EZ Blog

Process list In Delphi (Source Code Attached)

Process list In Delphi (Source Code Attached)

unit uDGProcessList;

 

interface

uses

  SysUtils,

  Windows,

  Classes,

  Graphics,

  TlHelp32,

  ShellApi,

  PsApi;

type

  // type used to store information about a process

  PDGProcessRec = ^TDGProcessRec;

  TDGProcessRec = record

    Name: WideString;

    ExeName: WideString;

    UserName: WideString;

    Domain: WideString;

    StartDateTime: TDateTime;

    MemoryUsage: DWORD;

    Usage: DWORD;

    ProcessID: DWORD; // this process

    DefaultHeapID: DWORD;

    ModuleID: DWORD; // associated exe

    ThreadCount: DWORD;

    ParentProcessID: DWORD; // this process's parent process

    PriClassBase: Longint; // Base priority of process's threads

  end;// TDGProcessRec = record

type

  // type used to get user name and domain

  PTOKEN_USER = ^TOKEN_USER;

  _TOKEN_USER = record

    User: TSidAndAttributes;

  end;

  TOKEN_USER = _TOKEN_USER;

type

  TUnitType = (utByte, utKiloByte, utMegaByte, utGigaByte);

type

  TDGProcessList = class

  PRIVATE// variables and methods

    FList: TList;

    function GetProcessRec(INDEX: Integer): TDGProcessRec;

    function GetProcessFileName(dwProcessID: DWORD): WideString;

    function GetProcessUserAndDomain(dwProcessID: DWORD;

      var UserName, Domain: WideString): Boolean;

    function GetProcessStartDateTime(dwProcessID: DWORD): TDateTime;

    procedure SetProcessRec(INDEX: Integer; const Value: TDGProcessRec);

  PUBLIC// methods

    function Count: Integer;

    function TerminateProcess(dwProcessID: DWORD): Boolean; OVERLOAD;

    function TerminateProcess(const Name: WideString): Boolean; OVERLOAD;

    function Exists(dwProcessID: DWORD): Boolean; OVERLOAD;

    function Exists(dwProcessID: DWORD; var atIndex: Integer): Boolean; OVERLOAD;

    function Exists(const Name: WideString): Boolean; OVERLOAD;

    function Exists(const Name: WideString; var atIndex: Integer): Boolean; OVERLOAD;

    function ProcessInfoToStr(Index: Integer): WideString;

    function GetProcessIcon(Index: Integer;

      const bSmallIcon: Boolean = True): TIcon; OVERLOAD;

    function GetProcessIcon(const ExeName: WideString;

      const bSmallIcon: Boolean = True): TIcon; OVERLOAD;

    function GetProcessMemoryUsage(dwProcessID: DWORD;

      const UnitType: TUnitType = utByte): DWORD;

    procedure Clear;

    procedure Delete(Index: Integer);

    procedure Refresh;

  PUBLIC// properties

    property Process[INDEX: Integer]: TDGProcessRec

      read GetProcessRec write SetProcessRec; DEFAULT;

  PUBLIC// constructor and destructor

    constructor Create;

    destructor Destroy; override;

  end;// TDGProcessList = class

implementation

{ TDGProcessList }

procedure TDGProcessList.Clear;

var

  Index: Integer;

begin

  for Index := FList.Count -1 downto 0 do

    Delete(Index);

end;// procedure TDGProcessList.Clear;

function TDGProcessList.Count: Integer;

begin

  Result := FList.Count;

end;// function TDGProcessList.Count: Integer;

constructor TDGProcessList.Create;

begin

  FList := TList.Create;

end;// constructor TDGProcessList.Create;

procedure TDGProcessList.Delete(Index: Integer);

var

  ProcessRec: PDGProcessRec;

begin

  ProcessRec := FList[Index];

  Dispose(ProcessRec);

  FList.Delete(Index);

end;// procedure TDGProcessList.Delete(Index: Integer);

destructor TDGProcessList.Destroy;

begin

  Clear;

  FreeAndNil(FList);

  inherited;

end;// destructor TDGProcessList.Destroy;

function TDGProcessList.Exists(dwProcessID: DWORD): Boolean;

var

  Index: Integer;

begin

  Result := Exists(dwProcessID, Index);

end;// function TDGProcessList.Exists(dwProcessID: DWORD): Boolean;

function TDGProcessList.Exists(dwProcessID: DWORD;

  var atIndex: Integer): Boolean;

var

  Index: Integer;

begin

  Result := True;

  for Index := 0 to FList.Count -1 do

    if Process[Index].ProcessID = dwProcessID then begin

      atIndex := Index;

      Exit;

    end;// if Process[Index].th32ProcessID = dwProcessID then begin

  Result := False;

end;// function TDGProcessList.Exists(dwProcessID: DWORD;

function TDGProcessList.Exists(const Name: WideString): Boolean;

var

  Index: Integer;

begin

  Result := Exists(Name, Index);

end;// function TDGProcessList.Exists(const Name: AnsiString): Boolean;

function TDGProcessList.Exists(const Name: WideString;

  var atIndex: Integer): Boolean;

var

  Index: Integer;

begin

  Result := True;

  for Index := 0 to FList.Count -1 do

    if SameText(Process[Index].Name, Name) then begin

      atIndex := Index;

      Exit;

    end;// if SameText(Process[Index].Name, Name) then begin

  Result := False;

end;// function TDGProcessList.Exists(const Name: AnsiString;

function TDGProcessList.GetProcessFileName(dwProcessID: DWORD): WideString;

var

  Handle: THandle;

begin

  Result := EmptyStr;

  Handle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False,

    dwProcessID);

  try

    SetLength(Result, MAX_PATH);

    if Handle <> 0 then begin

      if GetModuleFileNameEx(Handle, 0, {$IFDEF UNICODE}PWideChar{$ELSE}PAnsiChar{$ENDIF}(Result), MAX_PATH) > 0 then

        SetLength(Result, StrLen(PChar(Result)))

      else

        Result := EmptyStr;

    end else begin// if Handle <> 0 then begin

       if GetModuleFileNameEx(Handle, 0, {$IFDEF UNICODE}PWideChar{$ELSE}PAnsiChar{$ENDIF}(Result), MAX_PATH) > 0 then

        SetLength(Result, StrLen(PChar(Result)))

      else

        Result := EmptyStr;

    end;// if Handle <> 0 then begin

  finally

    CloseHandle(Handle);

  end;// try

end;// function TDGProcessList.GetProcessFileName(dwProcessID: DWORD): AnsiString;

function TDGProcessList.GetProcessIcon(Index: Integer;

  const bSmallIcon: Boolean = True): TIcon;

begin

  Result := GetProcessIcon(Process[Index].ExeName);

end;// function TDGProcessList.GetProcessIcon(Index: Integer;

function TDGProcessList.GetProcessIcon(const ExeName: WideString;

  const bSmallIcon: Boolean = True): TIcon;

var

  FileInfo: _SHFILEINFO;

  Flags: DWORD;

begin

  if bSmallIcon then

    Flags := SHGFI_ICON or SHGFI_SMALLICON or SHGFI_SYSICONINDEX

  else

    Flags := SHGFI_ICON or SHGFI_LARGEICON or SHGFI_SYSICONINDEX;

  Result := TIcon.Create;

  SHGetFileInfo({$IFDEF UNICODE}PWideChar{$ELSE}PAnsiChar{$ENDIF}(ExeName), 0, FileInfo, SizeOf(FileInfo), Flags);

  Result.Handle := FileInfo.hIcon;

end;// function TDGProcessList.GetProcessIcon(const ExeName: AnsiString;

function TDGProcessList.GetProcessMemoryUsage(dwProcessID: DWORD;

  const UnitType: TUnitType = utByte): DWORD;

const

  CFACTOR_BYTE = 1;

  CFACTOR_KILOBYTE = CFACTOR_BYTE * 1024;

  CFACTOR_MEGABYTE = CFACTOR_KILOBYTE * 1024;

  CFACTOR_GIGABYTE = CFACTOR_MEGABYTE * 1024;

var

  MemCounters: TProcessMemoryCounters;

  hProcess: THandle;

begin

  Result := 0;

  MemCounters.cb := SizeOf(TProcessMemoryCounters);

  hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, dwProcessID);

  if hProcess <> 0 then begin

    if GetProcessMemoryInfo(hProcess, @MemCounters, SizeOf(MemCounters)) then

      case UnitType of

        utByte:

          Result := MemCounters.WorkingSetSize div CFACTOR_BYTE;

        utKiloByte:

          Result := MemCounters.WorkingSetSize div CFACTOR_KILOBYTE;

        utMegaByte:

          Result := MemCounters.WorkingSetSize div CFACTOR_MEGABYTE;

        utGigaByte:

          Result := MemCounters.WorkingSetSize div CFACTOR_GIGABYTE;

      end// case UnitType of

    else

      RaiseLastOSError;

    CloseHandle(hProcess)

  end;// if hProcess <> 0 then begin

end;// function TDGProcessList.GetProcessMemoryUsage(dwProcessID: DWORD;

function TDGProcessList.GetProcessRec(INDEX: Integer): TDGProcessRec;

begin

  if (INDEX <= -1) or (INDEX >= FList.Count) then

    raise Exception.Create('Index out of bounds');

  Result := PDGProcessRec(FList[INDEX])^;

end;// function TDGProcessList.GetProcessRec(INDEX: Integer): TDGProcessRec;

function TDGProcessList.GetProcessStartDateTime(

  dwProcessID: DWORD): TDateTime;

  function FileTimeToDateTime(ft: TFileTime): TDateTime;

  var

    ft1: TFileTime;

    st: TSystemTime;

  begin

    if ft.dwLowDateTime + ft.dwHighDateTime = 0 then

      Result := 0

    else

    begin

      FileTimeToLocalFileTime(ft, ft1);

      FileTimeToSystemTime(ft1, st);

      Result := SystemTimeToDateTime(st);

    end;

  end;

var

  ftCreationTime, lpExitTime, ftKernelTime, ftUserTime: TFileTime;

  hProcess: THandle;

begin

  Result := 0;

  hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, dwProcessID);

  if hProcess <> 0 then begin

    if GetProcessTimes(hProcess, ftCreationTime, lpExitTime,

        ftKernelTime, ftUserTime) then

      Result := FileTimeToDateTime(ftCreationTime)

    else

      RaiseLastOSError;

    CloseHandle(hProcess);

  end;// if hProcess <> 0 then begin

end;// function TDGProcessList.GetProcessStartDateTime(

function TDGProcessList.GetProcessUserAndDomain(dwProcessID: DWORD;

  var UserName, Domain: WideString): Boolean;

var

  hToken: THandle;

  cbBuf: Cardinal;

  tokUser: PTOKEN_USER;

  sidNameUse: SID_NAME_USE;

  hProcess: THandle;

  UserSize, DomainSize: DWORD;

  bSuccess: Boolean;

begin

  Result := False;

  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, dwProcessID);

  if hProcess <> 0 then begin

    if OpenProcessToken(hProcess, TOKEN_QUERY, hToken) then begin

      bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);

      tokUser := nil;

      while (not bSuccess) and

          (GetLastError = ERROR_INSUFFICIENT_BUFFER) do begin

        ReallocMem(tokUser, cbBuf);

        bSuccess := GetTokenInformation(hToken, TokenUser, tokUser, cbBuf, cbBuf);

      end;// while (not bSuccess) and...

      CloseHandle(hToken);

      if not bSuccess then

        Exit;

      UserSize := 0;

      DomainSize := 0;

      LookupAccountSid(nil, tokUser.User.Sid, nil, UserSize, nil, DomainSize, sidNameUse);

      if (UserSize <> 0) and (DomainSize <> 0) then begin

        SetLength(UserName, UserSize);

        SetLength(Domain, DomainSize);

        if LookupAccountSid(nil, tokUser.User.Sid, {$IFDEF UNICODE}PWideChar{$ELSE}PAnsiChar{$ENDIF}(UserName), UserSize,

            {$IFDEF UNICODE}PWideChar{$ELSE}PAnsiChar{$ENDIF}(Domain), DomainSize, sidNameUse) then begin

          Result := True;

          UserName := StrPas(PChar(UserName));

          Domain := StrPas(PChar(Domain));

        end;// if LookupAccountSid(nil, tokUser.User.Sid, PAnsiChar(UserName), UserSize,

      end;// if (UserSize <> 0) and (DomainSize <> 0) then begin

      if bSuccess then

        FreeMem(tokUser);

    end;// if OpenProcessToken(hProcess, TOKEN_QUERY, hToken) then begin

    CloseHandle(hProcess);

  end;// if hProcess <> 0 then begin

end;// function TDGProcessList.GetProcessUserAndDomain(dwProcessID: DWORD;

function TDGProcessList.ProcessInfoToStr(Index: Integer): WideString;

const

  CCRLF = #$D#$A;

  CPROCESSREC_FMT = CCRLF +

    'Name = %s' + CCRLF +

    'ExeName = %s' + CCRLF +

    'User name = %s' + CCRLF +

    'Domain = %s' + CCRLF +

    'Started = %s' + CCRLF +

    'Memory usage = %d bytes' + CCRLF +

    'Usage = %d' + CCRLF +

    'Process ID = %d' + CCRLF +

    'Default heap ID = %d' + CCRLF +

    'Module ID = %d' + CCRLF +

    'Threads = %d' + CCRLF +

    'Parent process ID = %d' + CCRLF +

    'Priority base class = %d' + CCRLF;

var

  ProcessRec: TDGProcessRec;

begin

  ProcessRec := Process[Index];

  Result := Format(CPROCESSREC_FMT, [

    ProcessRec.Name,

    ProcessRec.ExeName,

    ProcessRec.UserName,

    ProcessRec.Domain,

    DateTimeToStr(ProcessRec.StartDateTime),

    ProcessRec.MemoryUsage,

    ProcessRec.Usage,

    ProcessRec.ProcessID,

    ProcessRec.DefaultHeapID,

    ProcessRec.ModuleID,

    ProcessRec.ThreadCount,

    ProcessRec.ParentProcessID,

    ProcessRec.PriClassBase]);

end;// function TDGProcessList.ProcessInfoToStr(Index: Integer): AnsiString;

procedure TDGProcessList.Refresh;

var

  ProcessEntry32: TProcessEntry32;

  ProcessRec: PDGProcessRec;

  hSnapshot: THandle;

  UserName: WideString;

  Domain: WideString;

begin

  Clear;

  hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

  ProcessEntry32.dwSize := SizeOf(TProcessEntry32);

  if Process32First(hSnapshot, ProcessEntry32) then

    repeat

      New(ProcessRec);

      ProcessRec^.Name := pchar(StrPas(ProcessEntry32.szExeFile));

      ProcessRec^.ExeName := GetProcessFileName(ProcessEntry32.th32ProcessID);

      if GetProcessUserAndDomain(ProcessEntry32.th32ProcessID,

          UserName, Domain) then begin

        ProcessRec^.UserName := UserName;

        ProcessRec^.Domain := Domain;

      end;// if GetProcessUserAndDomain(ProcessEntry32.th32ProcessID,

      ProcessRec^.StartDateTime := GetProcessStartDateTime(

        ProcessEntry32.th32ProcessID);

      ProcessRec^.MemoryUsage := GetProcessMemoryUsage(

        ProcessEntry32.th32ProcessID);

      ProcessRec^.Usage := ProcessEntry32.cntUsage;

      ProcessRec^.ProcessID := ProcessEntry32.th32ProcessID;

      ProcessRec^.DefaultHeapID := ProcessEntry32.th32DefaultHeapID;

      ProcessRec^.ModuleID := ProcessEntry32.th32ModuleID;

      ProcessRec^.ThreadCount := ProcessEntry32.cntThreads;

      ProcessRec^.ParentProcessID := ProcessEntry32.th32ParentProcessID;

      ProcessRec^.PriClassBase := ProcessEntry32.pcPriClassBase;

      FList.Add(ProcessRec);

    until NOT Process32Next(hSnapshot, ProcessEntry32);

  if FList.Count > 0 then

    Delete(0);

  if hSnapshot <> 0 then

    CloseHandle(hSnapshot);

end;// procedure TDGProcessList.Refresh;

procedure TDGProcessList.SetProcessRec(INDEX: Integer;

  const Value: TDGProcessRec);

begin

  PDGProcessRec(FList[INDEX])^ := Value;

end;// procedure TDGProcessList.SetProcessRec(INDEX: Integer;

function TDGProcessList.TerminateProcess(dwProcessID: DWORD): Boolean;

var

  hProcess: THandle;

begin

  Result := False;

  hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, dwProcessID);

  if hProcess <> 0 then begin

    Result := Windows.TerminateProcess(hProcess, 0);

    CloseHandle(hProcess)

  end;// if hProcess <> 0 then begin

end;// function TDGProcessList.TerminateProcess(dwProcessID: DWORD): Boolean;

function TDGProcessList.TerminateProcess(const Name: WideString): Boolean;

var

  Index: Integer;

begin

  Result := False;

  for Index := 0 to FList.Count -1 do

    if SameText(Process[Index].Name, Name) then begin

      Result := TerminateProcess(Process[Index].ProcessID);

      Exit;

    end;// if SameText(Process[Index].Name, Name) then begin

end;// function TDGProcessList.TerminateProcess(const Name: AnsiString): Boolean;

end.// unit uDGProcessList;

 

 
 

Usage: 

 

uses

uDGProcessList;

 

 

How to fill a memo called Memo1 with all processes along with it's information


procedure TForm1.Button1Click(Sender: TObject);

var

  Index: Integer;

  ProcessList: TDGProcessList;

begin

  ProcessList := TDGProcessList.Create;

  ProcessList.Refresh;

  Memo1.Clear;

  for Index := 0 to ProcessList.Count -1 do

    Memo1.Text := Memo1.Text + ProcessList.ProcessInfoToStr(Index);

  FreeAndNil(ProcessList);

end;



How to terminate Notepad for instance


procedure TForm1.Button1Click(Sender: TObject);

var

  Index: Integer;

  ProcessList: TDGProcessList;

begin

  ProcessList := TDGProcessList.Create;

  ProcessList.Refresh;

  ProcessList.Exists('notepad.exe', Index);

  if (Index > 0) and (Index < ProcessList.Count) then

    ProcessList.TerminateProcess(ProcessList[Index].ProcessID);

  FreeAndNil(ProcessList);

end;
Attached Files: Download

 

 

Information

EZ SystemRepairs is a young and promising company that produces innovative software with advanced technology in the fields of system fixing, performance tune up as well as security protection.

Company