用普通的API函数只能获取 32位进程的路径，64位进程的路径就无法获取了。得用采用获取dos路径模式。模块代码如下
Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetProcessImageFileNameA Lib "psapi.dll" (ByVal hProcess As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function QueryDosDevice Lib "kernel32" Alias "QueryDosDeviceA" (ByVal lpDeviceName As String, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
'把DOS路径转化为正常的 路径
Private Function pvReplaceDevice(sPath As String) As String
Dim sDrive As String
Dim sDevice As String
Dim lIdx As Long
For lIdx = 0 To 25
sDrive = Chr$(65 + lIdx) & ":"
sDevice = Space(1000)
If QueryDosDevice(sDrive, sDevice, Len(sDevice)) <> 0 Then
sDevice = Left$(sDevice, InStr(sDevice, Chr$(0)) - 1)
' Debug.Print sDrive; "="; sDevice
If LCase$(Left$(sPath, Len(sDevice))) = LCase$(sDevice) Then
pvReplaceDevice = sDrive & Mid$(sPath, Len(sDevice) + 1)
Exit Function
End If
End If
Next
pvReplaceDevice = sPath
End Function
'根据进程号获取进程路径函数：
Public Function GetProcessPathByHWND(hwd_ As Long) As String
On Error GoTo Z
Dim cbNeeded As Long
Dim szBuf(1 To 250) As Long
Dim Ret As Long
Dim szPathName As String
Dim nSize As Long
Dim hProcess As Long
Dim 进程Pid As Long
Dim 窗口句柄 As Long
窗口句柄 = hwd_
GetWindowThreadProcessId 窗口句柄, 进程Pid
hProcess = OpenProcess(&H1F0FFF, 0, 进程Pid)
If hProcess <> 0 Then
'Ret = EnumProcessModules(hProcess, szBuf(1), 250, cbNeeded)
Ret = EnumProcessModules(hProcess, szBuf(1), 250, cbNeeded)
szPathName = Space(500)
nSize = 500
If Ret <> 0 Then
Ret = GetModuleFileNameExA(hProcess, szBuf(1), szPathName, nSize)
GetProcessPathByHWND = Left(szPathName, Ret)
'MsgBox szPathName
Else
Ret = GetProcessImageFileNameA(hProcess, szPathName, nSize)
'MsgBox Ret
GetProcessPathByHWND = pvReplaceDevice(Left(szPathName, Ret)) 'dos路径转化为正常的路径
End If
End If
Ret = CloseHandle(hProcess)
If GetProcessPathByHWND = "" Then
GetProcessPathByHWND = ""
End If
Exit Function
Z:
End Function
窗体代码如下 参数是 窗口句柄
Private Sub Command1_Click()
Text1 = GetProcessPathByHWND(Me.hwnd)
End Sub