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

Материал из DRKB

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