VB 通过进程PID获取该程序的窗口句柄函数

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, ByVa 4000 l 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
 

• 点赞
• 收藏
• 分享
• 文章举报