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

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.