赞
踩
- 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, 0, 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, hModule, 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
Copyright © 2003-2013 www.wpsshop.cn 版权所有,并保留所有权利。