欧美大屁股bbbbxxxx,狼人大香伊蕉国产www亚洲,男ji大巴进入女人的视频小说,男人把ji大巴放进女人免费视频,免费情侣作爱视频

歡迎來到入門教程網(wǎng)!

Delphi

當前位置:主頁 > 軟件編程 > Delphi >

Delphi實現(xiàn)獲取進程列表及相關(guān)信息的實例

來源:本站原創(chuàng)|時間:2020-01-10|欄目:Delphi|點擊: 次

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

網(wǎng)頁制作CMS教程網(wǎng)絡編程軟件編程腳本語言數(shù)據(jù)庫服務器

如果侵犯了您的權(quán)利,請與我們聯(lián)系,我們將在24小時內(nèi)進行處理、任何非本站因素導致的法律后果,本站均不負任何責任。

聯(lián)系QQ:835971066 | 郵箱:835971066#qq.com(#換成@)

Copyright © 2002-2020 腳本教程網(wǎng) 版權(quán)所有