Option Explicit Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String,ByVal lpWindowName As String) As Long Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long,lpdwProcessId As Long) As Long Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long,ByVal bInheritHandle As Long,ByVal dwProcId As Long) As Long Public Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long,ByRef lphModule As Long,ByVal cb As Long,ByRef cbNeeded As Long) As Long Public Declare Function GetModuleFileNameEx Lib "psapi.dll" Alias "GetModuleFileNameExA" (ByVal hProcess As Long,ByVal hModule As Long,ByVal ModuleName As String,ByVal nSize As Long) As Long Public Const PROCESS_QUERY_INFORMATION = &H400 Public Const PROCESS_VM_READ = &H10 Sub main() If FindWindow(vbNullString,"计算器") = 0 Then Shell "calc.exe" End If Debug.Print GetModuleFileNameByHwnd(FindWindow(vbNullString,"计算器")) End Sub '<> '******************************************************************************** ' 函数: GetModuleFileNameByHwnd ' 功能: 通过窗口句柄得到模块名称 '******************************************************************************** '<> Public Function GetModuleFileNameByHwnd(ByVal hWindow As Long) As String Dim dwProcId As Long Dim hProcess As Long Dim hModule As Long Dim nRet As Long Dim szBuf As String Const MAX_SIZE As Long = 256 If hWindow <= 0 Then Exit Function '' 得到进程ID Call GetWindowThreadProcessId(hWindow,dwProcId) If dwProcId = 0 Then Exit Function '' 根据进程ID,取得进程的句柄 hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ,dwProcId) If hProcess = 0 Then Exit Function '' 枚举进程中的各个模块 nRet = EnumProcessModules(hProcess,hModule,4&,0&) If nRet = 0 Then Exit Function '' 最后用下面这个函数得到可执行文件的名称 szBuf = String$(MAX_SIZE,vbNullChar) GetModuleFileNameEx hProcess,szBuf,Len(szBuf) GetModuleFileNameByHwnd = StripNulls(szBuf) End Function ' '----------------------------------------------------------------------------- ' '*********************************************************** ' 函数: StripNulls ' 功能: 清除字符串中多余的Null '*********************************************************** Public Function StripNulls(ByRef szOriginal As String) As String Dim i As Long i = InStr(szOriginal,vbNullChar) If i > 0 Then szOriginal = Left$(szOriginal,i - 1) End If StripNulls = szOriginal End Function
参考: @L_502_0@