Cara Mendeteksi Running Application di Delphi 7

0 Comment

7


Ya ampuun , udah lama banget blog ini kagak di update :hammer.Saya tidak akan berapologi dengan mengatakan kalau saya sibuk ini-itu walaupun kenyataannya memang begitu.(itu berapologi juga bay -,-" ).Okay , untuk postingan kali ini saya akan membahas mengenai Cara Mendeteksi Running Application di Delphi 7.Maksudnya !? Jadi gini gan , saya itu kesel sama adik saya yang maniak banget

nge-game.Game online pastinya.Sehari bisa seharian dia anteng mantengin PC cuma untuk naekin level yang menurut saya amat sangat tidak bermanfaat.Apalagi dia masih SMA , dan sekarang sedang masa-masa ujian.Dengan motif tersebut , saya tergugah untuk membuat sebuah aplikasi yang berfungsi untuk setidaknya mereduksi kenikmatan dia main game , hahahahaha (evil laugh).Well , lalu bagaimana alur kerja aplikasi ini !? Trus hubungannya sama judul apa !? Okay , saya jelaskan :

1.Aplikasi ini akan mendetect file exe program , dalam kasus ini lostsaga.exe (nama gamenya).
2.Jika lostsaga.exe terdeteksi , maka dalam selang waktu beberapa menit , komputer akan restart sendiri , hehe.
3.Kita akan membuat aplikasi ini running ketika start up.
4.Tentu saja , kita juga harus menyembunyikan aplikasi ini di taskbar.

Terdengar simple bukan !? makanya , ayo kita buat programnya segera.Simpan aplikasi dengan nama AppInterface.
Pertama , kita harus setting terlebih dahulu formnya agar tak terlihar.Gampang kok , set properties borderStyle menjadi none , color menjadi clBlack dan transparent.Coba jalankan program anda , kalo anda tidak melihat form apapun , berarti sudah oke.Selanjutnya , tambahkan beberapa class pada kalusa uses , yaitu ShellAPI , TlHelp32 dan Registry.Lalu kita akan membuat function yang berfungsi untuk menyembunyikan program di taskbar.Ketikan kode berikut :

  1. procedure showTaskBarIcon(Const Show : boolean);  
  2. begin  
  3.   ShowWindow(Application.Handle, SW_HIDE);  
  4.   
  5.   if Show = false then  
  6.   SetWindowLong(Application.Handle, GWL_EXSTYLE,GetWindowLong(Application.Handle,GWL_EXSTYLE) or WS_EX_TOOLWINDOW)  
  7.   else  
  8.     SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_OVERLAPPED);  
  9.     ShowWindow(Application.Handle, SW_SHOW);  
  10. end;  

Okay , function tersebut bertipe boolean.Yang nantinya akan di panggil saat aplikasi di jalankan.Selanjutnya , kita akan membuat function yang berfungsi untuk mendetect apakah sebuah program sedang running atau tidak (nyambung sama judul kan !? hehe ).Ketikan kode berikut :

  1. function processExists(exeFileName: string): Boolean;  
  2. var  
  3.   ContinueLoop: BOOL;  
  4.   FSnapshotHandle: THandle;  
  5.   FProcessEntry32: TProcessEntry32;  
  6. begin  
  7.   FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);  
  8.   FProcessEntry32.dwSize := SizeOf(FProcessEntry32);  
  9.   ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);  
  10.   Result := False;  
  11.   while Integer(ContinueLoop) <> 0 do  
  12.   begin  
  13.     if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =  
  14.       UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =  
  15.       UpperCase(ExeFileName))) then  
  16.     bdgin  
  17.       Result := True;  
  18.     end;  
  19.     ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);  
  20.   end;  
  21.   CloseHandle(FSnapshotHandle);  
  22. end;  

Sama seperti function sebelumnya , function ini juga bertipe boolean.Selanjutnya , kita akan membuat procedure yang mengatur program agar running ketika start up komputer.Inti dari procedure ini adalah , kita membuat value di registry dengan path program kita sebagai isinya.Dan ketika pertama booting , program di jalankan.Ketikan kode berikut :

  1. procedure RunOnStartup(WindowTitle,CommandLn:String;RunOnlyOnce: Boolean);  
  2. var  
  3.   RegIniFile  : TRegIniFile;  
  4. begin  
  5.   RegIniFile := TRegIniFile.Create('');  
  6.   with RegIniFile do begin  
  7.     RootKey := HKEY_LOCAL_MACHINE;  
  8.     if RunOnlyOnce then  
  9.       RegIniFile.WriteString('Software\Microsoft\Windows\' +  
  10.                              'CurrentVersion\RunOnce'#0,  
  11.                               WindowTitle, CommandLn)  
  12.     else  
  13.       RegIniFile.WriteString('Software\Microsoft\Windows\' +  
  14.                              'CurrentVersion\Run'#0,  
  15.                               WindowTitle, CommandLn);  
  16.     Free;  
  17.   end;  
  18. end;  

Seperti terlihat pada code diatas , bila program kita hanya ingin dijalankan sekali saja , maka yang di pilih adalah path RunOnce , bila ingin terus menerus dijalankan ketika start up , kita pilih path run.Selanjutnya , kita akan menuliskan 2 buah function yang berfungsi untuk menghandle proses turn off komputer.Ketikan kode berikut :

  1. function setShutDownPrivilege : Boolean;  
  2. var  
  3.     TTokenHnd : THandle;  
  4.     TTokenPvg : TTokenPrivileges;  
  5.     cbtpPrevious : DWORD;  
  6.     rTTokenPvg : TTokenPrivileges;  
  7.     pcbtpPreviousRequired : DWORD;  
  8.     tpResult : Boolean;  
  9.   
  10. const  
  11.     SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';  
  12. begin  
  13.   Result := false;  
  14.   
  15.   if Win32Platform = VER_PLATFORM_WIN32_NT  then  
  16.     begin  
  17.       if OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TTokenHnd) then  
  18.         begin  
  19.           tpResult := lookupPrivilegeValue(nil, SE_SHUTDOWN_NAME,TTokenPvg.Privileges[0].Luid);  
  20.           TTokenPvg.PrivilegeCount := 1;  
  21.           TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;  
  22.           cbtpPrevious := SizeOf(rTTokenPvg);  
  23.           pcbtpPreviousRequired := 0;  
  24.           if tpResult then  
  25.             Result := windows.AdjustTokenPrivileges(TTokenHnd,False,TTokenPvg,cbtpPrevious,rTTokenPvg, pcbtpPreviousRequired);  
  26.         end;  
  27.     end;  
  28. end;  
  29.   
  30. function Power(pwFlags: Cardinal) : Boolean;  
  31. begin  
  32.   if Win32Platform = VER_PLATFORM_WIN32_NT then  
  33.     setShutDownPrivilege;  
  34.     Result := ExitWindowsEx(pwFlags, 0);  
  35. end;  

Okay , semua function dan procedure telah kita siapkan , saatnya proses eksekusi ;).Tambahkan 2 buah Timer.Pada timer1 , set Intervalnya menjadi 5000 dan enabled true.Lalu ketikan code berikut :

  1. procedure TForm1.Timer1Timer(Sender: TObject);  
  2. var prog:string;  
  3. begin  
  4.   prog:='lostsaga.exe';  //nama programnya  
  5.   if processExists(prog) then  
  6.     begin  
  7.       Timer2.Enabled:=true;  
  8.     end;  
  9. end;  

Seperti kita lihat , setiap 5 detik sekali , aplikasi akan mengecek , apakah program lostsaga.exe running atau tidak.Function processExists() dipanggil.Dan bila ternyata lostsaga.exe sedang running , maka timer2 akan di aktifkan.Okay , untuk timer2 , set intervalnya sesuai keinginan anda :D.Dan set propeties enabled menjadi false..Lalu ketikan kode berikut :

  1. procedure TForm1.Timer2Timer(Sender: TObject);  
  2. begin  
  3.   Power(EWX_REBOOT or EWX_FORCE);  
  4. end;  

Yuph , kita akan menshutdown komputer kita sesuai interval yang telah di set.Dan yang terakhir , kita akan memindahkan aplikasi kita ke tempat yang cukup jarang di jamah oleh user awam pada saat program di jalankan.Masuk ke form event onShow lalu ketikan kode berikut :

  1. procedure TForm1.FormShow(Sender: TObject);  
  2. begin  
  3.   if FileExists('AppInterface.exe') then //cek , apakah pogram kita ada  
  4.     begin  
  5.       //bila ada , kita akan pindahkan sesuai path  
  6.       MoveFile('AppInterface.exe','C:\WINDOWS\system32\AppInterface.exe');  
  7.     end;  
  8.     //function taskbar di panggil , dan di set false agar tak terlihat  
  9.   showTaskBarIcon(False);  
  10.   
  11.   //kita panggil procedure ini agar program dijalankan tiap kali start up  
  12.   RunOnStartup('Application Interface','C:\Windows\System32\AppInterface.exe',False );  
  13. end;  

Kode lengkapnya sebagai berikut :

  1. unit Uutama;  
  2.   
  3. interface  
  4.   
  5. uses  
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  7.   Dialogs , TlHelp32, ExtCtrls, StdCtrls,ShellAPI,Registry;  
  8.   
  9. type  
  10.   TForm1 = class(TForm)  
  11.     Timer1: TTimer;  
  12.     Timer2: TTimer;  
  13.     procedure Timer1Timer(Sender: TObject);  
  14.     procedure FormShow(Sender: TObject);  
  15.     procedure Timer2Timer(Sender: TObject);  
  16.   private  
  17.     { Private declarations }  
  18.   public  
  19.     { Public declarations }  
  20.   end;  
  21.   
  22. var  
  23.   Form1: TForm1;  
  24.   
  25. implementation  
  26.   
  27. uses Math;  
  28.   
  29. {$R *.dfm}  
  30.   
  31.   
  32. procedure showTaskBarIcon(Const Show : boolean);  
  33. begin  
  34.   ShowWindow(Application.Handle, SW_HIDE);  
  35.   
  36.   if Show = false then  
  37.   SetWindowLong(Application.Handle, GWL_EXSTYLE,GetWindowLong(Application.Handle,GWL_EXSTYLE) or WS_EX_TOOLWINDOW)  
  38.   else  
  39.     SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_OVERLAPPED);  
  40.     ShowWindow(Application.Handle, SW_SHOW);  
  41. end;  
  42.   
  43. function processExists(exeFileName: string): Boolean;  
  44. var  
  45.   ContinueLoop: BOOL;  
  46.   FSnapshotHandle: THandle;  
  47.   FProcessEntry32: TProcessEntry32;  
  48. begin  
  49.   FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);  
  50.   FProcessEntry32.dwSize := SizeOf(FProcessEntry32);  
  51.   ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);  
  52.   Result := False;  
  53. while Integer(ContinueLoop) <> 0 do  
  54.   begin  
  55.     if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =  
  56.       UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =  
  57.       UpperCase(ExeFileName))) then  
  58.     begin  
  59.       Result := True;  
  60.     end;  
  61.     ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);  
  62.   end;  
  63.   CloseHandle(FSnapshotHandle);  
  64. end;  
  65.   
  66.   
  67. procedure TForm1.Timer1Timer(Sender: TObject);  
  68. var prog:string;  
  69. begin  
  70.   prog:='lostsaga.exe';  //nama programnya  
  71.   if processExists(prog) then  
  72.     begin  
  73.       Timer2.Enabled:=true;  
  74.     end;  
  75. end;  
  76.   
  77. procedure RunOnStartup(WindowTitle,CommandLn:String;RunOnlyOnce: Boolean);  
  78. var  
  79.   RegIniFile  : TRegIniFile;  
  80. begin  
  81.   RegIniFile := TRegIniFile.Create('');  
  82.   with RegIniFile do begin  
  83.     RootKey := HKEY_LOCAL_MACHINE;  
  84.     if RunOnlyOnce then  
  85.       RegIniFile.WriteString('Software\Microsoft\Windows\' +  
  86.                              'CurrentVersion\RunOnce'#0,  
  87.                               WindowTitle, CommandLn)  
  88.     else  
  89.       RegIniFile.WriteString('Software\Microsoft\Windows\' +  
  90.                              'CurrentVersion\Run'#0,  
  91.                               WindowTitle, CommandLn);  
  92.     Free;  
  93.   end;  
  94. end;  
  95.   
  96.   
  97.   
  98. procedure TForm1.FormShow(Sender: TObject);  
  99. begin  
  100.   if FileExists('AppInterface.exe') then //cek , apakah pogram kita ada  
  101.     begin  
  102.       //bila ada , kita akan pindahkan sesuai path  
  103.       MoveFile('AppInterface.exe','C:\WINDOWS\system32\AppInterface.exe');  
  104.     end;  
  105.     //function taskbar di panggil , dan di set false agar tak terlihat  
  106.   showTaskBarIcon(False);  
  107.   
  108.   //kita panggil procedure ini agar program dijalankan tiap kali start up  
  109.   RunOnStartup('Application Interface','C:\Windows\System32\AppInterface.exe',False );  
  110. end;  
  111.   
  112. function setShutDownPrivilege : Boolean;  
  113. var  
  114.     TTokenHnd : THandle;  
  115.     TTokenPvg : TTokenPrivileges;  
  116.     cbtpPrevious : DWORD;  
  117.     rTTokenPvg : TTokenPrivileges;  
  118.     pcbtpPreviousRequired : DWORD;  
  119.     tpResult : Boolean;  
  120.   
  121. const  
  122.     SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';  
  123. begin  
  124.   Result := false;  
  125.   
  126.   if Win32Platform = VER_PLATFORM_WIN32_NT  then  
  127.     begin  
  128.       if OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TTokenHnd) then  
  129.         begin  
  130.           tpResult := lookupPrivilegeValue(nil, SE_SHUTDOWN_NAME,TTokenPvg.Privileges[0].Luid);  
  131.           TTokenPvg.PrivilegeCount := 1;  
  132.           TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;  
  133.           cbtpPrevious := SizeOf(rTTokenPvg);  
  134.           pcbtpPreviousRequired := 0;  
  135.           if tpResult then  
  136.             Result := windows.AdjustTokenPrivileges(TTokenHnd,False,TTokenPvg,cbtpPrevious,rTTokenPvg, pcbtpPreviousRequired);  
  137.         end;  
  138.     end;  
  139. end;  
  140.   
  141. function Power(pwFlags: Cardinal) : Boolean;  
  142. begin  
  143.   if Win32Platform = VER_PLATFORM_WIN32_NT then  
  144.     setShutDownPrivilege;  
  145.     Result := ExitWindowsEx(pwFlags, 0);  
  146. end;  
  147.   
  148. procedure TForm1.Timer2Timer(Sender: TObject);  
  149. begin  
  150.   Power(EWX_REBOOT or EWX_FORCE);  
  151. end;  
  152.   
  153. end.  


Okay , beres deh.Untuk percobaan , anda bisa merubah lostsaga.exe menjadi file exe yang ingin anda test , dan pada timer2 bisa anda rubah menjadi showmessage daripada harus cape-cape reboot :D.Jalankan program dan tunggu apa yang terjadi.Untuk membersihkan sisa-sisa dari kejahilan ini , anda bisa mengapus file AppInterface.exe di C:\Windows\System32\AppInterface.exe.Dan untuk menghapus regestrynya , buka regedit dan hapus value yang terdapat di HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run.Okay , sekian untuk postingan kali ini , semoga bermanfaat ;).Oia , untuk source code programnya bisa anda download DISINI
Sumber: http://bayuidham.blogspot.com/2011/12/cara-mendeteksi-running-application-di.html

0 Comment:

Posting Komentar

_Pasopati 2010 UYP™

Copyright 2011 Designing a dream come true.
Blogger Templates By:Noct.