berikut ini adalah source code membuat task manager dengan delphi
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls,tlhelp32;
type
TForm1 = class(TForm)
ListView1: TListView;
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
Procedure TutupProsesID(ID:THandle);
procedure BacaProses;
public
{ Public declarations }
end;
var
Form1: TForm1;
lvi:TListitem;
implementation
{$R *.dfm}
Procedure TForm1.TutupProsesID(ID:THandle);
//Disini kode untuk menututu proses
procedure TerminateProcessById(AID: Cardinal);
var
HndProcess,ExCode : THandle;
begin
//Baca Proses ID-nya
HndProcess := OpenProcess(PROCESS_ALL_ACCESS,True,AID);
GetExitCodeProcess(HndProcess,ExCode); {Dapatkan kode untuk menutupnya}
TerminateProcess(HndProcess,ExCode) {Tutup prosess sekarang..!};
CloseHandle(HndProcess); {Fresh Memory}
end;
{
Nah ini kode untuk dapat mengakses proses service yang biasanya tidak bisa
di terminate dengan kode biasa, untuk itu diperlukan kode tambahan
berikut kodenya :
}
function SetPrivilege(aPrivilegeName: string; aEnabled: boolean): boolean;
var
TP : TTokenPrivileges;
TPPrev : TTokenPrivileges;
Token : THandle;
dwRetLen : DWord;
begin
Result := False; //Nilai default
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, Token);
TP.PrivilegeCount := 1;
if (LookupPrivilegeValue(nil, PChar(aPrivilegeName), TP.Privileges[0].LUID)) then begin
if (aEnabled) then
TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
else
TP.Privileges[0].Attributes := 0;
dwRetLen := 0;
Result := AdjustTokenPrivileges(Token, False, TP, SizeOf(TPPrev), TPPrev, dwRetLen);
end;
CloseHandle(Token);
end;
function KillProcessByPID(pid: cardinal): boolean;
var
hProc : THandle;
begin
Result := False;
//Untuk mematikan proses dibutuhkan kode privilege
if not SetPrivilege('SeDebugPrivilege', True) then exit;
hProc := OpenProcess(STANDARD_RIGHTS_REQUIRED or PROCESS_TERMINATE, False, pid);
try
if hProc > 0 then begin
Result := TerminateProcess(hProc, 1);
end;
finally
CloseHandle(hProc);
SetPrivilege('SeDebugPrivilege', False);
end;
end;
Begin
KillProcessByPID(ID); //Tutup proses ID sekarang juga...!
End;
//Baca Semua proses di sini..
procedure TForm1.BacaProses;
var
hSnap:Cardinal;
pe32:TProcessEntry32;
s:String;
begin
//Buat dahulu snapshootnya di mulai dari proses desktop
hsnap:=CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS,0);
if hSnap = INVALID_HANDLE_VALUE then
exit;
FillChar(pe32, sizeof(pe32),0);
pe32.dwSize:=Sizeof(pe32);
if not Process32First(hsnap, pe32) then
exit;
ListView1.Clear; //hapus seluruh list
//tambahkan seluruh list dengan nama dan PID proses..
repeat
lvi:=ListView1.Items.Add;
s:=IntToStr(pe32.th32ProcessID);
lvi.caption := pe32.szExeFile;
lvi.subitems.Add(s);
until not Process32Next(hsnap, pe32);
CloseHandle(hSnap);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Bacaproses;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Bacaproses;
end;
procedure TForm1.ListView1SelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
begin
button2.Enabled := selected;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
TutupProsesID(strtoint(listview1.Selected.SubItems[0]));
end;
end.
semoga bermanfaat
