Atrybut PtrSafe - deklarowanie funkcji w środowisku VBA 7.
Jak przekazać uchwyt hwnd w 32 i 64 bitowej wersji pakietu Office ?
Napiszmy prostą przykładową funkcję korzystającą z funkcji API i zwracającą tytuł aktywnego okna. Funkcja accGetTextWindow(...) korzystać będzie z trzech funkcji API:
- GetActiveWindow zwracającą uchwyt hwnd aktywnego okna.
- GetWindowTextLength zwracającą długość tekstu okna o przekazanym w argumencie uchwycie hwnd.
- GetWindowText zwracająca długość pobranego do buforu tekstu okna, a w buforze właściwy tekst okna.
W środowisku 32 bitowym funkcja accGetTextWindow(hWind As Long) As String będzie miała postać:
Private Declare Function GetActiveWindow Lib "user32" () As Long Private Declare Function GetWindowText Lib "user32" _ Alias "GetWindowTextA" ( _ ByVal hwnd As Long, _ ByVal lpString As String, _ ByVal cch As Long) As Long Private Declare Function GetWindowTextLength Lib "user32" _ Alias "GetWindowTextLengthA" ( _ ByVal hwnd As Long) As Long Private Function accGetTextWindow(hWind As Long) As String Dim sBuffer As String Dim lLenText As Long ' pobierz długość tekstu okna lLenText = GetWindowTextLength(hWind) ' uwzględnij dodawany znak końca ciągu znaków lLenText = lLenText + 1 ' przygotuj bufor na przyjęcie tekstu sBuffer = String(lLenText, vbNullChar) ' pobierz długość zwróconego tekstu lLenText = GetWindowText(hWind, sBuffer, lLenText) ' utnij nadmiarowy ciąg znaków vbNullChar w buforze accGetTextWindow = Left$(sBuffer, lLenText) End Function
Uwaga: Tak zadeklarowana funkcja powinna działać w każdym 32 bitowym pakiecie Microsoft Office, bez względu na wersję systemu operacyjnego Windows (32 bit, czy 64 bit).
W podobny sposób możemy zadeklarować funkcję accGetTextWindow(...), tak by pracowała prawidłowo w 32 i 64 bitowym środowisku VBA7 pakietu Microsoft Office 2010 i wyższych wersjach. Wystarczy za każdą instrukcją Declare umieścić atrybut PtrSafe i zadeklarować wszystkie uchwyty hwnd w funkcjach API jako typ LngPtr.
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr Private Declare PtrSafe Function GetWindowText Lib "user32" _ Alias "GetWindowTextA" ( _ ByVal hwnd As LongPtr, _ ByVal lpString As String, _ ByVal cch As Long) As Long Private Declare PtrSafe Function GetWindowTextLength Lib "user32" _ Alias "GetWindowTextLengthA" ( _ ByVal hwnd As LongPtr) As Long Private Function accGetTextWindow(hWind As LongPtr) As String Dim sBuffer As String Dim lLenText As Long ' pobierz długość tekstu okna lLenText = GetWindowTextLength(hWind) ' uwzględnij dodawany znak końca ciągu znaków lLenText = lLenText + 1 ' przygotuj bufor na przyjęcie tekstu sBuffer = String(lLenText, vbNullChar) ' pobierz długość zwróconego tekstu lLenText = GetWindowText(hWind, sBuffer, lLenText) ' utnij nadmiarowy ciąg znaków vbNullChar w buforze accGetTextWindow = Left$(sBuffer, lLenText) End Function
Uwaga: Tak zadeklarowana funkcja powinna działać w pakiecie Microsoft Office 2010 i wersji wyższej (środowisko VBA 7), bez względu na wersję systemu operacyjnego Windows (32 bit, czy 64 bit).
Z powyżej przedstawionych dwóch wersji kodu wiemy jak już, napisać funkcję działającą w dowolnej 32 bitowej wersji pakietu Microsoft Office oraz funkcję działającą w środowisku VBA7 w 32 lub 64 bitowej wersji pakietu Microsoft Office 2010 i wyższej.
Jeżeli chcemy napisać uniwersalną funkcję działającą w obu systemach operacyjnych Windows oraz w (32 i 64 bitowych) pakietach Microsoft Office, musimy skorzystać nie tylko z atrybutu PtrSafe przy deklarowaniu funkcji API, ale także ze stałej kompilacji warunkowej VBA7. Stałą tą musimy zastosować także przy deklarowaniu naszej funkcji accGetTextWindow (hWind As Long[LongPtr]), gdyż w środowisku 32 bitowym przekazywany uchwyt hwnd musi być liczbą typy Long, a w środowisku 64 bitowym uchwyt hwnd liczbą typu LongLong.
#If VBA7 Then ' Środowisko VBA 7 - zarówno 32 jak i 64 bitowe Private Declare PtrSafe Function GetActiveWindow Lib "user32" ( _ ) As LongPtr Private Declare PtrSafe Function GetWindowText Lib "user32" _ Alias "GetWindowTextA" ( _ ByVal hwnd As LongPtr, _ ByVal lpString As String, _ ByVal cch As Long) As Long Private Declare PtrSafe Function GetWindowTextLength Lib "user32" _ Alias "GetWindowTextLengthA" ( _ ByVal hwnd As LongPtr) As Long #Else ' Środowisko VBA 6 - tylko 32 bitowe Private Declare Function GetActiveWindow Lib "user32" ( _ ) As Long Private Declare Function GetWindowText Lib "user32" _ Alias "GetWindowTextA" ( _ ByVal hwnd As Long, _ ByVal lpString As String, _ ByVal cch As Long) As Long Private Declare Function GetWindowTextLength Lib "user32" _ Alias "GetWindowTextLengthA" ( _ ByVal hwnd As Long) As Long #End If '==================================================================== ' Funkcja accGetTextWindow(hWind As LongPtr[LongPtr]) As String ' argumenty: ' hWind - uchwyt okna ' zwraca: ' Zwraca ciąg znaków będący tytułem (tekstem) okna. ' Przy niepowodzeniu zwraca ciąg zerowej długości. ' autor: Zbigniew Bratko ' data: 28.01.2019 '==================================================================== #If VBA7 Then ' Deklaracja funkcji - zarówno 32 jak i 64 bitowe środowisko VBA 7 Private Function accGetTextWindow(hWind As LongPtr) As String #Else ' Deklaracja funkcji - tylko 32 bitowe środowisko VBA 6 Private Function accGetTextWindow(hWind As Long) As String #End If Dim sBuffer As String Dim lLenText As Long ' pobierz długość tekstu okna lLenText = GetWindowTextLength(hWind) ' uwzględnij dodawany znak końca ciągu znaków lLenText = lLenText + 1 ' przygotuj bufor na przyjęcie tekstu sBuffer = String(lLenText, vbNullChar) ' pobierz długość zwróconego tekstu lLenText = GetWindowText(hWind, sBuffer, lLenText) ' utnij nadmiarowy ciąg znaków vbNullChar w buforze accGetTextWindow = Left$(sBuffer, lLenText) End Function
Wywołanie funkcji accGetTextWindow (hWind As ...)
Wywołanie funkcji accGetTextWindow (...) jest zupełnie proste. W przykładzie 1 przekazujemy w argumencie funkcji uchwyt okna Access (Application.hWndAccessApp), w przykładzie 2 w sposób bezpośredni przekazywany jest uchwyt aktywnego okna. W obu przypadkach uchwyty są takie same, więc zwracany tytuł okna jest taki sam.
' przykładowe wywołanie 1: Private Sub btnTest1_Click() ' pobierz tytuł okna aplikacji Access MsgBox "Tytuł okno Access: " & accGetTextWindow(Application.hWndAccessApp) End Sub ' przykładowe wywołanie 2: Private Sub btnTest2_Click() ' pobierz tytuł aktywnego okna MsgBox "Tytuł aktywnego okna: " & accGetTextWindow(GetActiveWindow) End Sub
Wszystko jest w porządku. Funkcje zwracają taki sam tytuł okna. Kompilator nie sygnalizuje błędów kompilacji.
Application.hWndAccessApp - typ Long, czy LongLong?
Rodzi się pytanie, czy kompilator prawidłowo pilnuje typu przekazywanego uchwytu okna hwnd ?
Spróbujmy niezbyt poprawnie zadeklarować funkcję GetTextWindow_vba7 (hWind As Long),
zakładając, że będzie prawidłowo działała zarówno w środowisku 32, jak i 64 bitowego VBA7.
Nasz błąd polega na bezwarunkowym zadeklarowaniu argumentu funkcji hWind jako typ Long.
Taka deklaracja jest prawidłowa w środowisku 32 bitowym, ale nie jest poprawna
w środowisku 64 bitowym VBA7.
' w środowisku 64 bitowym argument hWind powinien być zadeklarowany jako LongPtr: Private Function GetTextWindow_vba7(hWind As Long) As String ... End Function ' przykładowe wywołanie 1: Private Sub btnTest1_Click() ' pobierz tytuł okna aplikacji Access MsgBox "Tytuł okno Access: " & accGetTextWindow(Application.hWndAccessApp) End Sub
Kompilator w środowisku 64 bitowym nie zgłasza żadnych błędów, pomimo teoretyczne niezgodności typów.
Metoda
Application.hWndAccessApp w środowisku 64 bitowym powinna zwrócić
uchwyt typu LongLong. Widocznie tak nie jest, lub kompilator o tym nie wie.
Prawdopodobnie metoda Application.hWndAccessApp zwraca wartość typu Long
i dlatego kompilator nie widzi niezgodności typów.
I tutaj pojawia się problem. Czy zwracany uchwyt Application.hWndAccessApp w środowisku 64 bitowym
jest typu LongLong, czy typu Long?
Funkcja:
VarType(Application.hWndAccessApp)
w środowisku 64 bitowym zwraca wartość vbLong = 3, a nie vbLongLong = 20.
Czy typ Long dla uchwytu hwnd jest prawidłowy w środowisku 64 bitowym ? Na to pytanie musi odpowiedzieć sam Microsoft. Problem z niezgodnością typu uchwytu nie skutkuje na razie nieprawidłowym działaniem funkcji. Zapewne środowisko programistyczne Win64 zwraca uchwyty jako typ LongLong, ale w zakresie typu Long. Niejawna konwersja typów nie prowadzi do tzw. „obcięcia” liczby. Ale prędzej, czy później, 64 bitowe środowisko zwróci uchwyt typu LongLong o wartości przekraczającej zakres typu Long, a nasza funkcja przytnie go do zakresu Long. Po takiej konwersji uchwyt hwnd nie będzie wskazywał na żadne okno, lub będzie się odnosił do zupełnie innego okna.
Jeżeli zmienimy wywołanie funkcji accGetTextWindow(hWind As Long) przekazując bezpośrednio
w argumencie uchwyt hwnd zwracany przez funkcję API GetActiveWindow(...):
' pobierz tytuł aktywnego okna MsgBox "Tytuł aktywnego okna: " & accGetTextWindow(GetActiveWindow)
to kompilator zgłosi błąd: „Niezgodność typu”.
I faktycznie tak jest, ponieważ zgodnie z deklaracją, funkcja GetActiveWindow(...)
zwraca liczbę typu LongPtr, która w środowisku Win64 (64 bitowym pakiecie Microsoft Office)
jest typu LongLong, a źle zadeklarowana funkcja accGetTextWindow
(hWind As Long
) przyjmuje w argumencie uchwyt hwnd zadeklarowany
jako typ Long, a zwracany przez funkcję GetActiveWindow jako LongLong.