Source Code Task Manager dengan Delphi7

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