Delphi實(shí)現(xiàn)獲取進(jìn)程列表及相關(guān)信息的實(shí)例
Delphi實(shí)現(xiàn)獲取進(jìn)程列表及相關(guān)信息的實(shí)例
前言:
閑著沒事,看著任務(wù)管理器好玩,查資料先簡單實(shí)現(xiàn)一下,代碼中沒有加入獲取CPU占用率的代碼,這個(gè)代碼網(wǎng)上很多,只是不喜歡那種寫法,這里就不寫了。以后繼續(xù)完善,對(duì)于System Process和System的信息還沒法獲得,那位兄弟知道可以提個(gè)醒。
代碼如下
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)信息,運(yùn)行時(shí)需要以管理員身份運(yùn)行
}
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時(shí)間
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)建進(jìn)程快照
hSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
pEntry.dwSize := SizeOf(pEntry);
//第一個(gè)進(jìn)程
find := Process32First(hSnapShot,pEntry);
while find do
begin
item := Lv_Process.Items.Add;
//進(jìn)程名
item.Caption := pEntry.szExeFile;
//進(jìn)程ID
item.SubItems.Add(IntToStr(pEntry.th32ProcessID));
pPMCSize := SizeOf(PROCESS_MEMORY_COUNTERS);
GetMem(pPMC,pPMCSize);
pPMC.cb := pPMCSize;
//打開進(jìn)程,增加PROCESS_VM_READ權(quán)限,以便后面獲取完整路徑時(shí)使用
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,pEntry.th32ProcessID);
//獲取內(nèi)存信息
if GetProcessMemoryInfo(hProcess,pPMC,pPMCSize) then
begin
//取得進(jìn)程的用戶
item.SubItems.Add(GetProcessUser(hProcess));
//內(nèi)存使用
item.SubItems.Add(GetMemUsedText(pPMC.WorkingSetSize));
//內(nèi)存峰值
item.SubItems.Add(GetMemUsedText(pPMC.PeakWorkingSetSize));
//CPU時(shí)間
item.SubItems.Add(FormatDateTime('hh:mm:ss',GetProcCPUTime(hProcess)));
//獲取優(yōu)先級(jí)
ProcessPriority := GetPriorityClass(hProcess);
item.SubItems.Add(GetProcessPriority(ProcessPriority));
//根據(jù)進(jìn)程句柄找到模塊句柄
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 := '實(shí)時(shí)';
end;
end;
//獲取進(jìn)程的所屬用戶
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;
//獲取令牌信息,這里第三個(gè)參數(shù)使用了nil,是先返回實(shí)際大小dwSize,然后根據(jù)這個(gè)大小去分配內(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;
//查找用戶信息,先返回用戶名和域名的大小,當(dāng)然你也可以一次性得到,即不使用動(dòng)態(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.
運(yùn)行圖片

如有疑問請(qǐng)留言或者到本站社區(qū)交流討論,感謝閱讀,希望能幫助到大家,謝謝大家對(duì)本站的支持!
相關(guān)文章
截取指定符號(hào)之間的字符串(隨機(jī)讀取)delphi實(shí)例代碼
這篇文章主要介紹了截取指定符號(hào)之間的字符串(隨機(jī)讀取)delphi實(shí)例代碼,有需要的朋友可以參考一下2013-12-12
Delphi實(shí)現(xiàn)木馬文件傳輸代碼實(shí)例
這篇文章主要介紹了Delphi實(shí)現(xiàn)木馬文件傳輸?shù)姆椒?對(duì)于了解木馬的運(yùn)行原理有一定的幫助,需要的朋友可以參考下2014-07-07
Delphi實(shí)現(xiàn)圖片滾動(dòng)切換的完整實(shí)例代碼
這篇文章主要介紹了Delphi實(shí)現(xiàn)圖片滾動(dòng)切換的完整實(shí)例代碼,通過本實(shí)例,讀者可以進(jìn)一步掌握Delphi控件及圖形處理的技巧,需要的朋友可以參考下2014-07-07
Windows API GetLastError()函數(shù)返回值含義解釋
這篇文章主要介紹了Windows API GetLastError()函數(shù)返回值含義解釋,本文羅列了所有錯(cuò)誤代碼及中文注釋,需要的朋友可以參考下2015-05-05
Delphi實(shí)現(xiàn)樹型結(jié)構(gòu)具體實(shí)例
這篇文章介紹了Delphi實(shí)現(xiàn)樹型結(jié)構(gòu)具體實(shí)例,有需要的朋友可以參考一下2013-10-10
delphi7連接mysql5的實(shí)現(xiàn)方法
這篇文章主要介紹了delphi7連接mysql5的實(shí)現(xiàn)方法,需要的朋友可以參考下2014-07-07
Delphi實(shí)現(xiàn)獲取磁盤空間大小的方法
這篇文章主要介紹了Delphi實(shí)現(xiàn)獲取磁盤空間大小的方法,是一個(gè)很實(shí)用的功能,需要的朋友可以參考下2014-07-07
解決delphi TAdoQuery組件的close方法導(dǎo)致”列名無效“錯(cuò)誤的問題
今天小編就為大家分享一篇解決delphi TAdoQuery組件的close方法導(dǎo)致”列名無效“錯(cuò)誤的問題,具有很好的參考價(jià)值,希望對(duì)大家有所幫助。一起跟隨小編過來看看吧2020-02-02
Delphi 中內(nèi)存映射對(duì)于大文件的使用
這篇文章主要介紹了Delphi 中內(nèi)存映射對(duì)于大文件的使用的相關(guān)資料,希望通過本文能幫助到大家,需要的朋友可以參考下2017-09-09

