W poprzednim artykule • Funkcje API - ile uruchomiono instancji MS Access • dowiedzieliśmy się jak wykorzystać interfejs API, aby odczytać ile instancji MS Access jest otwartych. Często informacja typu: „Otwarto 2 instancje MS Access” jest niewystarczająca. Oprócz ilości otwartych instancji MS Access, potrzebna jest informacja jakie instancje MS Access są otwarte. Odpowiedź na to pytanie nie jest łatwa (przynajmniej dla mnie). Jedynie co mogę zrobić, to określić ilość otwartych instancji MS Access i pobrać tytuły (nazwy) widniejące na pasku tytułowym otwartych okien MS Access.
Do tego celu wykorzystam interfejs Windows API i jego funkcję:
• FindWindowEx - zwracającą uchwyt okna potomnego, którego albo nazwa klasy, albo (i) tytuł odpowiadają
nazwom przekazanym w argumentach funkcji.
Z artykułu
• Funkcje API - jak pobrać nazwę klasy okna •
wiemy, że okno aplikacji MS Access jest klasy OMain, a jego „rodzicem” (właścicielem) jest główne
okno Windows, czyli Pulpit (ang. Desktop). Pobranie uchwytu Pulpitu umożliwia funkcja API • GetDesktopWindow.
W celu znalezienia pierwszego okna aplikacji MS Access powinniśmy wywołać funkcję • FindWindowEx następująco:
hDesktop =GetDesktopWindow
hwndNext =FindWindowEx(ByVal hDesktop, ByVal 0, ByVal "OMain", ByVal vbNullString)
' następne (ewentualne) instancje MS Access znajdziemy po przekazaniu do funkcjiFindWindowExznaleziony uchwyt okna hwndNext o ile jest różny od 0 (zera)
hwndNext =FindWindowEx(ByVal hDesktop, ByVal hwndNext, ByVal "OMain", ByVal vbNullString)
Wiedząc jak znaleźć okna aplikacji MS Access, zostaje nam tylko pobranie tytułu okna.W tym celu skorzystam z własnej funkcji GetTextWindow(...)
zwracającą tekst (tytuł) okna o przekazanym w argumencie uchwycie hwnd. Funkcja ta korzysta z dwóch innych funkcji API:
• GetWindowTextLength - zwracającą długość tekstu okna o przekazanym w argumencie uchwycie hwnd
• GetWindowText - zwracającą długość pobranego do buforu tekstu okna, a w buforze właściwy tekst okna o uchwycie
hwnd. Funkcję własną GetTextWindow(...) przedstawiłem w artykule:
• Funkcje API - jak pobrać tytuł (tekst) okna •.
Wyszukiwanie okien aplikacji MS Access jest szczególnym przypadkiem bardziej ogólnego zagadnienia, jakim jest znalezienie wszystkich okien „potomnych”
(dzieci) okna nadrzędnego o uchwycie hParent i klasie ClassName. Aby napisać bardziej
uniwersalną funkcję, będę potrzebował drugiej funkcji własnej GetWinClassName(...) z wcześniej wzmiankowanego artykułu
• Funkcje API - jak pobrać nazwę
klasy okna •, by znając uchwyt okna, pobrać nazwę klasy w celu przekazania do funkcji •FindWindowEx.
Option Compare Database
Option Explicit
' • Function EnumWindowInstances(ByVal hParent As LongPtr, _
' ByVal sWindowClassName As String, _
' ByVal sWindowTitle As String, _
' ByRef arrRet() As String) As Long
' ----------------------------------------------------------------------
' autor: Zbigniew Bratko - 01.2016
' [hParent] - uchwyt okna nadrzędnego (rodzica), które będzie przeszukiwane w celu
' znalezienia okien potomnych (dzieci) spełniających kryteria przekazane
' w argumentach,
' [sWindowClassName] - nazwa szukanej klasy okna, dla ciągu zerowej długości lub
' znaku vbNullString wyliczane są wszystkie okna o tytule sWindowTitle,
' [sWindowTitle] - tytuł szukanego okna, dla ciągu zerowej długości lub znaku vbNullString
' wyliczane są wszystkie okna klasy sClassName,
' [arrRet] - zwracana ByRef tablica z tytułami (tekstem) okien spełniających kryteria
' przekazane w argumentach,
' [Out] - zwraca liczbę znalezionych okien, spełniających kryteria przekazane w argumentach,
' a w argumencie ByRef arrRet zwraca tablicę z tytułami okien spełniających
' Przy niepowodzeniu zwraca 0 (Zero), a w argumencie ByRef arrRet niezainicjowaną tablicę,
' UWAGA! - Jeżli argumenty [sWindowClassName] i [sWindowTitle] są ciągiem zerowej długości
' lub równe vbNullString zwrócone zostaną wszystkie okna potomne (dzieci) okna
' nadrzędnego o uchwycie [hParent]
'
#If VBA7 Then
Private Declare PtrSafe Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As LongPtr, _
ByVal hWnd2 As LongPtr, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
#Else
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
#End If
' Funkcja własna EnumWindowInstances
#If VBA7 Then
' Deklaracja funkcji - zarówno w 32 jak i 64 bitowym środowisku VBA 7
Public Function EnumWindowInstances(ByVal hParent As LongPtr, _
ByVal sWindowClassName As String, _
ByVal sWindowTitle As String, _
ByRef arrRet() As String) As Long
Dim hNext As LongPtr
#Else
' Deklaracja funkcji - tylko 32 bitowe środowisko VBA 6
Public Function EnumWindowInstances(hParent As Long, _
ByVal sWindowClassName As String, _
ByVal sWindowTitle As String, _
ByRef arrRet() As String) As Long
Dim hNext As Long
#End If
Dim lCount As Long
' konwertuj ciąg zerowej długości "" na vbNullString,
' gdyż ciąg zerowej długości "", to nie to samo co vbNullString
If Len(sWindowTitle) = 0 Then sWindowTitle = vbNullString
If Len(sWindowClassName) = 0 Then sWindowClassName = vbNullString
' szukaj pierwszego wystąpienia okna spełniającego kryteria
hNext = FindWindowEx(hParent, 0&, ByVal sWindowClassName, ByVal sWindowTitle)
Do Until hNext = 0
' zwiększ wymiar tablicy
ReDim Preserve arrRet(0 To lCount)
' zapisz do tablicy tytuł okna
arrRet(lCount) = GetTextWindow(hNext)
' zwiększ licznik
lCount = lCount + 1
' szukaj następnego wystąpienia okna spełniającego kryteria
hNext = FindWindowEx(ByVal hParent, ByVal hNext, ByVal sWindowClassName, ByVal sWindowTitle)
Loop
EnumWindowInstances = lCount
End Function
' przykładowe wywołanie
Private Sub btnTest_Click()
#If VBA7 Then
Dim hParent As LongPtr
#Else
Dim hParent As Long
#End If
Dim sClassName As String
Dim sArray() As String
Dim lRet As Long
Dim sWinTitle As String
Dim i As Integer
' pobierz nazwę klasy okna - (tutaj okno MS Access)
sClassName = GetWinClassName(Application.hWndAccessApp)
' pobierz uchwyt okna rodzica
hParent = GetDesktopWindow
' pobierz ilość wystąpień okna klasy sClassName
' a do tablicy sArray() tytuły (tekst) okien
lRet = EnumWindowInstances(hParent, sClassName, "", sArray())
If lRet = 0 Then
MsgBox "Nie znaleziono okien spełniających kryteria !"
Else
For i = 0 To lRet - 1
' utwórz listę tytułów (tekstu) znalezionych okien
sWinTitle = sWinTitle & CStr(i + 1) & ". '" & CStr(sArray(i)) & "'" & vbNewLine
Next
End If
MsgBox "Znaleziono okna (szt. " & CStr(lRet) & ") o tytułach:" & _
vbNewLine & vbNewLine & sWinTitle
End Sub
Po testowym uruchomieniu 4 różnych baz (Access 2007, Access 2010, Access 2016) i biężącej, testowej bazy Access 2016
z poziomu której uruchomiona została procedura Sub btnTest_Click wywołująca funkcję własną EnumWindowInstances(...)
wyświetlone zostanie okno komunikatu informujące o uruchomionych instancjach MS Access:
Po małej modyfikacji procedury Sub btnTest_Click, tak by wyszukała wszystkie okna „potomne”
(dzieci) okna głównego „Pulpitu”, a w oknie „Immediate” wylistowała okna, które mają tytuł (tekstu):
' przykładowe wywołanie
Private Sub btnTest_Click()
#If VBA7 Then
Dim hParent As LongPtr
#Else
Dim hParent As Long
#End If
Dim sClassName As String
Dim sArray() As String
Dim lRet As Long
Dim sWinTitle As String
Dim i As Integer
' pobierz uchwyt okna rodzica
hParent = GetDesktopWindow
' pobierz ilość wystąpień wszystkich okien potomnych
' a do tablicy sArray() tytuły (tekst) okien
lRet = EnumWindowInstances(hParent, "", "", sArray())
If lRet = 0 Then
MsgBox "Nie znaleziono okien spełniających kryteria !"
Else
For i = 0 To lRet - 1
If Len(sArray(i)) > 0 Then
' w oknie Immediate listuj okna mające tytuł
Debug.Print CStr(i + 1) & ". " & sArray(i)
End If
' utwórz listę tytułów (tekstu) znalezionych okien
sWinTitle = sWinTitle & CStr(i + 1) & ". '" & CStr(sArray(i)) & "'" & vbNewLine
Next
End If
MsgBox "Znaleziono okna (szt. " & CStr(lRet) & ") o tytułach:" & _
vbNewLine & vbNewLine & sWinTitle, vbInformation, "API - lista tytułów okien"
End Sub
' Lista okien, których tytuł (tekst) nie jest pusty
' -------------------------------------------------
' 10. Start
' 29. Network Flyout
' 30. Default IME
' 31. Przełączanie zadań
' 32. CiceroUIWndFrame
' 33. MSCTFIME UI
' 34. Default IME
' 37. CiceroUIWndFrame
' 38. TF_FloatingLangBar_WndTitle
' 39. Wyszukaj
' 40. MSCTFIME UI
' 41. Default IME
' 42. Properties
' 43. API - Lista tytułów okien
' 48. Toolbar Options
' 49. Debug
' 53. Microsoft Visual Basic for Applications - Instancje_MS_Access [running] - [Immediate]
' 54. MSCTFIME UI
' 55. Default IME
' 56. art_09 - Google Chrome
' 57. MSCTFIME UI
' 58. Default IME
' 60. Szukaj
' 94. DDE Server Window
' 95. OfficePowerManagerWindow
' 103. MSCTFIME UI
' 104. Default IME
' 105. COMODO Internet Security Premium
' 106. CCisEventsHandlerWindow_2604_0
' 107. Default IME
' 108. GDI+ Window
' 109. Default IME
' 117. Menu Start
' 118. MS_WebcheckMonitor
' 119. MCI command handling window
' 120. Default IME
' 121. BluetoothNotificationAreaIconWindowClass
' 127. HiddenFaxWindow
' 128. Media Center SSO
' 129. Default IME
' 132. Default IME
' 133. MSCTFIME UI
' 134. REALTEK 11n USB Wireless LAN Utility
' 135. REALTEK 11n USB Wireless LAN Utility
' 136. GDI+ Window
' 137. Default IME
' 139. Default IME
' 140. Miernik baterii
' 141. Default IME
' 143. Piriform CCleaner
' 144. GDI+ Window
' 145. Default IME
' 146. USB 3.0 Monitor
' 147. Default IME
' 150. MSCTFIME UI
' 152. Lista szybkiego dostępu
' 158. DDE Server Window
' 159. GDI+ Window
' 160. Default IME
' 161. TaskEng - proces aparatu Harmonogramu zadań
' 162. Default IME
' 165. Default IME
' 166. MCI command handling window
' 167. Default IME
' 168. Task Host Window
' 169. Default IME
' 170. AMD EEU Client
' 171. Default IME
' 172. Default IME
' 174. DWM Notification Window
' 175. Default IME
' 176. CisTray
' 177. Program Manager
W sumie listing obejmuje 172 okna różnego typu. Ilość okien potomnych Pulpitu zależy od konfiguracji Systemu, ilości uruchomionych aplikacji bezpośrednio,
jak również różnych usług uruchomionych w tle.
Muszę wyraźnie zaznaczyć, że funkcja własna EnumWindowInstances(...) uwzględnia tylko okna „potomne” (dzieci)
okna nadrzędnego o uchwycie hParent. Aby wylistować następne pokolenie okien „potomnych” konieczna jest modyfikacja
funkcji własnej EnumWindowInstances(...). Najprościej by było zrobić wywołanie rekurencyjne, ale na razie
poprzestanę na powyższym przykładzie. Być może kiedyś ...
