Unit с полезными функциями для работы с процессами

=== Unit с полезными функциями для работы с процессами ===
{ **** UBPFD *********** by kladovka.net.ru ****
>> Unit с полезными функциями для работы с процессами
Этот Unit содержит полезные функции для работы с процессами. Взять информацию о данном процессе, обо всех процессах, убить процесс, и т.д. Полезна при создании системных приложений под Win32. Надо хорошо оттестировать этот Unit.
Зависимости: windows, PSAPI, TlHelp32, SysUtils;
Copyright: Моя разработка, некоторые функции базируются на примере в MSDN jan 2000 Collection
Дата: 5 июня 2002 г.
********************************************** }
unit ProcUtilz;
interface
uses Windows, PSAPI, TlHelp32, SysUtils;
type
 TLpModuleInfo = packed record
 ModuleInfo: LPMODULEINFO;
 ModulePID: Cardinal;
 ModuleName: string;
 end;
type
 TLpModuleInfoArray = array of TLpModuleInfo;
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall;
 external 'KERNEL32.DLL';
// Показать процесс с заданным PID в диспетчере задач Windows 9X
// ВНИМАНИЕ: Работает только под Win9x !!!!
function DisplayProcessInThreeFingerSalute(PID: Integer; Disp: Boolean): Boolean;
// Получить PID процесса по заголовку его окна
function TakeProcessID(WindowTitle: string): Integer;
// Получить PID текущего процесса
function GetCurrAppPID: Integer;
function GetAllProcessesInfo(ExtractFullPath: Boolean = False): TLpModuleInfoArray;
function ExtractExeFromModName(ModuleName: string): string;
// Останавливает работу процесса. Не действует на сервисами WinNT
function TerminateTask(PID: Integer): Integer;
implementation
function TakeProcessID(WindowTitle: string): Integer;
var
 WH: THandle;
begin
 Result := 0;
 WH := FindWindow(nil, PChar(WindowTitle));
 if WH <> 0 then
 GetWindowThreadProcessID(WH, @Result);
end;
function GetCurrAppPID: Integer;
begin
 GetCurrAppPID := GetCurrentProcessID;
end;
function DisplayProcessInThreeFingerSalute(PID: Integer; Disp: Boolean): Boolean;
begin
 Result := False;
 if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
 begin
 try
 if Disp = True then
 RegisterServiceProcess(PID, 0)
 else
 RegisterServiceProcess(PID, 1);
 except
 Result := False;
 end;
 end;
 DisplayProcessInThreeFingerSalute := Result;
end;
function TerminateTask(PID: Integer): Integer;
var
 process_handle: Integer;
 lpExitCode: Cardinal;
begin
 process_handle := OpenProcess(PROCESS_ALL_ACCESS, True, pid);
 GetExitCodeProcess(process_handle, lpExitCode);
 if (process_handle = 0) then
 TerminateTask := GetLastError
 else if TerminateProcess(process_handle, lpExitCode) then
 begin
 TerminateTask := 0;
 CloseHandle(process_handle);
 end
 else
 begin
 TerminateTask := GetLastError;
 CloseHandle(process_handle);
 end;
end;
// Получить информацию о процессе по его PID
// Проверено под WinNT.
function GetProcessInfo(PID: Word): LPMODULEINFO;
var
 RetVal: LPMODULEINFO;
 hProc: DWORD;
 hMod: HMODULE;
 cm: cardinal;
begin
 hProc := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PID);
 GetMem(RetVal, SizeOf(LPMODULEINFO));
 if not (hProc = 0) then
 begin
 EnumProcessModules(hProc, @hMod, 4, cm);
 GetModuleInformation(hProc, hMod, RetVal, SizeOf(RetVal));
 end;
 GetProcessInfo := RetVal;
end;
// Получить имя испольняемого файла процесса по его полному пути
function ExtractExeFromModName(ModuleName: string): string;
begin
 ExtractExeFromModName := Copy(ModuleName, LastDelimiter('\', ModuleName) + 1, Length(ModuleName));
end;
// Получить информацию о всех процессах на данный момент
// Проыверено под WinNT
function GetAllProcessesInfo(ExtractFullPath: Boolean = False): TLpModuleInfoArray;
var
 ProcList: array [0..$FFF] of DWORD;
 RetVal: TLpModuleInfoArray;
 ProcCnt: Cardinal;
 I, MaxCnt: word;
 ModName: array[0..max_path] of Char;
 ph, mh: THandle;
 cm: Cardinal;
 SnapShot: THandle;
 ProcEntry: TProcessEntry32;
 RetValLength, CVal: Word;
 ModInfo: LPMODULEINFO;
begin
 // case the platform is Win9X
 if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
 begin
 GetMem(ModInfo, SizeOf(LPMODULEINFO));
 SnapShot := CreateToolhelp32Snapshot(th32cs_snapprocess, 0);
 RetValLength := 0;
 CVal := 0;
 if not Integer(SnapShot) = -1 then
 begin
 ProcEntry.dwSize := SizeOf(TProcessEntry32);
 if Process32First(SnapShot, ProcEntry) then
 repeat
 // get the size of out array
 Inc(RetValLength);
 until not Process32Next(SnapShot, ProcEntry);
 // set the size of the output array
 SetLength(RetVal, RetValLength);
 // iterate through processes and get their info
 if Process32First(SnapShot, ProcEntry) then
 begin
 repeat
 Inc(CVal);
 ModInfo.lpBaseOfDll := nil;
 ModInfo.SizeOfImage := ProcEntry.dwSize;
 ModInfo.EntryPoint := nil;
 RetVal[CVal].ModuleInfo := ModInfo;
 RetVal[CVal].ModulePID := ProcEntry.th32ProcessID;
 if (ExtractFullPath) then
 RetVal[CVal].ModuleName := string(ProcEntry.szExeFile)
 else
 RetVal[CVal].ModuleName := ExtractExeFromModName(string(ProcEntry.szExeFile));
 ModInfo := nil;
 until not Process32Next(SnapShot, ProcEntry);
 end;
 end;
 end
 // case the platform is WinNT/2K/XP
 else
 begin
 EnumProcesses(@ProcList, SizeOf(ProcList), ProcCnt);
 MaxCnt := ProcCnt div 4;
 SetLength(RetVal, MaxCnt);
 // iterate through processes and get their info
 for i := Low(RetVal) to High(RetVal) do
 begin
 // Check for reserved PIDs
 if ProcList[i] = 0 then
 begin
 RetVal[i].ModuleName := 'System Idle Process';
 RetVal[i].ModulePID := 0;
 RetVal[i].ModuleInfo := ProcUtilz.GetProcessInfo(i);
 end
 else if ProcList[i] = 8 then
 begin
 RetVal[i].ModuleName := 'System';
 RetVal[i].ModulePID := 8;
 RetVal[i].ModuleInfo := ProcUtilz.GetProcessInfo(i);
 end
 // Gather info about all processes
 else
 begin
 RetVal[i].ModulePID := ProcList[i];
 RetVal[i].ModuleInfo := GetProcessInfo(ProcList[i]);
 // get module name
 ph := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcList[i]);
 if ph > 0 then
 begin
 EnumProcessModules(ph, @mh, 4, cm);
 GetModuleFileNameEx(ph, mh, ModName, sizeof(ModName));
 if (ExtractFullPath) then
 RetVal[i].ModuleName := string(ModName)
 else
 RetVal[i].ModuleName := ExtractExeFromModName(string(ModName));
 end
 else
 RetVal[i].ModuleName := 'UNKNOWN';
 CloseHandle(ph);
 end;
 end;
 end;
 // return the array of LPMODULEINFO structz
 GetAllProcessesInfo := RetVal;
end;
end.
Пример использования:
procedure TForm1.Button1Click(Sender: TObject);
var
 I: Integer;
 PC: WORD;
begin
 ListBox1.Clear;
 ProcArr := TLpModuleInfoArray(ProcUtilz.GetAllProcessesInfo);
 PC := 0;
 for i := Low(ProcArr) to High(ProcArr) do
 begin
 ListBox1.Items.Add('Process Name: ' + ProcArr[i].ModuleName
 + ' : Proccess ID ' + IntToStr(ProcArr[i].ModulePID)
 + ' : Image Size: ' + IntToStr(ProcArr[i].ModuleInfo.SizeOfImage));
 Inc(PC);
 end;
 ListBox1.Items.Add('Total process count: ' + IntToStr(PC));
end;
procedure TForm1.Button2Click(Sender: TObject);
var
 EC: Integer;
begin
 EC := ProcUtilz.TerminateTask(ProcArr[ListBox1.ItemIndex].ModulePID);
 if EC = 0 then
 MessageDlg('Task terminated successfully!', mtInformation, [mbOK], 0)
 else
 MessageDlg('Unable to terminate task! GetLastError() returned: ' + IntToStr(EC), mtWarning, [mbOK], 0);
 Button1Click(Sender);
end;
ID: 02140