Delphi實作取得進程清單及相關資訊的實例
前言：
閒著沒事，看著任務管理器好玩，查資料先簡單實現一下，代碼中沒有加入獲取CPU佔用率的代碼，這個代碼網上很多，只是不喜歡那種寫法，這裡就不寫了。以後繼續完善，對於System Process和System的資訊還沒辦法取得，那位兄弟知道可以提個醒。
程式碼如下
unit Main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,TlHelp32, StdCtrls, ComCtrls,psAPI; type PTokenUser _TOKEN_USER; TForm1 = class(TForm) btn_Get: TButton; Lv_Process: TListView; procedure btn_GetClick(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations; GetProcessPriority(priority:Cardinal):string; function GetCupUsedPercent(hprocess:THandle):string; function GetProcessUser(hprocess:THandle):string; public { Public declarations } end; var Form1: TForm1;作用：提權到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; TokenPRIri.Privage:0]. 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)+SystemTimeKate; GetProcCPUTime(procID:THandle): TDateTime; var CreationTime, ExitTime, KernelTime, UserTime: TFileTime; begin GetProcessTimes(procID, CreationTime, ExitTime, KernelTime,UserTime); Result := AddFileTimes(KernelTime, Time); (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..1] of char; begin //建立進程快照hSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); pEntry.dwSize := SizeOf(pEntry); //第一個進程find := Process32First(hSnapShot,pEntry); while find do 處理程序 Processem := LAddProcessem Items. item.Caption := pEntry.szExeFile; //進程ID item.SubItems.Add(IntToStr(pEntry.th32ProcessID)); pPMCSize := SizeOf(PROCESS_MEMORY_COUNTERS); GetMem(pPMC,pPMCSize); pPMC.cb := pPMCSize; GetMem(pPMC,pPMCSize); pPMC.cb := pPMCSize; //Mem.後面取得完整路徑時使用hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,pEntry.th32ProcessID); //取得記憶體資訊if GetProcessMemoryInfo(hProcess,pPMC,pPMCSize) then begin //取得程序的使用者item.SubItems.AddProcess(GetUser(h)); //記憶體使用item.SubItems.Add(GetMemUsedText(pPMC.WorkingSetSize)); //記憶體峰值item.SubItems.Add(GetMemUsedText(pPMC.PeakWorkingSetSize)); //CPUtimeitem.SubItems.Add(FormatDate).Add(Formathhaate） :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; function TForm1.GetMemUsedText(memsize: Cardinal): string; begin Result := IntToStr(memsize div 1024) + ' K'; end; function TForm1.GetProcessPriority(priority: Cardinal): string; function TForm1.GetProcessPriority(priority: Cardinal): string; function TForm1.GetProcessPriority(priority: Cardinal): string; priginITY: PRIority_CLgin: PRIing;低'; NORMAL_PRIORITY_CLASS: Result := '普通'; HIGH_PRIORITY_CLASS: Result := '高'; REALTIME_PRIORITY_CLASS: Result := '實時'; end; end; //取得進程的所屬使用者function TForm1.GetProcess ' 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, Exhken) then; //取得令牌訊息，這裡第三個參數使用了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,PChardwszUserName), (szDomainName),dwDomainSize,peUse); end; Result := PChar(szUserName)+'/'+PChar(szDomainName); CloseHandle(hToken); FreeMem(pUser); end; procedure TForm1.FormCreate(Sender: TObject); begin PromoteProcessPrivilege(GetCurrentProcess,'DebugPrivile'Seend);運行圖片
如有疑問請留言或到本站社區交流討論，感謝閱讀，希望能幫助大家，謝謝大家對本站的支持！