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

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.

运行图片

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