问题来源: 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