This isn't anything terribly special, but it is something I've been wanting to do for some time.
It's just a top-level window enumeration, but it's accomplished without any global nor module level variables. I've done similar things with other API enumerations (using the lpData argument), but I've just never done it for the EnumWindows API. I particularly like it when all variables are kept local (or just passed to sub-procedures (or, in this case, callbacks)).
So, here it is (best in a BAS module):
And here's some test code for a Form1:
You can take out the GetCurrentProcessId (and let it default to -1) to get ALL top level windows, but it'll probably overflow the Immediate window.
Enjoy,
Elroy
It's just a top-level window enumeration, but it's accomplished without any global nor module level variables. I've done similar things with other API enumerations (using the lpData argument), but I've just never done it for the EnumWindows API. I particularly like it when all variables are kept local (or just passed to sub-procedures (or, in this case, callbacks)).
So, here it is (best in a BAS module):
Code:
Option Explicit
'
Private Declare Sub SafeArrayAllocDescriptor Lib "oleaut32" (ByVal cDims As Long, ByRef psaInOut As Long)
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function vbaObjSetAddref Lib "msvbvm60" Alias "__vbaObjSetAddref" (ByRef dstObject As Any, ByRef srcObjPtr As Any) As Long
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (a() As Any) As Long
'
Public Function hWndOfAllTopLevelWindows(Optional iSpecificProcessId As Long = -1&) As Long()
' Returns a 0 to -1 array if none found, but it ALWAYS returns a dimensioned array (so that LBound and UBound can be used).
' The caller should use GetCurrentProcessId if you wish to get windows for just this process.
'
Dim hWndsColl As New Collection
' Gather ALL of them.
EnumWindows AddressOf EnumWindowsCallBack, ObjPtr(hWndsColl) ' Doesn't return until done.
' See if we only want a specific PID, and delete non-matches if so.
If iSpecificProcessId <> -1& Then
Dim i As Long
For i = hWndsColl.Count To 1& Step -1&
If ProcessId(CLng(hWndsColl.Item(i))) <> iSpecificProcessId Then hWndsColl.Remove i
Next
End If
' Transfer into our return array.
If hWndsColl.Count Then
hWndOfAllHelper hWndOfAllTopLevelWindows, hWndsColl
Else
SafeArrayAllocDescriptor 1&, ByVal ArrPtr(hWndOfAllTopLevelWindows) ' Makes a 0 to -1 array.
End If
End Function
Private Sub hWndOfAllHelper(hArray() As Long, coll As Collection)
ReDim hArray(coll.Count - 1&)
Dim v As Variant
Dim iPtr As Long
For Each v In coll
hArray(iPtr) = v
iPtr = iPtr + 1&
Next
End Sub
Private Function EnumWindowsCallBack(ByVal hWnd As Long, ByVal lpData As Long) As Long
Dim coll As Collection ' Will de-reference when we fall out of scope.
vbaObjSetAddref coll, ByVal lpData
coll.Add hWnd
EnumWindowsCallBack = 1&
End Function
Public Function ProcessId(hWndOfInterest As Long) As Long
Call GetWindowThreadProcessId(hWndOfInterest, ProcessId)
End Function
Code:
Option Explicit
'
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long ' Returns OUR PID.
Private Declare Function GetWindowTextLengthW Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowTextW Lib "user32" (ByVal hWnd As Long, ByVal lpString As Long, ByVal cch As Long) As Long
'
Private Sub Form_Load()
Dim ia() As Long
ia = hWndOfAllTopLevelWindows(GetCurrentProcessId) ' Limit it to just our windows.
Debug.Print "Count: "; UBound(ia) - LBound(ia) + 1&
Dim i As Long
For i = LBound(ia) To UBound(ia)
Debug.Print ia(i), ProcessId(ia(i)), WindowText(ia(i))
Next
Unload Me
End Sub
Public Function WindowText(hWndOfInterest As Long) As String
WindowText = Space$(GetWindowTextLengthW(hWndOfInterest))
WindowText = Left$(WindowText, GetWindowTextW(hWndOfInterest, StrPtr(WindowText), Len(WindowText) + 1&))
End Function
Enjoy,
Elroy