Sorry experts, I thought this might be the best place to post this problem. I'm actually using VBA to find multiple windows running under XP and determine if the window is busy or not, ie waiting for user input.
I have some code that can enumerate through all top level windows and identify the windows I'm interested in and find out some key information on the window. The problem I have now is that I can't seem to identify if the window is busy or not. I've played around with "WaitForSingleObject" and "WaitForInputIdle" without much success. Any ideas on where I'm going wrong ?
The code I have so far is this .......
I have some code that can enumerate through all top level windows and identify the windows I'm interested in and find out some key information on the window. The problem I have now is that I can't seem to identify if the window is busy or not. I've played around with "WaitForSingleObject" and "WaitForInputIdle" without much success. Any ideas on where I'm going wrong ?
The code I have so far is this .......
Code:
Option Explicit
Public Const MAX_PATH = 260
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Declare Function IsWindowEnabled Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function GetActiveWindow Lib "user32.dll" () As Long
Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal fuFlags As Long, ByVal uTimeout As Long, pdwResult As Long) As Long
Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Public Function fEnumWindows() As Boolean
Dim hWnd As Long
' The EnumWindows function enumerates all top-level windows
Call EnumWindows(AddressOf fEnumWindowsCallBack, hWnd)
End Function
Public Function fEnumWindowsCallBack(ByVal hWnd As Long, ByVal lpData As Long) As Long
Dim lResult As Long
Dim lThreadId As Long
Dim lProcessId As Long
Dim sWndName As String
Dim sClassName As String
Dim lProcessHandle As Long
Dim window_name As String
Dim ret As Variant
window_name = "Microsoft"
fEnumWindowsCallBack = 1
sClassName = Space$(MAX_PATH)
sWndName = Space$(MAX_PATH)
lResult = GetClassName(hWnd, sClassName, MAX_PATH)
sClassName = Left$(sClassName, lResult)
lResult = GetWindowText(hWnd, sWndName, MAX_PATH)
sWndName = Left$(sWndName, lResult)
If (sWndName <> "" And InStr(1, sWndName, window_name) > 0) Then
lThreadId = GetWindowThreadProcessId(hWnd, lProcessId)
lProcessHandle = OpenProcess(&H1F0000, True, lProcessId)
'**********************************************************************
'need some routine to check if window is busy or waiting for user input
'**********************************************************************
'ret = WaitForSingleObject(lProcessHandle, 10) '-1& INFINITE
'WaitForInputIdle lProcessHandle, 250
MsgBox "Active Window:" & CStr(GetActiveWindow()) & vbCrLf & vbCrLf & _
"Window Handle :" & CStr(hWnd) & vbCrLf & vbCrLf & _
"Class Name:" & sClassName & vbCrLf & vbCrLf & _
"Process ID:" & CStr(lProcessId) & vbCrLf & vbCrLf & _
"Thread ID:" & CStr(lThreadId) & vbCrLf & vbCrLf & _
"Window Name:" & sWndName & vbCrLf & vbCrLf & _
"Window Enabled:" & IsWindowEnabled(hWnd) & vbCrLf & vbCrLf & _
"Application Responding:" & ApplicationResponding(hWnd) & vbCrLf & vbCrLf & _
"Window State:" & ret 'a window state needs defining properly
End If
End Function
Function ApplicationResponding(lHwnd As Long, Optional lWaitTimeOut As Long = 2000) As Boolean
Dim lResult As Long
Dim lReturn As Long
Const SMTO_BLOCK = &H1, SMTO_ABORTIFHUNG = &H2, WM_NULL = &H0
lReturn = SendMessageTimeout(lHwnd, WM_NULL, 0&, 0&, SMTO_ABORTIFHUNG And SMTO_BLOCK, lWaitTimeOut, lResult)
If lReturn Then
ApplicationResponding = True
Else
ApplicationResponding = False
End If
End Function