Delphi實現(xiàn)獲取進程列表及相關(guān)信息的實例
Delphi實現(xiàn)獲取進程列表及相關(guān)信息的實例
前言:
閑著沒事,看著任務管理器好玩,查資料先簡單實現(xiàn)一下,代碼中沒有加入獲取CPU占用率的代碼,這個代碼網(wǎng)上很多,只是不喜歡那種寫法,這里就不寫了。以后繼續(xù)完善,對于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} { 作用:提權(quán)到Debug,為了在Vista和Win7下讀取系統(tǒng)信息,運行時需要以管理員身份運行 } 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 //看系統(tǒng)權(quán)限的特權(quán)值 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; //提權(quán) 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; //內(nèi)存信息 pPMC:PPROCESS_MEMORY_COUNTERS; pPMCSize,ProcessPriority:Cardinal; n:DWORD; fName:array [0..MAX_PATH-1] of char; begin //創(chuàng)建進程快照 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權(quán)限,以便后面獲取完整路徑時使用 hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,pEntry.th32ProcessID); //獲取內(nèi)存信息 if GetProcessMemoryInfo(hProcess,pPMC,pPMCSize) then begin //取得進程的用戶 item.SubItems.Add(GetProcessUser(hProcess)); //內(nèi)存使用 item.SubItems.Add(GetMemUsedText(pPMC.WorkingSetSize)); //內(nèi)存峰值 item.SubItems.Add(GetMemUsedText(pPMC.PeakWorkingSetSize)); //CPU時間 item.SubItems.Add(FormatDateTime('hh:mm:ss',GetProcCPUTime(hProcess))); //獲取優(yōu)先級 ProcessPriority := GetPriorityClass(hProcess); item.SubItems.Add(GetProcessPriority(ProcessPriority)); //根據(jù)進程句柄找到模塊句柄 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 //打開權(quán)限 if not OpenProcessToken(hprocess,TOKEN_QUERY,hToken) then Exit; //獲取令牌信息,這里第三個參數(shù)使用了nil,是先返回實際大小dwSize,然后根據(jù)這個大小去分配內(nèi)存 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; //查找用戶信息,先返回用戶名和域名的大小,當然你也可以一次性得到,即不使用動態(tài)數(shù)組 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.
運行圖片
如有疑問請留言或者到本站社區(qū)交流討論,感謝閱讀,希望能幫助到大家,謝謝大家對本站的支持!
上一篇:Windows API GetLastError()函數(shù)返回值含義解釋
欄 目:Delphi
下一篇:Delphi基本圖像處理方法匯總
本文標題:Delphi實現(xiàn)獲取進程列表及相關(guān)信息的實例
本文地址:http://mengdiqiu.com.cn/a1/Delphi/8599.html
您可能感興趣的文章
- 01-10在Delphi實現(xiàn)在數(shù)據(jù)庫中存取圖像的圖文演示無錯
- 01-10delphi建立、讀取、存貯INI文件的方法《三》
- 01-10Delphi Command模式
- 01-10delphi 正弦曲線圖
- 01-10delphi建立、讀取、存貯INI文件的方法《二》
- 01-10插件管理框架 for Delphi(二)
- 01-10插件管理框架 for Delphi(一)
- 01-10Delphi中判斷文件是否為文本文件的函數(shù)
- 01-10delphi中一個值得大家來考慮的DLL問題
- 01-10初探Delphi中的插件編程


閱讀排行
本欄相關(guān)
- 01-10在Delphi實現(xiàn)在數(shù)據(jù)庫中存取圖像的圖
- 01-10delphi建立、讀取、存貯INI文件的方法
- 01-10delphi 正弦曲線圖
- 01-10Delphi Command模式
- 01-10delphi建立、讀取、存貯INI文件的方法
- 01-10插件管理框架 for Delphi(二)
- 01-10插件管理框架 for Delphi(一)
- 01-10Delphi中判斷文件是否為文本文件的函
- 01-10delphi中一個值得大家來考慮的DLL問題
- 01-10初探Delphi中的插件編程
隨機閱讀
- 01-11Mac OSX 打開原生自帶讀寫NTFS功能(圖文
- 01-10C#中split用法實例總結(jié)
- 08-05dedecms(織夢)副欄目數(shù)量限制代碼修改
- 01-10SublimeText編譯C開發(fā)環(huán)境設(shè)置
- 08-05DEDE織夢data目錄下的sessions文件夾有什
- 01-10使用C語言求解撲克牌的順子及n個骰子
- 01-10delphi制作wav文件的方法
- 08-05織夢dedecms什么時候用欄目交叉功能?
- 01-11ajax實現(xiàn)頁面的局部加載
- 04-02jquery與jsp,用jquery