怎样在nt下得到进程的所在的路径?(100分)

michaelx · 2001-12-08

我看了这里的一篇文章说madshi可以不用psapi,还提供了下面的网址
http://nettrash.com/users/madshi/
不过我,找不到这个文件enumstuff.zip,谁以前下载了这个文件可以email给我
吗?yhmx@21cn.com thx!
不过我都想知怎样用psapi得知进程的路径

xianjun · 2001-12-08

用GetModuleFileNameEx就可以取得全路径。
看代码吧：

代码:

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls;

type
  TFormMain = class(TForm)
    Button1: TButton;
    TreeView1: TTreeView;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TreeView1DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.DFM}
const
  KILL_NOERR = 0;
  KILL_NOTSUPPORTED = -1;
  KILL_ERR_OPENPROCESS = -2;
  KILL_ERR_TERMINATEPROCESS = -3;

  ENUM_NOERR = 0;
  ENUM_NOTSUPPORTED = -1;
  ENUM_ERR_OPENPROCESSTOKEN = -2;
  ENUM_ERR_LookupPrivilegeValue = -3;
  ENUM_ERR_AdjustTokenPrivileges = -4;

  SE_DEBUG_NAME = 'SeDebugPrivilege';

var
  ProcessNameList, ProcessIDList, FullNameList: TStrings;

function EnumProcesses(lpidProcess, cb, cbNeeded: DWORD):
  Integer; stdcall; external 'PSAPI.DLL';

function EnumProcessModules(hProcess: THandle; lphModule: HMODULE; cb, lpcbNeeded: DWORD):
  Integer; stdcall; external 'PSAPI.DLL';

function GetModuleBaseNameA(hProcess: THandle; HMODULE: HMODULE; lpBaseName: PChar; nSize: DWORD):
  Integer; stdcall; external 'PSAPI.DLL';

function GetModuleFileNameExA(hProcess: THandle; HMODULE: HMODULE; lpFileName: PChar; nSize: DWORD):
  Integer; stdcall; external 'PSAPI.DLL';

procedure ErrorMessage;
var
  MsgBuf: string;
begin
  FormatMessage(
    FORMAT_MESSAGE_ALLOCATE_BUFFER or
    FORMAT_MESSAGE_FROM_SYSTEM or
    FORMAT_MESSAGE_IGNORE_INSERTS,
    nil,
    GetLastError(),
    LANG_NEUTRAL, //MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language
    @MsgBuf,
    SizeOf(MsgBuf),
    nil
    );
  MessageBox(0, PChar(MsgBuf), '错误', MB_OK);
  raise EAbort.Create('');
end;

procedure GetTokenInfo(ProcessId: THandle);
var
  InfoBuffer: TTokenPrivileges;
  I: Integer;
  ucPrivilegeName: string;
  dwPrivilegeNameSize, dwInfoBufferSize: DWORD;
  PrivilegesList: TStrings;
  hToken, hProcess: THandle;
  S: string;
  P: PChar;
begin
  Exit;
  //get process handle from process id
  hProcess := OpenProcess(PROCESS_ALL_ACCESS,
    True, ProcessId);
  try
    if hProcess = 0 then
      ErrorMessage;
    //get token handle from process handle
    if not OpenProcessToken(hProcess,
      TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY or TOKEN_READ, hToken) then
    begin
      ErrorMessage;
    end;

    dwInfoBufferSize := 0;
    if not GetTokenInformation(hToken, TokenPrivileges, @InfoBuffer,
      1024 {SizeOf(TTokenPrivileges)}, dwInfoBufferSize) then
    begin
      ErrorMessage;
    end;

    dwPrivilegeNameSize := 255;
    SetLength(ucPrivilegeName, 255);
//    for I := 0 to InfoBuffer.PrivilegeCount - 1 do
    begin
      if LookupPrivilegeName(nil, InfoBuffer.Privileges[0].Luid,
        PChar(ucPrivilegeName), dwPrivilegeNameSize) then
        ShowMessage(Copy(ucPrivilegeName, 1, dwPrivilegeNameSize))
      else
        ErrorMessage;
    end;
  finally
    CloseHandle(hProcess);
  end;
end;

function EnableDebugPrivilegeNT: Integer;
var
  hToken: THandle;
  DebugValue: TLargeInteger;
  tkp: TTokenPrivileges;
  ReturnLength: DWORD;
  PreviousState: TTokenPrivileges;
begin
  if (OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY or TOKEN_READ, hToken) = False) then
    Result := ENUM_ERR_OPENPROCESSTOKEN
  else
  begin
    if (LookupPrivilegeValue(nil, SE_DEBUG_NAME, DebugValue) = False) then
      Result := ENUM_ERR_LookupPrivilegeValue
    else
    begin
      ReturnLength := 0;
      tkp.PrivilegeCount := 1;
      tkp.Privileges[0].Luid := DebugValue;
      tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      AdjustTokenPrivileges(hToken, False, tkp, SizeOf(TTokenPrivileges), PreviousState, ReturnLength);
      if (GetLastError &lt;&gt; ERROR_SUCCESS) then
        Result := ENUM_ERR_AdjustTokenPrivileges
      else
        Result := ENUM_NOERR;
    end;
  end;
end;

function Kill_By_Pid(pid: Longint): Integer;
var
  hProcess: THandle;
  TermSucc: BOOL;
begin
  hProcess := OpenProcess(PROCESS_ALL_ACCESS, True, pid);
  if (hProcess = 0) then // v 1.2 : was =-1
  begin
    Result := KILL_ERR_OPENPROCESS;
  end
  else
  begin
    TermSucc := TerminateProcess(hProcess, 0);
    if (TermSucc = False) then
      Result := KILL_ERR_TERMINATEPROCESS
    else
      Result := KILL_NOERR;
  end;
end;

procedure UpdateTreeView(Tree: TTreeView);
var
  I: Integer;
  MyNode: TTreeNode;
begin
  with Tree.Items do
  begin
    Clear;
    if MyNode &lt;&gt; nil then
      MyNode := nil;

    for I := 0 to FullNameList.Count - 1 do
    begin
      if (MyNode = nil) or (UpperCase(Copy(FullNameList[I], Length(FullNameList[I]) - 2, 3)) = 'EXE') then
        MyNode := Add(nil, FullNameList[I])
      else
        AddChild(MyNode, FullNameList[I]);
    end;
  end;
end;

procedure PrintProcessNameAndID(ProcessId: DWORD);
var
  //   szProcessName:ARRAY[0..1024] OF CHAR;
  szFullName: array[0..1024] of Char;
  szModName: array[0..1024] of Char;
  hProcess: THandle;
  hMods: array[0..1024] of DWORD;
  cbNeeded, cMod: DWORD;
  I: Integer;
begin
  // Get a handle to the process.
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
    PROCESS_VM_READ,
    False, ProcessId);
  // Get the process name.
  szModName := 'unknown';
  szFullName := 'unknown';
  if (hProcess &lt;&gt; 0) then
  begin
    if EnumProcessModules(hProcess, DWORD(@hMods), SizeOf(hMods), DWORD(@cbNeeded)) &lt;&gt; 0 then
    begin
      //            GetModuleBaseNameA( hProcess, hMod, szProcessName,sizeof(szProcessName) );
      //            GetModuleFileNameExA(hProcess, hMod, szFullName,sizeof(szFullName));
      cMod := cbNeeded div SizeOf(HMODULE);
      for I := 0 to (cMod - 1) do
      begin
        // Get the full path to the module's file.
        GetModuleBaseNameA(hProcess, hMods[I], szModName, SizeOf(szModName));
        GetModuleFileNameExA(hProcess, hMods[I], szFullName, SizeOf(szModName));
        ProcessNameList.Add(StrPas(szModName));
        FullNameList.Add(StrPas(szFullName));
      end;
    end;
  end;

  // Print the process name and identifier.

  //Form1.Memo1.Lines.Add (StrPas(szProcessName));
//    ProcessNameList.Add (StrPas(szProcessName));
//    FullNameList.Add (StrPas(szFullName));

  CloseHandle(hProcess);

end;

procedure TFormMain.Button1Click(Sender: TObject);
var
  cbNeeded, cProcesses: DWORD;
  aProcesses: array[0..1024] of DWORD;
  I: Cardinal;
begin
  if EnumProcesses(DWORD(@aProcesses), SizeOf(aProcesses), DWORD(@cbNeeded)) &lt;&gt; 0 then
  begin
    cProcesses := cbNeeded div SizeOf(DWORD);
  end
  else
    showmessage(IntToStr(GetLastError));

  if ProcessIDList &lt;&gt; nil then
    processidlist.Clear
  else
    ProcessIDList := TStringList.Create;

  if ProcessNameList &lt;&gt; nil then
    ProcessNameList.Clear
  else
    ProcessNameList := TStringList.Create;

  if FullNameList &lt;&gt; nil then
    FullNameList.Clear
  else
    FullNameList := TStringList.Create;

  for I := 0 to cprocesses - 1 do
    processidlist.Add(IntToStr(aProcesses[I]));

  for I := 0 to cProcesses - 1 do
  begin
    PrintProcessNameAndID(StrToInt(ProcessIDList[I]));
  end;
  //     Memo1.lines:=ProcessNameList;
  UpdateTreeView(FormMain.TreeView1);
end;

procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if ProcessIDList &lt;&gt; nil then
    ProcessIDList.Free;
  if ProcessNameList &lt;&gt; nil then
    ProcessNameList.Free;
  if FullNameList &lt;&gt; nil then
    FullNameList.Free;
end;

procedure TFormMain.TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  MyNode: TTreeNode;
begin
  MyNode := TreeView1.GetNodeAt(X, Y);
  if MyNode &lt;&gt; nil then
  begin
    MyNode.Selected := True;
    if MyNode.HasChildren then
    begin
      Caption := '[' + ProcessIDList[MyNode.Index] + ']' + FullNameList[MyNode.AbsoluteIndex];
      GetTokenInfo(StrToInt(ProcessIDList[MyNode.Index]));
    end
    else
      Caption := FullNameList[MyNode.AbsoluteIndex];
  end;
end;

procedure TFormMain.TreeView1DblClick(Sender: TObject);
var
  MyNode: TTreeNode;
begin
  MyNode := TreeView1.Selected;
  if (MyNode &lt;&gt; nil) and (MyNode.HasChildren) then
  begin
    showmessage(IntToStr(Kill_By_Pid(StrToInt(ProcessIDList[MyNode.Index]))));
  end;

end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  EnableDebugPrivilegeNT;
end;

procedure TFormMain.Button2Click(Sender: TObject);
var
  S: string;
  P: PChar;
begin
  P := StrAlloc(128);
  StrCopy(P, 'aa');
  //p:='aaa';
  S := StrPas(P);
  showmessage(S);

  StrDispose(P);
end;

end.


DFM：
object FormMain: TFormMain
  Left = 192
  Top = 107
  Width = 439
  Height = 480
  Caption = 'FormMain'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = '宋体'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  OnCreate = FormCreate
  DesignSize = (
    431
    453)
  PixelsPerInch = 96
  TextHeight = 12
  object Button1: TButton
    Left = 351
    Top = 424
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'GetProcess'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 263
    Top = 424
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'Button2'
    TabOrder = 1
    OnClick = Button2Click
  end
  object TreeView1: TTreeView
    Left = 8
    Top = 8
    Width = 416
    Height = 409
    Anchors = [akLeft, akTop, akRight, akBottom]
    Indent = 19
    TabOrder = 2
    OnDblClick = TreeView1DblClick
    OnMouseDown = TreeView1MouseDown
  end
end

！雅龙 · 2001-12-11

哇！！！这是什么啊？？！！只要解决取的路径就可以了啊，用不着这样吧？？！！

不过还是谢谢！！：）

简单的取得路径，谁会？？？

xianjun · 2001-12-11

你不要告诉我说这你看不懂!
这就是最简单的PSAPI的DEMO了
下面这句就是取得全路径：
GetModuleFileNameExA(hProcess, hMods, szFullName, SizeOf(szModName));

！雅龙 · 2001-12-11

那么怎么获得该进程所占用的cpu and cpu time ????

YB_unique · 2001-12-11

呵呵！xianjun在吓小孩子！

xianjun · 2001-12-11

呵呵　怎么敢啊　[8D]

取得进程用去的CPU时间：
GetProcessTimes

DragonPC_??? · 2001-12-12

experts-exchange 有一封帖子 Madshi 提供了下载地址，我不知道下载以后放到哪里去了。

icysword · 2001-12-29

用CreateToolhelp32Snapshot获取进程快照后, PROCESSENTRY32.szExeFile在win98下也能得
到进程全路径名. 但在win2000下不行, 我曾试过用 GetModuleHandle 函数获取进程模块
句柄 modulehandle:=GetModuleHandle(pchar(extractfilename(proceentry32.szExeFile)))
然后再用 GetModuleFileName 得到进程全路径名,
if modulehandle<>0 then
GetModuleHandle(modulehandle,exefilepath,260); // exefilepath 即为全路径名
但得到的进程并非完全的. 也就是说系统后台还有一些进程尚未列出, 经分析是因为 modulehandl
变量返回值为0所造成,
在此请教各位, 为何 GetModuleHandle 会返回0呢?? 我已指定模块了呀, 函数为什么得不到
所指模块的句柄呢??

zyy04 · 2003-10-14

接受答案了.

怎样在nt下得到进程的所在的路径?(100分)

michaelx

Unregistered / Unconfirmed

xianjun

Unregistered / Unconfirmed

！雅龙

Unregistered / Unconfirmed

xianjun

Unregistered / Unconfirmed

！雅龙

Unregistered / Unconfirmed

YB_unique

Unregistered / Unconfirmed

xianjun

Unregistered / Unconfirmed

DragonPC_???

Unregistered / Unconfirmed

icysword

Unregistered / Unconfirmed

zyy04

Unregistered / Unconfirmed

Similar threads