根据窗口句柄获取所在程序路径 - 回复 "Haiwen" 的问题

问题来源: http://www.cnblogs.com/del/archive/2008/07/30/1255869.html#1272342

---

本例效果图:

---

代码文件:

---

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;



type

  TForm1 = class(TForm)

    Button1: TButton;

    Button2: TButton;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



uses PsAPI; {GetModuleFileNameEx 函数需要它}



{根据窗口句柄获取所在程序路径的函数}

function GetProcessExePath(h: HWND): string;

var

  pid: Cardinal;

  pHandle: THandle;

  buf: array[0..MAX_PATH] of Char;

begin

  {先获取进程 ID}

  GetWindowThreadProcessId(h, @pid);

  {再获取进程句柄}

  pHandle := OpenProcess(PROCESS_ALL_ACCESS, False, pid);

  {获取进程路径}

  GetModuleFileNameEx(pHandle, 0, buf, Length(buf));

  CloseHandle(pHandle);

  Result := buf;

end;



{测试当前程序}

procedure TForm1.Button1Click(Sender: TObject);

var

  path: string;

begin

  path := GetProcessExePath(Handle);

  ShowMessage(path);

end;



{测试记事本 - 需要随便打开一个记事本}

procedure TForm1.Button2Click(Sender: TObject);

var

  wh: HWND;

  path: string;

begin

  wh := FindWindow('Notepad', nil);

  path := GetProcessExePath(wh);

  ShowMessage(path);

end;



end.


 
   

窗体文件:

---

object Form1: TForm1

  Left = 0

  Top = 0

  Caption = 'Form1'

  ClientHeight = 116

  ClientWidth = 471

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  Position = poDesktopCenter

  PixelsPerInch = 96

  TextHeight = 13

  object Button1: TButton

    Left = 112

    Top = 33

    Width = 233

    Height = 25

    Caption = 'Button1'

    TabOrder = 0

    OnClick = Button1Click

  end

  object Button2: TButton

    Left = 112

    Top = 64

    Width = 233

    Height = 25

    Caption = 'Button2'

    TabOrder = 1

    OnClick = Button2Click

  end

end