Recent

Author Topic: Get list of process  (Read 20551 times)

taazz

  • Hero Member
  • *****
  • Posts: 5368
Re: Get list of process
« Reply #15 on: October 20, 2017, 11:32:15 am »
I'm not sure where Taaz got his quote from and maybe I'm missing something
I'm not in the habit of misquoting, see attached image.
Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

munair

  • Hero Member
  • *****
  • Posts: 798
  • compiler developer @SharpBASIC
    • SharpBASIC
Re: Get list of process
« Reply #16 on: October 20, 2017, 11:48:26 am »
I'm not sure where Taaz got his quote from and maybe I'm missing something
I'm not in the habit of misquoting, see attached image.

Ahh, that explains it.
keep it simple

Ericktux

  • Sr. Member
  • ****
  • Posts: 345
Re: Get list of process
« Reply #17 on: October 22, 2017, 05:03:04 am »
good friends, already I could solve the "description" and "company" of each process  :) , but some processes do not show their path.  :( :(
how can I get the missing path...

attached project and image.

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Buttons,
  9.   ComCtrls, Utilwmi, contnrs;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BitBtn1: TBitBtn;
  17.     ListView1: TListView;
  18.     procedure BitBtn1Click(Sender: TObject);
  19.   private
  20.  
  21.   public
  22.  
  23.   end;
  24.  
  25. var
  26.   Form1: TForm1;
  27.  
  28. implementation
  29.  
  30. {$R *.lfm}
  31.  
  32. { TForm1 }
  33.  
  34. function obtenerInfoFichero (info : string; fichero : string) : string;
  35. type
  36.   PaLeerBuffer = array [0..MAX_PATH] of char;
  37. var
  38.   Size, Size2 : DWord;
  39.   Pt, Pt2 : Pointer;
  40.   Idioma : string;
  41. begin
  42.   Result := '';
  43.   Size := GetFileVersionInfoSize(PChar (fichero), Size2);
  44.   if Size > 0 then
  45.   begin
  46.     GetMem (Pt, Size);
  47.     if GetFileVersionInfo (PChar (fichero), 0, Size, Pt) then
  48.     begin
  49.       VerQueryValue( Pt, '\VarFileInfo\Translation',Pt2, Size2);
  50.       Idioma:=IntToHex( DWord(Pt2^) ,8 );
  51.       Idioma:=Copy(Idioma,5,4)+Copy(Idioma,1,4);
  52.       VerQueryValue( Pt,Pchar('\StringFileInfo\'+Idioma+'\'+info),Pt2, Size2);
  53.       if Size2 > 0 then
  54.       begin
  55.        Result:=Copy(PaLeerBuffer(Pt2^),1,Size2);
  56.       end
  57.       else
  58.         result := '';
  59.       FreeMem (Pt);
  60.     end;
  61.   end
  62.   else
  63.     result := '';
  64. end;
  65.  
  66. procedure TForm1.BitBtn1Click(Sender: TObject);
  67. var WMIResult         : TFPObjectList;
  68.  f             : integer;
  69.  retVal            : String;
  70. begin
  71.   WMIResult := GetWMIInfo('Win32_Process', ['name', 'ProcessId','ExecutablePath', 'WorkingSetSize']);
  72.   for f := 0 to Pred(WMIResult.Count) do
  73.   begin
  74.  
  75.   // ORIGINAL OF Jurassic Pork  ////////////////////////////////////////////////
  76.     {retVal := TStringList(WMIResult[f]).ValueFromIndex[0] + ' - Pid : ' +
  77.               TStringList(WMIResult[f]).ValueFromIndex[1] +  ' - Exec : ' +
  78.               TStringList(WMIResult[f]).ValueFromIndex[2];
  79.     Memo1.Lines.add(Retval);}
  80.   //////////////////////////////////////////////////////////////////////////////
  81.  
  82.     with Form1.ListView1.Items.Add do
  83.         begin
  84.         Caption:= TStringList(WMIResult[f]).ValueFromIndex[0];      // name of process
  85.         SubItems.Add(TStringList(WMIResult[f]).ValueFromIndex[1]);  // pid of process
  86.         SubItems.Add(TStringList(WMIResult[f]).ValueFromIndex[2]);  // path of process
  87.         SubItems.Add(TStringList(WMIResult[f]).ValueFromIndex[3]);  // ram used of process (bytes)
  88.         SubItems.Add(obtenerInfoFichero('FileDescription', TStringList(WMIResult[f]).ValueFromIndex[2]));  // description of process ERROR ERROR ERROR
  89.         SubItems.Add(obtenerInfoFichero('CompanyName', TStringList(WMIResult[f]).ValueFromIndex[2]));      // company name lack
  90.         end;
  91.   end;
  92.   WMIResult.Free;
  93.   form1.Caption:='Total Process: '+inttostr(ListView1.Items.Count);
  94. end;
  95.  
  96. end.


help me  :(

« Last Edit: October 22, 2017, 05:05:23 am by Ericktux »

Ericktux

  • Sr. Member
  • ****
  • Posts: 345
Re: Get list of process
« Reply #18 on: October 24, 2017, 07:56:05 am »
any idea  :(

Jurassic Pork

  • Hero Member
  • *****
  • Posts: 1228
Re: Get list of process
« Reply #19 on: October 24, 2017, 09:08:55 am »
hello,
try to run your application as administrator.

Friendly, J.P
Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

Ericktux

  • Sr. Member
  • ****
  • Posts: 345
Re: Get list of process
« Reply #20 on: October 25, 2017, 10:16:28 pm »
thank you for answering my friend
I have tried and it comes out the same.  :(

which may be

ASerge

  • Hero Member
  • *****
  • Posts: 2223
Re: Get list of process
« Reply #21 on: October 25, 2017, 10:56:14 pm »
I have tried and it comes out the same.  :(
To open these processes, you need to get the SeDebugPrivilege privilege

Ericktux

  • Sr. Member
  • ****
  • Posts: 345
Re: Get list of process
« Reply #22 on: October 26, 2017, 10:32:24 am »
hi, I have tried these codes but they do not work for me...  :(

Code: Pascal  [Select][+][-]
  1. function EnabledDebugPrivilege(const bEnabled: Boolean):Boolean;  //提升权限
  2. var
  3.   hToken: THandle;
  4.   tp: TOKEN_PRIVILEGES;
  5.   a: DWORD;
  6. const
  7.   SE_DEBUG_NAME = 'SeDebugPrivilege';
  8. begin
  9.   Result:=False;
  10.   if (OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken)) then
  11.   begin
  12.     tp.PrivilegeCount :=1;
  13.     LookupPrivilegeValue(nil, SE_DEBUG_NAME, tp.Privileges[0].Luid);
  14.     if bEnabled then
  15.       tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
  16.     else
  17.       tp.Privileges[0].Attributes := 0;
  18.     a:=0;
  19.     AdjustTokenPrivileges(hToken, False, @tp, SizeOf(tp), nil, @a);
  20.     Result:= GetLastError = ERROR_SUCCESS;
  21.     CloseHandle(hToken);
  22.   end;
  23. end;

use:
Code: Pascal  [Select][+][-]
  1. EnabledDebugPrivilege(true);

also probe:

Code: Pascal  [Select][+][-]
  1. const
  2.   SE_CREATE_TOKEN_NAME = 'SeCreateTokenPrivilege';
  3.   SE_ASSIGNPRIMARYTOKEN_NAME = 'SeAssignPrimaryTokenPrivilege';
  4.   SE_LOCK_MEMORY_NAME = 'SeLockMemoryPrivilege';
  5.   SE_INCREASE_QUOTA_NAME = 'SeIncreaseQuotaPrivilege';
  6.   SE_UNSOLICITED_INPUT_NAME = 'SeUnsolicitedInputPrivilege';
  7.   SE_MACHINE_ACCOUNT_NAME = 'SeMachineAccountPrivilege';
  8.   SE_TCB_NAME = 'SeTcbPrivilege';
  9.   SE_SECURITY_NAME = 'SeSecurityPrivilege';
  10.   SE_TAKE_OWNERSHIP_NAME = 'SeTakeOwnershipPrivilege';
  11.   SE_LOAD_DRIVER_NAME = 'SeLoadDriverPrivilege';
  12.   SE_SYSTEM_PROFILE_NAME = 'SeSystemProfilePrivilege';
  13.   SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege';
  14.   SE_PROF_SINGLE_PROCESS_NAME = 'SeProfileSingleProcessPrivilege';
  15.   SE_INC_BASE_PRIORITY_NAME = 'SeIncreaseBasePriorityPrivilege';
  16.   SE_CREATE_PAGEFILE_NAME = 'SeCreatePagefilePrivilege';
  17.   SE_CREATE_PERMANENT_NAME = 'SeCreatePermanentPrivilege';
  18.   SE_BACKUP_NAME = 'SeBackupPrivilege';
  19.   SE_RESTORE_NAME = 'SeRestorePrivilege';
  20.   SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
  21.   SE_DEBUG_NAME = 'SeDebugPrivilege';
  22.   SE_AUDIT_NAME = 'SeAuditPrivilege';
  23.   SE_SYSTEM_ENVIRONMENT_NAME = 'SeSystemEnvironmentPrivilege';
  24.   SE_CHANGE_NOTIFY_NAME = 'SeChangeNotifyPrivilege';
  25.   SE_REMOTE_SHUTDOWN_NAME = 'SeRemoteShutdownPrivilege';
  26.   SE_UNDOCK_NAME = 'SeUndockPrivilege';
  27.   SE_SYNC_AGENT_NAME = 'SeSyncAgentPrivilege';
  28.   SE_ENABLE_DELEGATION_NAME = 'SeEnableDelegationPrivilege';
  29.   SE_MANAGE_VOLUME_NAME = 'SeManageVolumePrivilege';
  30.  
  31. // Enables or disables privileges debending on the bEnabled
  32. // Aktiviert oder deaktiviert Privilegien, abhängig von bEnabled
  33.  
  34. function NTSetPrivilege(sPrivilege: string; bEnabled: Boolean): Boolean;
  35. var
  36.   hToken: THandle;
  37.   TokenPriv: TOKEN_PRIVILEGES;
  38.   PrevTokenPriv: TOKEN_PRIVILEGES;
  39.   ReturnLength: Cardinal;
  40. begin
  41.   Result := True;
  42.   // Only for Windows NT/2000/XP and later.
  43.   if not (Win32Platform = VER_PLATFORM_WIN32_NT) then Exit;
  44.   Result := False;
  45.  
  46.   // obtain the processes token
  47.   if OpenProcessToken(GetCurrentProcess(),
  48.     TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
  49.   begin
  50.     try
  51.       // Get the locally unique identifier (LUID) .
  52.       if LookupPrivilegeValue(nil, PChar(sPrivilege),
  53.         TokenPriv.Privileges[0].Luid) then
  54.       begin
  55.         TokenPriv.PrivilegeCount := 1; // one privilege to set
  56.  
  57.         case bEnabled of
  58.           True: TokenPriv.Privileges[0].Attributes  := SE_PRIVILEGE_ENABLED;
  59.           False: TokenPriv.Privileges[0].Attributes := 0;
  60.         end;
  61.  
  62.         ReturnLength := 0; // replaces a var parameter
  63.         PrevTokenPriv := TokenPriv;
  64.  
  65.         // enable or disable the privilege
  66.  
  67.         AdjustTokenPrivileges(hToken, False, TokenPriv, SizeOf(PrevTokenPriv),
  68.           PrevTokenPriv, ReturnLength);
  69.       end;
  70.     finally
  71.       CloseHandle(hToken);
  72.     end;
  73.   end;
  74.   // test the return value of AdjustTokenPrivileges.
  75.   Result := GetLastError = ERROR_SUCCESS;
  76.   if not Result then
  77.     raise Exception.Create(SysErrorMessage(GetLastError));
  78. end;

use:
Code: Pascal  [Select][+][-]
  1. NTSetPrivilege(SE_DEBUG_NAME, true);

none works for me, I have the same result  :( :(
« Last Edit: October 26, 2017, 10:34:46 am by Ericktux »

Ericktux

  • Sr. Member
  • ****
  • Posts: 345
Re: Get list of process
« Reply #23 on: October 26, 2017, 11:27:58 am »
I have also tested adding "sedebugprivilege" to the "utilwmi.pas" code of "Jurassic Pork"

Code: Pascal  [Select][+][-]
  1.   try
  2.     FSWbemLocator   := CreateOleObject('WbemScripting.SWbemLocator');
  3.     FSWbemLocator.Security_.Privileges.AddAsString('sedebugprivilege', true);  // added to test
  4.     objWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');  

also so

Code: Pascal  [Select][+][-]
  1. const
  2.   wbemFlagForwardOnly = $00000020;
  3.   wbemPrivilegeDebug = $00000013;  
  4.   ...
  5.  
  6.     FSWbemLocator   := CreateOleObject('WbemScripting.SWbemLocator');
  7.     FSWbemLocator.Security_.Privileges.Add(wbemPrivilegeDebug, True);   // added to test
  8.     objWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');  


but same result  :(  :(

Ericktux

  • Sr. Member
  • ****
  • Posts: 345
Re: Get list of process
« Reply #24 on: October 27, 2017, 07:39:43 am »
good friend, after so much testing, finally get the complete list.  :D  :D
I share the three ways I use it.

method one:

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Buttons,
  9.   ComCtrls, Utilwmi, contnrs, lazUTF8;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BitBtn1: TBitBtn;
  17.     ListView1: TListView;
  18.     procedure BitBtn1Click(Sender: TObject);
  19.     procedure FormCreate(Sender: TObject);
  20.   private
  21.  
  22.   public
  23.  
  24.   end;
  25.  
  26. var
  27.   Form1: TForm1;
  28.  
  29.     function QueryFullProcessImageNameW(hProcess: THandle; dwFlags: DWORD;
  30.   lpExeName: LPWSTR; var lpdwSize: DWORD): BOOL; stdcall; external kernel32;
  31.  
  32. implementation
  33.  
  34. {$R *.lfm}
  35.  
  36. { TForm1 }
  37.  
  38. function EnabledDebugPrivilege(const bEnabled: Boolean):Boolean;  //提升权限
  39. var
  40.   hToken: THandle;
  41.   tp: TOKEN_PRIVILEGES;
  42.   a: DWORD;
  43. const
  44.   SE_DEBUG_NAME = 'SeDebugPrivilege';
  45. begin
  46.   Result:=False;
  47.   if (OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken)) then
  48.   begin
  49.     tp.PrivilegeCount :=1;
  50.     LookupPrivilegeValue(nil, SE_DEBUG_NAME, tp.Privileges[0].Luid);
  51.     if bEnabled then
  52.       tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
  53.     else
  54.       tp.Privileges[0].Attributes := 0;
  55.     a:=0;
  56.     AdjustTokenPrivileges(hToken, False, @tp, SizeOf(tp), nil, @a);
  57.     Result:= GetLastError = ERROR_SUCCESS;
  58.     CloseHandle(hToken);
  59.   end;
  60. end;
  61.  
  62. function GetProcessPath(PID: DWORD): string;
  63. const
  64.   PROCESS_QUERY_LIMITED_INFORMATION = $1000;
  65. var
  66.   HProcess: THandle;
  67.   WBuf: UnicodeString;
  68.   Len: DWORD;
  69. begin
  70.   Result := '';
  71.   HProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, PID);
  72.   if HProcess <> 0 then
  73.   try
  74.     SetLength(WBuf, 1000);
  75.     Len := 1000 + 1;
  76.     if QueryFullProcessImageNameW(HProcess, 0, Pointer(WBuf), Len) then
  77.     begin
  78.       SetLength(WBuf, Len);
  79.       Result := UTF8Encode(WBuf);
  80.  
  81.     end;
  82.   finally
  83.     CloseHandle(HProcess);
  84.   end;
  85. end;
  86.  
  87. function obtenerInfoFichero (info : string; fichero : string) : string;
  88. type
  89.   PaLeerBuffer = array [0..MAX_PATH] of char;
  90. var
  91.   Size, Size2 : DWord;
  92.   Pt, Pt2 : Pointer;
  93.   Idioma : string;
  94. begin
  95.   Result := '';
  96.   Size := GetFileVersionInfoSize(PChar (fichero), Size2);
  97.   if Size > 0 then
  98.   begin
  99.     GetMem (Pt, Size);
  100.     if GetFileVersionInfo (PChar (fichero), 0, Size, Pt) then
  101.     begin
  102.       VerQueryValue( Pt, '\VarFileInfo\Translation',Pt2, Size2);
  103.       Idioma:=IntToHex( DWord(Pt2^) ,8 );
  104.       Idioma:=Copy(Idioma,5,4)+Copy(Idioma,1,4);
  105.       VerQueryValue( Pt,Pchar('\StringFileInfo\'+Idioma+'\'+info),Pt2, Size2);
  106.       if Size2 > 0 then
  107.       begin
  108.        //Result:=Copy(PaLeerBuffer(Pt2^),1,Size2);  // original
  109.        Result:=WinCPToUTF8(Copy(PaLeerBuffer(Pt2^),1,Size2));
  110.       end
  111.       else
  112.         result := '';
  113.       FreeMem (Pt);
  114.     end;
  115.   end
  116.   else
  117.     result := '';
  118. end;
  119.  
  120. procedure TForm1.BitBtn1Click(Sender: TObject);
  121. var WMIResult         : TFPObjectList;
  122.  f             : integer;
  123.  retVal            : String;
  124. begin
  125.   //ChangePrivilegeModified;
  126.   EnabledDebugPrivilege(true);
  127.   Form1.ListView1.Clear;
  128.   WMIResult := GetWMIInfo('Win32_Process', ['name', 'ProcessId','ExecutablePath', 'WorkingSetSize']);
  129.   for f := 0 to Pred(WMIResult.Count) do
  130.   begin
  131.  
  132.   // ORIGINAL OF Jurassic Pork  ////////////////////////////////////////////////
  133.     {retVal := TStringList(WMIResult[f]).ValueFromIndex[0] + ' - Pid : ' +
  134.               TStringList(WMIResult[f]).ValueFromIndex[1] +  ' - Exec : ' +
  135.               TStringList(WMIResult[f]).ValueFromIndex[2];
  136.     Memo1.Lines.add(Retval);}
  137.   //////////////////////////////////////////////////////////////////////////////
  138.  
  139.     with Form1.ListView1.Items.Add do
  140.         begin
  141.         Caption:= TStringList(WMIResult[f]).ValueFromIndex[0];      // name of process
  142.         SubItems.Add(TStringList(WMIResult[f]).ValueFromIndex[1]);  // pid of process
  143.  
  144.         //SubItems.Add(TStringList(WMIResult[f]).ValueFromIndex[2]);  // path of process
  145.         SubItems.Add(GetProcessPath(StrToInt64(TStringList(WMIResult[f]).ValueFromIndex[1])));  // path of process modified
  146.  
  147.         SubItems.Add(TStringList(WMIResult[f]).ValueFromIndex[3]);  // ram used of process (bytes)
  148.         SubItems.Add(obtenerInfoFichero('FileDescription', GetProcessPath(StrToInt64(TStringList(WMIResult[f]).ValueFromIndex[1]))));  // description process
  149.         SubItems.Add(obtenerInfoFichero('CompanyName', GetProcessPath(StrToInt64(TStringList(WMIResult[f]).ValueFromIndex[1]))));      // company process
  150.         end;
  151.  
  152.   end;
  153.   WMIResult.Free;
  154.   form1.Caption:='Total Process: '+inttostr(ListView1.Items.Count);
  155. end;
  156.  
  157. procedure TForm1.FormCreate(Sender: TObject);
  158. begin
  159.  
  160. end;
  161. end.


method two:

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Windows, jwaTlHelp32, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
  9.   StdCtrls, JwaPsApi, LazUTF8;
  10.  
  11. const
  12.   SE_CREATE_TOKEN_NAME = 'SeCreateTokenPrivilege';
  13.   SE_ASSIGNPRIMARYTOKEN_NAME = 'SeAssignPrimaryTokenPrivilege';
  14.   SE_LOCK_MEMORY_NAME = 'SeLockMemoryPrivilege';
  15.   SE_INCREASE_QUOTA_NAME = 'SeIncreaseQuotaPrivilege';
  16.   SE_UNSOLICITED_INPUT_NAME = 'SeUnsolicitedInputPrivilege';
  17.   SE_MACHINE_ACCOUNT_NAME = 'SeMachineAccountPrivilege';
  18.   SE_TCB_NAME = 'SeTcbPrivilege';
  19.   SE_SECURITY_NAME = 'SeSecurityPrivilege';
  20.   SE_TAKE_OWNERSHIP_NAME = 'SeTakeOwnershipPrivilege';
  21.   SE_LOAD_DRIVER_NAME = 'SeLoadDriverPrivilege';
  22.   SE_SYSTEM_PROFILE_NAME = 'SeSystemProfilePrivilege';
  23.   SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege';
  24.   SE_PROF_SINGLE_PROCESS_NAME = 'SeProfileSingleProcessPrivilege';
  25.   SE_INC_BASE_PRIORITY_NAME = 'SeIncreaseBasePriorityPrivilege';
  26.   SE_CREATE_PAGEFILE_NAME = 'SeCreatePagefilePrivilege';
  27.   SE_CREATE_PERMANENT_NAME = 'SeCreatePermanentPrivilege';
  28.   SE_BACKUP_NAME = 'SeBackupPrivilege';
  29.   SE_RESTORE_NAME = 'SeRestorePrivilege';
  30.   SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
  31.   SE_DEBUG_NAME = 'SeDebugPrivilege';
  32.   SE_AUDIT_NAME = 'SeAuditPrivilege';
  33.   SE_SYSTEM_ENVIRONMENT_NAME = 'SeSystemEnvironmentPrivilege';
  34.   SE_CHANGE_NOTIFY_NAME = 'SeChangeNotifyPrivilege';
  35.   SE_REMOTE_SHUTDOWN_NAME = 'SeRemoteShutdownPrivilege';
  36.   SE_UNDOCK_NAME = 'SeUndockPrivilege';
  37.   SE_SYNC_AGENT_NAME = 'SeSyncAgentPrivilege';
  38.   SE_ENABLE_DELEGATION_NAME = 'SeEnableDelegationPrivilege';
  39.   SE_MANAGE_VOLUME_NAME = 'SeManageVolumePrivilege';
  40.  
  41. type
  42.  
  43.   { TForm1 }
  44.  
  45.   TForm1 = class(TForm)
  46.     Button1: TButton;
  47.     ListView1: TListView;
  48.     procedure Button1Click(Sender: TObject);
  49.     procedure FormCreate(Sender: TObject);
  50.   private
  51.  
  52.   public
  53.  
  54.   end;
  55.  
  56. var
  57.   Form1: TForm1;
  58.  
  59.   function QueryFullProcessImageNameW(hProcess: THandle; dwFlags: DWORD;
  60.   lpExeName: LPWSTR; var lpdwSize: DWORD): BOOL; stdcall; external kernel32;
  61.  
  62. implementation
  63.  
  64. {$R *.lfm}
  65.  
  66. { TForm1 }
  67.  
  68. function obtenerInfoFichero (info : string; fichero : string) : string;
  69. type
  70.   PaLeerBuffer = array [0..MAX_PATH] of char;
  71. var
  72.   Size, Size2 : DWord;
  73.   Pt, Pt2 : Pointer;
  74.   Idioma : string;
  75. begin
  76.   Result := '';
  77.   Size := GetFileVersionInfoSize(PChar (fichero), Size2);
  78.   if Size > 0 then
  79.   begin
  80.     GetMem (Pt, Size);
  81.     if GetFileVersionInfo (PChar (fichero), 0, Size, Pt) then
  82.     begin
  83.       VerQueryValue( Pt, '\VarFileInfo\Translation',Pt2, Size2);
  84.       Idioma:=IntToHex( DWord(Pt2^) ,8 );
  85.       Idioma:=Copy(Idioma,5,4)+Copy(Idioma,1,4);
  86.       VerQueryValue( Pt,Pchar('\StringFileInfo\'+Idioma+'\'+info),Pt2, Size2);
  87.       if Size2 > 0 then
  88.       begin
  89.        Result:=WinCPToUTF8(Copy(PaLeerBuffer(Pt2^),1,Size2));   // modificado
  90.       end
  91.       else
  92.         result := '';
  93.       FreeMem (Pt);
  94.     end;
  95.   end
  96.   else
  97.     result := '';
  98. end;
  99.  
  100. function NTSetPrivilege(sPrivilege: string; bEnabled: Boolean): Boolean;
  101. var
  102.   hToken: THandle;
  103.   TokenPriv: TOKEN_PRIVILEGES;
  104.   PrevTokenPriv: TOKEN_PRIVILEGES;
  105.   ReturnLength: Cardinal;
  106. begin
  107.   Result := True;
  108.   // Only for Windows NT/2000/XP and later.
  109.   if not (Win32Platform = VER_PLATFORM_WIN32_NT) then Exit;
  110.   Result := False;
  111.  
  112.   // obtain the processes token
  113.   if OpenProcessToken(GetCurrentProcess(),
  114.     TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
  115.   begin
  116.     try
  117.       // Get the locally unique identifier (LUID) .
  118.       if LookupPrivilegeValue(nil, PChar(sPrivilege),
  119.         TokenPriv.Privileges[0].Luid) then
  120.       begin
  121.         TokenPriv.PrivilegeCount := 1; // one privilege to set
  122.  
  123.         case bEnabled of
  124.           True: TokenPriv.Privileges[0].Attributes  := SE_PRIVILEGE_ENABLED;
  125.           False: TokenPriv.Privileges[0].Attributes := 0;
  126.         end;
  127.  
  128.         ReturnLength := 0; // replaces a var parameter
  129.         PrevTokenPriv := TokenPriv;
  130.  
  131.         // enable or disable the privilege
  132.  
  133.         AdjustTokenPrivileges(hToken, False, TokenPriv, SizeOf(PrevTokenPriv),
  134.           PrevTokenPriv, ReturnLength);
  135.       end;
  136.     finally
  137.       CloseHandle(hToken);
  138.     end;
  139.   end;
  140.   // test the return value of AdjustTokenPrivileges.
  141.   Result := GetLastError = ERROR_SUCCESS;
  142.   if not Result then
  143.     raise Exception.Create(SysErrorMessage(GetLastError));
  144. end;
  145.  
  146. function GetProcessPath(PID: DWORD): string;
  147. const
  148.   PROCESS_QUERY_LIMITED_INFORMATION = $1000;
  149. var
  150.   HProcess: THandle;
  151.   WBuf: UnicodeString;
  152.   Len: DWORD;
  153. begin
  154.   Result := '';
  155.   HProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, PID);
  156.   if HProcess <> 0 then
  157.   try
  158.     SetLength(WBuf, 1000);
  159.     Len := 1000 + 1;
  160.     if QueryFullProcessImageNameW(HProcess, 0, Pointer(WBuf), Len) then
  161.     begin
  162.       SetLength(WBuf, Len);
  163.       Result := UTF8Encode(WBuf);
  164.     end;
  165.   finally
  166.     CloseHandle(HProcess);
  167.   end;
  168. end;
  169.  
  170. procedure TForm1.Button1Click(Sender: TObject);
  171. const
  172.   PROCESS_QUERY_LIMITED_INFORMATION = $1000;
  173. var
  174.   Snapshot, hProcess: THandle;
  175.   ProcInfo: TProcessEntry32;
  176.   pmc: _PROCESS_MEMORY_COUNTERS;  // for ram used
  177. begin
  178.   NTSetPrivilege(SE_DEBUG_NAME,true);
  179.   pmc.cb := SizeOf(pmc) ; // me quede por aqui
  180.   Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  181.   if Snapshot <> INVALID_HANDLE_VALUE then
  182.   try
  183.     ProcInfo.dwSize := SizeOf(ProcInfo);
  184.     if Process32First(Snapshot, ProcInfo) then
  185.       repeat
  186.          with ListView1.Items.Add do
  187.          begin
  188.            Caption := UTF8Encode(ProcInfo.szExeFile);                 // name process
  189.            SubItems.Append(IntToStr(ProcInfo.th32ProcessID));         // PID process
  190.            SubItems.Append(GetProcessPath(ProcInfo.th32ProcessID));   // path process
  191.  
  192.            // CODE FOR GET RAM USED FOR EACH PROCESS
  193.            hProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, ProcInfo.th32ProcessID);
  194.            if HProcess <> 0 then
  195.                    begin
  196.                    if GetProcessMemoryInfo(hProcess, pmc, sizeof(pmc)) then
  197.                    begin
  198.                    // Usage in Bytes: pmc.WorkingSetSize
  199.                      SubItems.Append(IntToStr(pmc.WorkingSetSize));  // ram used of process (bytes)
  200.                    end
  201.                    else
  202.                    begin
  203.                    // fail
  204.                     SubItems.Append('');
  205.                    end;
  206.                    end
  207.                            else
  208.                                  begin
  209.                                  SubItems.Append('');
  210.                                  end;
  211.  
  212.            SubItems.Append(obtenerInfoFichero('FileDescription', GetProcessPath(ProcInfo.th32ProcessID)));  // description of process
  213.            SubItems.Append(obtenerInfoFichero('CompanyName', GetProcessPath(ProcInfo.th32ProcessID)));      // company name
  214.  
  215.          end;
  216.       until not Process32Next(Snapshot, ProcInfo);
  217.   finally
  218.     CloseHandle(Snapshot);
  219.   end;
  220.  
  221.   form1.Caption:='Total Process: '+inttostr(ListView1.Items.Count);
  222. end;
  223.  
  224. procedure TForm1.FormCreate(Sender: TObject);
  225. begin
  226.  
  227. end;
  228. end.


method three:

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  9.   ComCtrls, Variants, ComObj, ActiveX, lazutf8;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     Button1: TButton;
  17.     ListView1: TListView;
  18.     procedure Button1Click(Sender: TObject);
  19.     procedure FormCreate(Sender: TObject);
  20.   private
  21.  
  22.   public
  23.  
  24.   end;
  25.  
  26. var
  27.   Form1: TForm1;
  28.  
  29.       function QueryFullProcessImageNameW(hProcess: THandle; dwFlags: DWORD;
  30.   lpExeName: LPWSTR; var lpdwSize: DWORD): BOOL; stdcall; external kernel32;
  31.  
  32. implementation
  33.  
  34. {$R *.lfm}
  35.  
  36. { TForm1 }
  37.  
  38.  
  39. function GetProcessPath(PID: DWORD): string;
  40. const
  41.   PROCESS_QUERY_LIMITED_INFORMATION = $1000;
  42. var
  43.   HProcess: THandle;
  44.   WBuf: UnicodeString;
  45.   Len: DWORD;
  46. begin
  47.   Result := '';
  48.   HProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, PID);
  49.   if HProcess <> 0 then
  50.   try
  51.     SetLength(WBuf, 1000);
  52.     Len := 1000 + 1;
  53.     if QueryFullProcessImageNameW(HProcess, 0, Pointer(WBuf), Len) then
  54.     begin
  55.       SetLength(WBuf, Len);
  56.       Result := UTF8Encode(WBuf);
  57.  
  58.     end;
  59.   finally
  60.     CloseHandle(HProcess);
  61.   end;
  62. end;
  63.  
  64. function obtenerInfoFichero (info : string; fichero : string) : string;
  65. type
  66.   PaLeerBuffer = array [0..MAX_PATH] of char;
  67. var
  68.   Size, Size2 : DWord;
  69.   Pt, Pt2 : Pointer;
  70.   Idioma : string;
  71. begin
  72.   Result := '';
  73.   Size := GetFileVersionInfoSize(PChar (fichero), Size2);
  74.   if Size > 0 then
  75.   begin
  76.     GetMem (Pt, Size);
  77.     if GetFileVersionInfo (PChar (fichero), 0, Size, Pt) then
  78.     begin
  79.       VerQueryValue( Pt, '\VarFileInfo\Translation',Pt2, Size2);
  80.       Idioma:=IntToHex( DWord(Pt2^) ,8 );
  81.       Idioma:=Copy(Idioma,5,4)+Copy(Idioma,1,4);
  82.       VerQueryValue( Pt,Pchar('\StringFileInfo\'+Idioma+'\'+info),Pt2, Size2);
  83.       if Size2 > 0 then
  84.       begin
  85.        //Result:=Copy(PaLeerBuffer(Pt2^),1,Size2);  // original
  86.        Result:=WinCPToUTF8(Copy(PaLeerBuffer(Pt2^),1,Size2));
  87.       end
  88.       else
  89.         result := '';
  90.       FreeMem (Pt);
  91.     end;
  92.   end
  93.   else
  94.     result := '';
  95. end;
  96.  
  97. procedure ChangePrivilegeModified;
  98. var
  99.   NewState: TTokenPrivileges;
  100.   luid: TLargeInteger;
  101.   hToken: THandle;
  102.   ReturnLength: DWord;
  103. begin
  104.   if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES, hToken) then
  105.   begin
  106.    if LookupPrivilegeValue(nil, PChar('SeDebugPrivilege'), luid) then
  107.    begin
  108.     NewState.PrivilegeCount:= 1;
  109.     NewState.Privileges[0].Luid := luid;
  110.     NewState.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
  111.     if AdjustTokenPrivileges(hToken, False, NewState, SizeOf(TTokenPrivileges), PTOKEN_PRIVILEGES(nil)^, ReturnLength) then
  112.     begin
  113.       if GetLastError = ERROR_NOT_ALL_ASSIGNED then
  114.         ShowMessage('Change privilege failed: Not all assigned')
  115.       else
  116.         ShowMessage('Privileged');
  117.     end;
  118.    end;
  119.     CloseHandle(hToken);
  120.   end;
  121. end;
  122.  
  123. procedure TForm1.Button1Click(Sender: TObject);
  124. const
  125.   wbemFlagForwardOnly = $00000020;
  126.   {wbemPrivilegeDebug = $00000013;
  127.   wbemImpersonationLevelImpersonate = $00000003;}
  128. var
  129.   FSWbemLocator : OLEVariant;
  130.   FWMIService   : OLEVariant;
  131.   FWbemObjectSet: OLEVariant;
  132.   FWbemObject   : OLEVariant;
  133.   oEnum         : IEnumVariant;
  134.   iValue        : LongWord;
  135. begin
  136.   ChangePrivilegeModified;
  137.   CoInitialize(nil);
  138.   FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  139.   //FSWbemLocator.Security_.Privileges.AddAsString('sedebugprivilege', true);
  140.   //FSWbemLocator.Security_.Set_ImpersonationLevel(wbemImpersonationLevelImpersonate);
  141.   //FSWbemLocator.Security_.Privileges.Add(wbemPrivilegeDebug, True);
  142.  
  143.   FWMIService := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  144.   FWbemObjectSet:= FWMIService.ExecQuery('SELECT ExecutablePath, name, ProcessId, WorkingSetSize FROM Win32_Process','WQL',wbemFlagForwardOnly);
  145.   oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  146.   while oEnum.Next(1, FWbemObject, iValue) = 0 do
  147.  
  148.   begin
  149.     //if not VarIsNull(FWbemObject.ExecutablePath) then
  150.  
  151.     //begin
  152.       //Writeln(string(FWbemObject.ProcessId) + ': ' + string(FWbemObject.ExecutablePath));   // original
  153.       with Form1.ListView1.Items.Add do
  154.         begin
  155.         Caption:= FWbemObject.name;   // name process
  156.         SubItems.Add(FWbemObject.ProcessId);    // pid process
  157.         SubItems.Add(GetProcessPath(StrToInt(FWbemObject.ProcessId)));  // path of process modified
  158.  
  159.         {
  160.         if not VarIsNull(FWbemObject.ExecutablePath) then
  161.         begin
  162.         SubItems.Add(FWbemObject.ExecutablePath);   // path process
  163.  
  164.         end
  165.         else
  166.         begin
  167.         SubItems.Add('');
  168.         end;
  169.         }
  170.  
  171.         SubItems.Add(FWbemObject.WorkingSetSize);    // ram used for each process
  172.         SubItems.Add(obtenerInfoFichero('FileDescription', GetProcessPath(StrToInt(FWbemObject.ProcessId))));  // description process
  173.         SubItems.Add(obtenerInfoFichero('CompanyName', GetProcessPath(StrToInt(FWbemObject.ProcessId))));   // company process
  174.         end;
  175.  
  176.     FWbemObject:=Unassigned; //avoid memory leak in oEnum.Next
  177.   end;
  178.   form1.Caption:='Total Process: '+inttostr(ListView1.Items.Count);
  179. end;
  180.  
  181. procedure TForm1.FormCreate(Sender: TObject);
  182. begin
  183.  
  184. end;
  185. end.

I hope you serve them as much as I do.  :) :)
I share three ways to run "SeDebugPrivilege"
remember for more details "open as administrator"

attached projects and images

balazsszekely

  • Guest
Re: Get list of process
« Reply #25 on: October 27, 2017, 08:48:10 pm »
@Ericktux
It's a good start, thanks for the code, but I'm kinda disappointed by the fact that you give us a half-baked solution. What is missing:
1. Query the processes in a worker thread
2. Continuously refresh the list
3. Show a process tree instead of process list
4. Show icons for processes
5. Highlight newly created process
6. Highlight deleted process
7. Automatically elevate current process to the highest available execution level
8. Switch to full unicode support
etc..
« Last Edit: October 30, 2017, 08:06:56 am by GetMem »

balazsszekely

  • Guest
Re: Get list of process
« Reply #26 on: October 30, 2017, 08:04:49 am »
@Ericktux
I was thinking about something like this, see attached image.  The source of inspiration for visual appearance was Process Explorer from SysInernals. Few notes:

  1. You need VirtualStringTree. Both 4.x.x and 5.x.x series should be fine
  2. I did not test it extensively, so be prepared for bugs
  3. It can be further optimized, it's far from ideal. For example all properties are reinterrogate in each cycle. This is not needed since the process path, company name,  description is not changing once a process is started
  4. You should probably switch to WMI instead, I went with your second example where wmi is not uses
  5. Feel free to add more columns, like CPU usage,  bitness, etc...

To test just run the application then open, close other processes and see what happens.

Ericktux

  • Sr. Member
  • ****
  • Posts: 345
Re: Get list of process
« Reply #27 on: October 30, 2017, 08:46:27 am »
Excellent contribution my friend getmem.  :) :)
I will check it.

bonmario

  • Sr. Member
  • ****
  • Posts: 346
Re: Get list of process
« Reply #28 on: November 17, 2020, 09:14:31 am »
I was thinking about something like this, see attached image.  The source of inspiration for visual appearance was Process Explorer from SysInernals.

Hi GetMem, you did a great job.
I have a question: is it possible to write the command line instead of the path? If so, how?

Thanks in advance, Mario

balazsszekely

  • Guest
Re: Get list of process
« Reply #29 on: November 17, 2020, 09:44:42 am »
@bonmario
Quote
Hi GetMem, you did a great job.
I have a question: is it possible to write the command line instead of the path? If so, how?

Thanks in advance, Mario
Take a look at the following article: https://theroadtodelphi.com/2011/07/20/two-ways-to-get-the-command-line-of-another-process-using-delphi/
You can easily incorporate the code in the previously atteched application.

 

TinyPortal © 2005-2018