Delphi实现获取进程列表及相关信息的实例

前言：

闲着没事，看着任务管理器好玩，查资料先简单实现一下，代码中没有加入获取CPU占用率的代码，这个代码网上很多，只是不喜欢那种写法，这里就不写了。以后继续完善，对于System Process和System的信息还没法获得，那位兄弟知道可以提个醒。

代码如下

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} { 作用：提权到Debug，为了在Vista和Win7下读取系统信息，运行时需要以管理员身份运行 } function PromoteProcessPrivilege(Processhandle:Thandle;Token_Name:pchar):boolean; var Token:cardinal; TokenPri:_TOKEN_PRIVILEGES; Luid:int64; i:DWORD; begin Result:=false; //打开令牌 if OpenProcessToken(Processhandle,TOKEN_ADJUST_PRIVILEGES,Token) then begin //看系统权限的特权值 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; //提权 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; //获取CPU时间 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; //内存信息 pPMC:PPROCESS_MEMORY_COUNTERS; pPMCSize,ProcessPriority:Cardinal; n:DWORD; fName:array [0..MAX_PATH-1] of char; begin //创建进程快照 hSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); pEntry.dwSize := SizeOf(pEntry); //第一个进程 find := Process32First(hSnapShot,pEntry); while find do begin item := Lv_Process.Items.Add; //进程名 item.Caption := pEntry.szExeFile; //进程ID item.SubItems.Add(IntToStr(pEntry.th32ProcessID)); pPMCSize := SizeOf(PROCESS_MEMORY_COUNTERS); GetMem(pPMC,pPMCSize); pPMC.cb := pPMCSize; //打开进程，增加PROCESS_VM_READ权限，以便后面获取完整路径时使用 hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,pEntry.th32ProcessID); //获取内存信息 if GetProcessMemoryInfo(hProcess,pPMC,pPMCSize) then begin //取得进程的用户 item.SubItems.Add(GetProcessUser(hProcess)); //内存使用 item.SubItems.Add(GetMemUsedText(pPMC.WorkingSetSize)); //内存峰值 item.SubItems.Add(GetMemUsedText(pPMC.PeakWorkingSetSize)); //CPU时间 item.SubItems.Add(FormatDateTime('hh:mm:ss',GetProcCPUTime(hProcess))); //获取优先级 ProcessPriority := GetPriorityClass(hProcess); item.SubItems.Add(GetProcessPriority(ProcessPriority)); //根据进程句柄找到模块句柄 ENumProcessModules(hProcess,@hModel,SizeOf(hModel),n); //取得完整路径 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 := '低'; NORMAL_PRIORITY_CLASS: Result := '普通'; HIGH_PRIORITY_CLASS: Result := '高'; REALTIME_PRIORITY_CLASS: Result := '实时'; end; end; //获取进程的所属用户 function TForm1.GetProcessUser(hprocess: THandle): string; var hToken:THandle; dwSize,dwUserSize,dwDomainSize:DWORD; pUser:PTokenUser; szUserName, szDomainName: array of Char; peUse: SID_NAME_USE; begin //打开权限 if not OpenProcessToken(hprocess,TOKEN_QUERY,hToken) then Exit; //获取令牌信息，这里第三个参数使用了nil，是先返回实际大小dwSize，然后根据这个大小去分配内存 GetTokenInformation(hToken,TokenUser,nil,0,dwSize); pUser := nil; //分配空间 ReallocMem(pUser,dwSize); dwUserSize := 0; dwDomainSize := 0; //获取信息 if not GetTokenInformation(hToken,TokenUser,pUser,dwSize,dwSize) then Exit; //查找用户信息，先返回用户名和域名的大小，当然你也可以一次性得到，即不使用动态数组 LookupAccountSid(nil,pUser.User.Sid,nil,dwUserSize,nil,dwDomainSize,peUse); if (dwUserSize <> 0) and (dwDomainSize <> 0) then begin //分配长度 SetLength(szUserName,dwUserSize); SetLength(szDomainName,dwDomainSize); //再次，获取用户名和域名 LookupAccountSid(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.

运行图片

如有疑问请留言或者到本站社区交流讨论，感谢阅读，希望能帮助到大家，谢谢大家对本站的支持！