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

Code:

{ **** UBPFD *********** ****

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

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

обо всех процессах, убить процесс, и т.д. Полезна при создании системных приложений под Win32.

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

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

Автор:       Alex Kantchev, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.

********************************************** }

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.