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

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Alex Kantchev

WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****

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

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

Взять информацию о данном процессе, обо всех процессах, убить процесс, и т.д.

Полезна при создании системных приложений под Win32.

Надо хорошо оттестировать этот Unit.

Зависимости: windows, PSAPI, TlHelp32, SysUtils;

Автор: Alex Kantchev, stoma@bitex.bg

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;

{/codecitation}

Добавить комментарий