Example of Delphi implementation of obtaining process list and related information
Foreword:
I have nothing to do, and it’s fun to look at the task manager. I checked the information and implemented it briefly. There is no code to obtain the CPU usage in the code. There are many codes online. I just don’t like that way of writing, so I won’t write it here. We will continue to improve it in the future, but the information about System Process and System cannot be obtained yet. If anyone knows, I can give you a reminder.
The code is as follows
unit Main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,TlHelp32, StdCtrls, ComCtrls,psAPI; type PTokenUser = ^TTokenUser; _TOKEN_USER = record User: TSIDAndAttributes; end; TTokenUser = _TOKEN_USER; TForm1 = class(TForm) btn_Get: TButton; Lv_Process: TListView; procedure btn_GetClick(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } function GetMemUsedText(memsize:Cardinal):string; function GetProcessPriority(priority:Cardinal) :string; function GetCupUsedPercent(hprocess:THandle):string; function GetProcessUser(hprocess:THandle):string; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} { Function: Elevate privileges to Debug, in order to use Vista To read system information under Win7, you need to run it as an administrator} function PromoteProcessPrivilege(Processhandle:Thandle;Token_Name:pchar):boolean; var Token:cardinal; TokenPri:_TOKEN_PRIVILEGES; Luid:int64; i:DWORD; begin Result:=false; //Open token if OpenProcessToken(Processhandle,TOKEN_ADJUST_PRIVILEGES,Token) then begin //Look at the privilege value of system permissions if LookupPrivilegeValue(nil,Token_Name,Luid) then begin TokenPri.PrivilegeCount:=1; TokenPri.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED; TokenPri.Privileges[0].Luid:=Luid; i:=0; //Elevate rights if AdjustTokenPrivileges(Token,false,TokenPri,sizeof(TokenPri),nil,i) then Result:=true; end; end; CloseHandle(Token); end; function AddFileTimes(KernelTime, UserTime: TFileTime): TDateTime; var SysTimeK, SysTimeU : TSystemTime; begin FileTimeToSystemTime(KernelTime, SysTimeK); FileTimeToSystemTime(UserTime, SysTimeU); Result :=SystemTimeToDateTime(SysTimeK)+SystemTimeToDateTime(SysTimeU); end; //Get CPU time function GetProcCPUTime(procID:THandle): TDateTime; var CreationTime, ExitTime, KernelTime, UserTime: TFileTime; begin GetProcessTimes (procID, CreationTime, ExitTime, KernelTime,UserTime); Result := AddFileTimes(KernelTime, UserTime); end; procedure TForm1.btn_GetClick(Sender: TObject); var hSnapShot,hProcess,hModel:THandle; pEntry:TProcessEntry32; find:Boolean; item:TListItem; // Memory information pPMC:PPROCESS_MEMORY_COUNTERS; pPMCSize,ProcessPriority:Cardinal; n:DWORD; fName:array [0..MAX_PATH-1] of char; begin //Create a process snapshot hSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); pEntry.dwSize := SizeOf(pEntry); //The first process find := Process32First(hSnapShot,pEntry); while find do begin item := Lv_Process.Items.Add; //Process name item.Caption := pEntry.szExeFile; //Process ID item.SubItems.Add(IntToStr(pEntry.th32ProcessID)); pPMCSize := SizeOf(PROCESS_MEMORY_COUNTERS ); GetMem(pPMC,pPMCSize); pPMC.cb := pPMCSize; //Open the process and increase the PROCESS_VM_READ permission so that hProcess can be used to obtain the complete path later:= OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,pEntry.th32ProcessID); //Get memory information if GetProcessMemoryInfo(hProcess,pPMC,pPMCSize) then begin //Get the user of the process item.SubItems.Add(GetProcessUser(hProcess)); //Memory usage item.SubItems.Add(GetMemUsedText(pPMC.WorkingSetSize)); //Memory peak item.SubItems.Add(GetMemUsedText(pPMC. PeakWorkingSetSize)); //CPU time item.SubItems.Add(FormatDateTime('hh:mm:ss',GetProcCPUTime(hProcess))); //Get priority ProcessPriority := GetPriorityClass(hProcess); item.SubItems.Add(GetProcessPriority(ProcessPriority) ); //Find the module handle according to the process handle ENumProcessModules(hProcess,@hModel,SizeOf(hModel),n); //Get the complete path GetModuleFileNameEx(hProcess,hModel,fName,Length(fName)); item.SubItems.Add(fName) ; end; FreeMem(pPMC); CloseHandle(hProcess); find := Process32Next(hSnapShot,pEntry); end; end; function TForm1.GetCupUsedPercent(hprocess: THandle): string; begin end; function TForm1.GetMemUsedText(memsize: Cardinal): string; begin Result := IntToStr(memsize div 1024) + ' K'; end; function TForm1.GetProcessPriority(priority: Cardinal): string; begin case priority of IDLE_PRIORITY_CLASS: Result := 'low'; NORMAL_PRIORITY_CLASS: Result := 'normal'; HIGH_PRIORITY_CLASS: Result := 'high'; REALTIME_PRIORITY_CLASS: Result := 'real-time' ; end; end; //Get the user function of the process TForm1.GetProcessUser(hprocess: THandle): string; var hToken:THandle; dwSize,dwUserSize,dwDomainSize:DWORD; pUser:PTokenUser; szUserName, szDomainName: array of Char; peUse: SID_NAME_USE; begin / /Open permissions if not OpenProcessToken(hprocess,TOKEN_QUERY,hToken) then Exit; //Get token information, the third parameter here uses nil, which returns the actual size dwSize first, and then allocates memory according to this size GetTokenInformation(hToken,TokenUser,nil,0 ,dwSize); pUser := nil; //Allocate space ReallocMem(pUser,dwSize); dwUserSize := 0; dwDomainSize := 0; //Get information if not GetTokenInformation(hToken,TokenUser,pUser,dwSize,dwSize) then Exit; //To find user information, first return the user name and domain name size. Of course, you can also get it all at once, that is, without using the dynamic array LookupAccountSid(nil,pUser.User.Sid,nil,dwUserSize,nil,dwDomainSize,peUse); if ( dwUserSize <> 0) and (dwDomainSize <> 0) then begin //Allocate length SetLength(szUserName,dwUserSize); SetLength(szDomainName,dwDomainSize); //Again, get the user name and domain nameLookupAccountSid(nil,pUser.User.Sid,PChar(szUserName),dwUserSize,PChar(szDomainName),dwDomainSize, peUse); end; Result := PChar(szUserName)+'/'+PChar(szDomainName); CloseHandle(hToken); FreeMem(pUser); end; procedure TForm1.FormCreate(Sender: TObject); begin PromoteProcessPrivilege(GetCurrentProcess,'SeDebugPrivilege'); end; end.Run picture
If you have any questions, please leave a message or go to the community of this site to communicate and discuss. Thank you for reading. I hope it can help everyone. Thank you for your support of this site!