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



Автор: Alex Kantchev
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Unit с полезными функциями для работы с процессами
Этот Unit содержит полезные функции для работы с процессами.
Взять информацию о данном процессе, обо всех процессах, убить процесс, и т.д.
Полезна при создании системных приложений под Win32.
Надо хорошо оттестировать этот Unit.
Зависимости: windows, PSAPI, TlHelp32, SysUtils;
Автор:       Alex Kantchev, [email protected]
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';
function DisplayProcessInThreeFingerSalute(PID: Integer; Disp: Boolean):
Boolean;
function TakeProcessID(WindowTitle: string): Integer;
function GetCurrAppPID: Integer;
function GetAllProcessesInfo(ExtractFullPath: Boolean = false):
TLpModuleInfoArray;
function ExtractExeFromModName(ModuleName: string): string;
function TerminateTask(PID: integer): integer;
implementation
//Wziat PID na danoi process ot nego window title
function TakeProcessID(WindowTitle: string): Integer;
var
WH: THandle;
begin
result := 0;
WH := FindWindow(nil, pchar(WindowTitle));
if WH <> 0 then
GetWindowThreadProcessID(WH, @Result);
end;
//Wziat PID na tekuchii process
function GetCurrAppPID: Integer;
begin
GetCurrAppPID := GetCurrentProcessID;
end;
//Pokzat process s PID v task menagera Windows 9X
//WNIMANIE: Rabotaet tolko pod Win9x !!!!
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;
//Ostanavlivaet rabotu procesa. Ne rabotaet so WinNT
//serviznae processi.
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;
//Wziat informacia ob processse po ego PID
//Testirano pod 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;
//Wziat executable processa ot ego polnai put
function ExtractExeFromModName(ModuleName: string): string;
begin
ExtractExeFromModName := Copy(ModuleName, LastDelimiter('\', ModuleName) + 1,
Length(ModuleName));
;
end;
//Wziat informacia ob wse processi rabotaushtie w tekuchii
//moment. Testirano pod 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
repeat
begin
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;
end;
until not Process32Next(SnapShot, ProcEntry);
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;

Далее: Запустить процесс в защищенной области другого пользователя »»