大悟还俗

邮箱 key_ok@qq.com 我的收集 http://pan.baidu.com/share/home?uk=1177427271
  新随笔  :: 联系 :: 订阅 订阅  :: 管理

获取进程列表及相关信息

Posted on 2013-11-18 17:25  大悟还俗_2  阅读(290)  评论(0编辑  收藏  举报
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.
View Code