poniedziałek, 29 lutego 2016

• Funkcje API - Mutex, jedna instancja bazy MS Access

W poprzednim artykule • Funkcje API - Jedna instancja bazy MS Access przedstawiłem kilka rozwiązań dotyczących zabezpieczenia bazy danych MS przed otwarciem przez użytkownika drugiej instancji otwartej bazy danych. Przedstawione metody działają w oparciu o opcje startowe MS Access tj. makro AutoExec lub właściwość StartupForm = „Formularz startowy”. Akcja makra AutoExec (Action ="RunCode") lub zdarzenie OnLoad() formularza wywoływały funkcję własną CountAccessInstances(...) przedstawioną w art. • Funkcje API - ile uruchomiono instancji MS Access •. Funkcja własna CountAccessInstances w zależności od przekazanych argumentów wyszukiwała okna MS Access klasy OMain o tytule zgodnym z tekstem przekazanym w opcjonalnym argumencie sAccessTitle.

' poglądowy kod
If CountAccessInstances([opconalnie: JakisTytulOkna MS Access]) > 1 Then
  MsgBox "Nie możesz uruchomić następnej bazy danych, [instancji bazy danych] "
  ' zamknij otwieraną bazę
  Application.Quit
End If

Uniemożliwienia otwarcie drugiej instancji bazy danych wymagało przekazania w argumencie funkcji własnej CountAccessInstances(...) tytułu okna MS Access. Wymogiem poprawnego działania funkcji było, by bieżąca baza danych miała ustawioną właściwość CurrentDb.Properties("AppTitle"), gdyż przy braku tej właściwośći, nie można było jednoznacznie określić tytułu okna MS Access, gdyż tytuł okna MS Access zmienia się w zależności od jego wersji. Umożliwiało to otwarcie drugiej instancji bieżącej bazy danych za pomocą innej wersji MS Access.

• Mutex - synchronizacja procesów.

•    Co to jest mutex?

Tak ogólnie można napisać, że mutex jest obiektem służącym do synchronizacji wątków i dostępny jest dla wszystkich wątków uruchomionych aktualnie w systemie. Bardziej szczegółowe dane dotyczące mutexu możemy uzyskać z Wikipedii w artykule Problem wzajemnego wykluczania. Poniżej cytuję fragment z tego artykułu:

Algorytmy wzajemnego wykluczania (w skrócie często nazywane mutex, z ang. mutual exclusion) są używane w przetwarzaniu współbieżnym w celu uniknięcia równoczesnego użycia wspólnego zasobu (np. zmiennej globalnej) przez różne wątki/procesy w częściach kodu zwanych sekcjami krytycznymi. Sekcja krytyczna jest fragmentem kodu, w którym wątki (lub procesy) odwołują się do wspólnego zasobu. Sama w sobie nie jest ani mechanizmem, ani algorytmem wzajemnego wykluczania. Program, proces lub wątek może posiadać sekcje krytyczne bez mechanizmów czy algorytmów implementujących wzajemne wykluczanie.

Aby stworzyć mutex należy wywołać funkcję CreateMutex(...), która po stwierdzeniu braku mutexu o podanej nazwie w systemie tworzy go, a funkcja GetLastError zwraca wartość ERROR_SUCCESS=0. Jeśli mutex już istnieje, funkcja CreateMutex(...) tworzy nowy uchwyt, a funkcja GetLastError zwraca wartość ERROR_ALREADY_EXISTS.
W chwili tworzenia mutexu wątek żąda natychmiastowego prawa własności do niego. Inne wątki moga otworzyć mutex za pomocą funkcji OpenMutex() i czekać na objęcie mutexu w posiadanie. Aby uwolnić mutex należy wywołć funkcję ReleaseMutex(). Jeśli wątek zakończy się i nie uwolni mutexu, to taki mutex uważany jest za porzucony i każdy czekający wątek może objąć go w posiadanie.
Teoretycznie jawne zamykanie uchwytów nie jest niezbędne, gdyż system zamyka wszystkie uchwyty w chwili zakończenia procesu, jednak zalecane jest, kiedy obiekt jest niepotrzebny.

• Mutex - jedna instancja bazy.

W celu uniemożliwienia otwarcie drugiej instancji bieżącej bazy danych wykorzystamy trzy funkcje API:
• CreateMutex(...) - tworzy, bądź otwiera nazwany lub nienazwany mutex i zwraca uchwyt do niego
• ReleaseMutex(...) - zwalnia mutex, proces przestaje być właścicielem mutexu, co pozwala przejąć go przez inny proces.
• CloseHandle(...) - zamyka obiekt identyfikowany przez uchwyt.  
Option Compare Database
Option Explicit

' • Function OneInstanceDb() As Long
' --------------------------------------------------------------------------------------
' autor: Zbigniew Bratko - 02.2016
' Tworzy nazwany muteks, uniemożliwiający otwarcie drugiej instancji bieżącej bazy danych
' [Out] - Przy powodzeniu tworzy nazwany muteks i zwraca liczbę różną od 0 (Zero)
'         Przy niepowodzeniu zwraca 0 (Zero)
'

#If VBA7 Then
  Private Declare PtrSafe Function CreateMutex Lib "kernel32" _
           Alias "CreateMutexA" _
           (lpMutexAttributes As SECURITY_ATTRIBUTES, _
           ByVal bInitialOwner As Long, _
           ByVal lpName As String) As LongPtr
  Private Declare PtrSafe Function ReleaseMutex Lib "kernel32" _
          (ByVal hMutex As LongPtr) As Long
  Private Declare PtrSafe Function CloseHandle Lib "kernel32" _
          (ByVal hObject As LongPtr) As Long
  Private Type SECURITY_ATTRIBUTES
          nLength As Long
          lpSecurityDescriptor As LongPtr
          bInheritHandle As Long
  End Type
  Private m_hMutex As LongPtr
#Else
  Private Declare Function CreateMutex Lib "kernel32" _
          Alias "CreateMutexA" _
          (lpMutexAttributes As SECURITY_ATTRIBUTES, _
          ByVal bInitialOwner As Long, _
          ByVal lpName As String) As Long
  Private Declare Function ReleaseMutex Lib "kernel32" _
          (ByVal hMutex As Long) As Long
  Private Declare Function CloseHandle Lib "kernel32" _
          (ByVal hObject As Long) As Long
  Private Type SECURITY_ATTRIBUTES
            nLength As Long
            lpSecurityDescriptor As Long
            bInheritHandle As Long
    End Type
    Private m_hMutex As Long
#End If
Private Const ERROR_ALREADY_EXISTS = &HB7
Private Const ERROR_SUCCESS = 0&


' Funkcja własna OneInstanceDb() - uruchomienie:
' makro AutoExec:
' Action = RunCode
' FunctionName = OneInstanceDb ()
' lub
' Zdarzenie OnLoad formularza startowego (StartUpForm)
Public Function OneInstanceDb() As Long

#If VBA7 Then
  Dim hMutex As LongPtr
#Else
  Dim hMutex As Long
#End If

Dim sa As SECURITY_ATTRIBUTES

  sa.nLength = Len(sa)
  ' utwórz nazwany muteks i zostań jego właścicielem (bInitialOwner=1)
  hMutex = CreateMutex(sa, 1, "NazwaMuteksu")
  ' sprawdź, czy nie wystąpił błąd podczas tworzenia muteksu
  If (Err.LastDllError = ERROR_SUCCESS) Then
    ' zapisz uchwyt muteksu w zmiennej prywatnej na poziomie modułu
    m_hMutex = hMutex
    OneInstanceDb = 1
    ' ... inne instrukcje (np. DoCmd.OpenForm "StartUpForm")
  Else
    If (Err.LastDllError = ERROR_ALREADY_EXISTS) Then
      ' muteks już istnieje, zamknij uchwyt
      Call CloseHandle(hMutex)
      MsgBox "Nie możesz uruchomić drugiej instancji bieżącej bazy danych!"
    Else
      ' (*) - patrz uwagi
      MsgBox "Nieprzewidziany błąd nr " & Err.LastDllError
    End If
    Application.Quit
  End If

End Function


' • Function RemoveMutex() As Long
' -------------------------------------------------------
' autor: Zbigniew Bratko - 02.2016
' Zwalnia muteks i zamyka uchwyt muteksu
' [Out] - Przy powodzeniu zwraca liczbę różną od 0 (Zero)
'         Przy niepowodzeniu zwraca 0 (Zero)

' Funkcja własna RemoveMutex()
' funkcję zwalniającą muteks należy uruchomić przy zamykaniu bazy, lub gdy chcemy
' zezwolić użytkownikowi na otwarcie drugiej instancji bazy.
Public Function RemoveMutex() As Long
Dim lRet As Long
    
    If m_hMutex <> 0 Then
      ' zwolnij muteks
      If ReleaseMutex(m_hMutex) <> 0 Then
        RemoveMutex = CloseHandle(m_hMutex)
      End If
    End If

End Function

Uwagi:
(*) komunikat typu:

MsgBox "Nieprzewidziany błąd nr " & Err.LastDllError

jest dość zdawkowy i nie daje końcowemu użytkownikowi zbyt wiele informacji o przyczynie błędu.
W następnym artykule (być może) postaram się przedstawić rozwiązanie, by komunikaty o błędach były bardziej przyjazne dla użytkownika.

• Inne rozwiązania

Nasuwa mi się jeszcze jedno (dość nietypowe) rozwiązanie oparte o utworzenie, przez zabezpieczaną bazę, swojego własnego, prywatnego okna o indywidualnym tytule, którego istnienie świadczyć będzie, że baza została juz uruchomiona. Dodatkowo, utworzone okno będzie mogło spełniać rolę "malutkiego" komunikatora pomiędzy bazami. Ale o tym będzie w którymś kolejnym artykule. Gdy artykuł będzie gotowy, podam tutaj link do niego.

• Funkcje API - Mutex, jedna instancja bazy MS Access • Przykładowa baza MS Access do pobrania

poniedziałek, 22 lutego 2016

• Funkcje API - Jedna instancja bazy MS Access

logo

Czasami projekt bazy danych wymaga, (z takich, czy innych względów), by użytkownik nie mógł otworzyć drugiej instancji bieżącej bazy danych. Sposobów zabezpieczenia się (a raczej pseudozabezpieczenia) przed otwarciem drugiej instancji bieżącej bazy jest kilka, jeśli nie kilkanaście. Generalnie wszystkie metody będą działały w oparciu o opcje startowe MS Access:

• Akcja makro Autoexec
Makro jest uruchamiane automatycznie podczas startu MS Access. Za pomocą funkcji uruchamianej przez to makro dokonujemy "pseudozabezpieczeń". Możemy również otworzyć jakiś formularz (może być ukryty), który będzie ... patrz punkt niżej:
Właściwość: StartupForm
Podczas startu MS Access automatycznie otwierany jest formularz startowy: StartupForm = „Nazwa formularza startowego” w którym np. w zdarzeniu OnLoad uruchamiamy funkcję, która tworzy "pseudozabezpieczenie"

Obie te opcje startowe można pominąć, otwierając bazę danych trzymając wciśnięty klawisz „Shift”. Ale z pomocą przychodzi właściwość AllowBypassKey, za pomocą której możemy uniemożliwić używanie klawisza SHIFT dla opcji startowych. Tak przy okazji, w celu dodatkowego zabezpieczeni możemy skorzystać z właściwości AllowSpecialKeys za pomocą której możemy uniemożliwić korzystanie użytkownikowi ze specjalnych klawiszy programu MS Access

  Sekwencja klawiszy  Skutek
F11Wyświetlenie okna bazy danych na wierzchu
CTRL+GWyświetlenie okna analizy programu
ALT+F11Wyświetlenie okna edytora VBA
CTRL+F11Przełączanie pomiędzy niestandardowym paskiem menu i wbudowanym paskiem menu
CTRL+BREAKWprowadzenie trybu przerwania i wyświetlenie bieżącego modułu w oknie modułu
SHIFTWciśnięcie podczas startu bazy umożliwia pominięcie opcji startowych tzn. makro Autoexec i formularz startowy nie są uruchamiane.

• Pseudozapezpieczenia

• Zapis pliku na dysku

Pierwszym, narzucającym się rozwiązaniem jest zapisanie „gdzieś” na dysku, podczas startu bazy, małego pliku tekstowego, takie niby „cookies”, który będzie usuwany przy zamknięciu bazy danych. Podczas startu bazy danych, z poziomu makra Autoexec lub formularza startowego, uruchomiana będzie „Jakas_Funkcja” sprawdzającej obecność pliku. Jak plik istnieje, to zostanie wywołana metoda Application.Quit dla nowo otwieranej instancji bazy.

' przykładowy kod
If Len(Dir("Sciezka_MojPlik")) > 0 Then
  ' plik istnieje, zamknij otwieraną bazę
  MsgBox "Nie możesz uruchomić następnej bazy danych"
  Application.Quit
End If

No niby tak, ale jeżeli zawiesi się System (baza), wtedy plik "Sciezka_MojPlik" nie zostanie usunięty z dysku, i przy następnym uruchomieniu naszej bazy możemy mieć poważne kłopoty. Plik istnieje (i będzie istniał, aż do jego usunięcia), więc może się zdarzyć tak, że zawsze będzie QUIT.

• Tylko jedna instancja MS Access

Innym sposobem jest sprawdzenie podczas uruchomienia bazy danych, czy inna instancja MS Access jest otwarta. W tym celu możemy skorzystać z funkcji własnej CountAccessInstances(...) przedstawionej w art. • Funkcje API - ile uruchomiono instancji MS Access •. Jeżeli funkcja zwróci wartość > 1, wtedy nie pozwalamy na uruchomienie bazy.

' przykładowy kod
If CountAccessInstances > 1 Then
  MsgBox "Nie możesz uruchomić następnej bazy danych"
  ' zamknij otwieraną bazę
  Application.Quit
End If

Niestety, to rozwiązanie ma jeden wielki minus. W ten sposób uniemożliwimy użytkownikowi otwarcie jakiejkolwiek innej bazy danych, gdy otwarta jest „ta nasza jedyna baza”.

• Tylko jedna instancja bieżącej bazy MS Access

Aby umożliwić użytkownikowi otwarcie innych baz, z wyłączeniem drugiej instancji bieżącej bazy danych, musimy podczas uruchamiania bazy sprawdzić, czy nie została wcześniej otwarta pierwsza instancja bazy. W tym celu skorzystamy z funkcji własnej GetTextWindow(...) przedstawionej w art.  • Funkcje API - jak pobrać tytuł (tekst) okna • w celu pobrania tytułu (tekstu) okna MS Access otwieranej bazy danych oraz (tak jak w poprzednim przykładzie), z funkcji własnej CountAccessInstances(...) przedstawionej w art. • Funkcje API - ile uruchomiono instancji MS Access • w celu pobrania ilości okien MS Access o tytule (tekście) zwróconym przez funkcję własną GetTextWindow(...).

' przykładowy kod  
Dim sCurrDbTitle As String

' pobierz tytuł okna MS Access bieżącej bazy
sCurrDbTitle = GetTextWindow(Application.hWndAccessApp)
' pobierz ilość otwartych instancji MS Access o tytule okna sCurrDbTitle
If CountAccessInstances(sCurrDbTitle) > 1 Then
  MsgBox "Nie możesz uruchomić drugiej instancji bieżącej bazy danych!"
  ' zamknij otwieraną bazę
  Application.Quit
End If

Niestety, to rozwiązanie też ma swoje wady. Jeżeli baza danych nie ma ustawionej właściwości CurrentDb.Properties("AppTitle"), którą to właściwość można ustawić za pomocą: Menu Plik/Opcje/Bieżąca baza danych/Opcje aplikacji/Tytuł Aplikacji, to tytuł okna MS Access zmienia się, wraz ze zmianą wersji MS Access.

Przykładowo dla bazy testowej: C:\tmp\dbTest.accdb
MS Access 2016 - "Access — dbTest : Baza danych- C:\tmp\dbTest.accdb (format pliku programu Access 2007–2016)"
MS Access 2010 - "Microsoft Access — dbTest : Baza danych (Access 2007 - 2010)"
MS Access 2007 - "Microsoft Access — dbTest : Baza danych (Access 2007)"
Jeżeli wymogiem dla prawidłowego działania kodu jest konieczność ustawienia właściwości CurrentDb.Properties("AppTitle") to nie musimy korzystać z funkcji własnej GetTextWindow(...), tytuł okna MS Access pobierzemy dzięki właściwości CurrentDb.Properties("AppTitle").

' przykładowy kod  
Dim sCurrDbTitle As String

' pobierz tytuł okna MS Access bieżącej bazy
sCurrDbTitle = CurrentDb.Properties("AppTitle")
' pobierz ilość otwartych instancji MS Access o tytule okna sCurrDbTitle
If CountAccessInstances(sCurrDbTitle) > 1 Then
  MsgBox "Nie możesz uruchomić drugiej instancji bieżącej bazy danych!"
  ' zamknij otwieraną bazę
  Application.Quit
End If

• Inne rozwiązania

Innym rozwiązaniem jest uruchomienie „jakieś funkcji”, która będzie pilnowała, by otwarta była jedna instancja bieżącej bazy danych. Innymi słowy „Jakaś funkcja” musi być uruchomiona podczas startu bazy danych i przez cały czas działania bazy musi sprawdzać, czy nie została otwarta druga instancja bieżącej bazy danych. Najprostszym rozwiązaniem jest otwarcie ukrytego formularza startowego z włączonym Timerem, w którym to w pewnych odstępach czasu (patrz. właściwość Form.TimerInterval), będzie sprawdzała, czy nie jest otwarta druga instancja bazy (druga instancja MS Access)

Oczywistym rozwiązaniem powinno być wykorzystanie systemowych mechanizmów służących do synchronizacji wątków, czyli algorytmów wzajemnego wykluczania (w skrócie mutex, z ang. mutual exclusion) Jak wykorzystać mutex w celu uniemożliwienia otwarcia drugiej instancji bazy danych MS Access opisałem w artykule • Funkcje API - Mutex, jedna instancja bazy MS Access •

wtorek, 16 lutego 2016

• Funkcje API - tytuły okien otwartych instancji MS Access

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 funkcji FindWindowEx znaleziony 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ś ...

środa, 10 lutego 2016

• Funkcje API - ile uruchomiono instancji MS Access

W poprzednim artykule • Funkcje API - jak pobrać nazwę klasy okna o uchwycie hwnd • dowiedzieliśmy się jak wykorzystać interfejs API, aby odczytać nazwę klasy okna. Po uruchomieniu przykładowego kodu wiemy, że nazwa klasy głównego okna MS Access brzmi OMain, a okno formularza jest klasy OForm.

Czasami w trakcie działania aplikacji MS Access potrzebujemy sprawdzić, czy otwarta jest inna baza MS Access, a jeżeli tak, to ile instancji MS Access jest uruchomionych. Do tego celu wykorzystamy interfejs Windows API i jego dwie funkcje:
• GetDesktopWindow - zwracającą uchwyt pulpitu czyli okna obejmującego cały ekran. Na pulpicie osadzone są wszystkie pozostałe okna
• FindWindowEx - zwracającą uchwyt okna potomnego, którego albo nazwa klasy, lub (i) tytuł odpowiadają nazwom przekazanym w argumentach funkcji.

Option Compare Database
Option Explicit
 
' • Function CountAccessInstances( _
'                  Optional ByVal sAccessTitle As String = vbNullString) As Long
' --------------------------------------------------------------------------------
' autor: Zbigniew Bratko - 02.2016

' [sAccessTitle] - argument opcjonalny, tytuł szukanego okna,
'                  dla ciągu zerowej długości lub znaku vbNullString
'                  wyliczane są wszystkie okna MS Access,
' [Out] - zwraca liczbę uruchomionych instancji MS Access,
'         o tytule odpowiadającym argumentowi sAccessTitle
'         Przy niepowodzeniu zwraca 0 (Zero)
'
 
#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
#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
#End If


' Funkcja własna CountAccessInstances
Public Function CountAccessInstances( _
                      Optional ByVal sAccessTitle As String = vbNullString) As Long
#If VBA7 Then
  Dim hNext As LongPtr
#Else
  Dim hNext As Long
#End If
  
' licznik
Dim lCount As Long
' nazwa klasy okna MS Access
Const cAccWindowClass As String = "OMain"

  ' konwertuj ciąg zerowej długości "" na vbNullString,
  ' gdyż ciąg zerowej długości "", to nie to samo co vbNullString
  If Len(sAccessTitle) = 0 Then sAccessTitle = vbNullString
  
  ' szukaj pierwszego wystąpienia potomnego okna MS Access klasy "OMain"
  ' i tytule sDbTitle, w oknie rodzica "Pulpit" (domyślnie dla argumentu hWnd1 = 0)
  hNext = FindWindowEx(0, 0, ByVal cAccWindowClass, ByVal sAccessTitle)
    
  Do Until hNext = 0
    ' zwiększ licznik
    lCount = lCount + 1
    ' szukaj następnego wystąpienia okna MS Access klasy "OMain"
    hNext = FindWindowEx(0, ByVal hNext, ByVal cAccWindowClass, ByVal sAccessTitle)
  Loop

  CountAccessInstances = lCount
  
End Function


' przykładowe wywołanie
Private Sub btnTest_Click()
Dim lRet As Long
  
  lRet = CountAccessInstances()
  MsgBox "Uruchomionych instancji MS Access: " & CStr(lRet) & " egz."
 
End Sub

piątek, 5 lutego 2016

• Funkcje API - jak pobrać nazwę klasy okna

W poprzednim artykule • Funkcje API - jak pobrać tytuł (tekst) okna o uchwycie hwnd • dowiedzieliśmy się jak wykorzystać interfejs API, aby odczytać tytuł (tekst) okna. Czasami w trakcie działania aplikacji MS Access potrzebujemy sprawdzić nie tylko jaki tytuł (tekst) ma okno, ale także nazwę klasy okna w systemie Windows.

Klasa okna jest to struktura opisująca podstawowe cechy okna: kolor tła, szerokość obramowania, menu sterowania, przyciski minimalizuj, maksymalizuj, zamknij, ikona paska tytułowego, paski przewijania, przypisany do okna kursor myszy i wiele innych cech okna.

• Odczyt nazwy klasy okna o uchwycie hwnd.

MS Access nie posiada żadnych metod i właściwości pozwalających na odczytanie nazwy klasy okna. Aby pobrać nazwę klasy okna musimy skorzystać z interfejsu API i jednej z jego funkcji:
• GetClassName - zwracającą długość pobranej do buforu nazwy klasy okna, a w buforze nazwę klasy okna o uchwycie hwnd.

Option Compare Database
Option Explicit

' • Function GetWinClassName(hWind As Long;[LongLong];[LngPtr]) As String
' --------------------------------------------------------------
' autor: Zbigniew Bratko - 01.2016
' [hWind] - uchwyt okna, którego nazwa klasy będzie pobierana
'           w środowisku 32 bitowym liczba typu Long
'           w środowisku 64 bitowym liczba typy LongLong
'           w środowisku VBA7 może być typu LongPtr
' [Out] - zwraca nazwę klasy okna
' Przy niepowodzeniu zwraca ciąg zerowej długości ""
'

#If VBA7 Then
  Private Declare PtrSafe Function GetClassName Lib "user32" _
          Alias "GetClassNameA" _
          (ByVal hwnd As LongPtr, _
          ByVal lpClassName As String, _
          ByVal nMaxCount As Long) As Long
#Else
  Private Declare Function GetClassName Lib "user32" _
          Alias "GetClassNameA" _
          (ByVal hwnd As Long, _
          ByVal lpClassName As String, _
          ByVal nMaxCount As Long) As Long
#End If

' Funkcja własna GetWinClassName
#If VBA7 Then
  ' Deklaracja funkcji - zarówno w 32 jak i 64 bitowym środowisku VBA 7
  Public Function GetWinClassName(hWind As LongPtr) As String
#Else
  ' Deklaracja funkcji - tylko 32 bitowe środowisko VBA 6
  Public Function GetWinClassName(hWind As Long) As String
#End If
  
Dim sBuffer           As String
Dim lLenText          As Long
Const cMaxSizeBuffer  As Long = 256

   ' przygotuj bufor na przyjęcie tekstu
   sBuffer = String(cMaxSizeBuffer, vbNullChar)
   ' pobierz długość zwróconego tekstu
   lLenText = GetClassName(hWind, sBuffer, cMaxSizeBuffer)
   ' utnij nadmiarowy ciąg znaków vbNullChar w buforze
   GetWinClassName = Left$(sBuffer, lLenText)
  
End Function

' przykładowe wywołanie:
Private Sub btnTest_Click()
 
  ' pobierz nazwę klasu okna formularza i okna aplikacji MS Access
  MsgBox "Nazwa klasy okna formularza: " & _
         GetWinClassName(Me.hwnd) & vbNewLine & _
        "Nazwa klasy okna MS Access: " & _
         GetWinClassName(Application.hWndAccessApp)
End Sub

Po uruchomieniu przykładowego wywołania, MS Access wyświetla okno komunikatu:

• OMain - jest to nazwa klasy okna MS Access.
• OForm - jest to nazwa klasy okna formularza.

Obie te nazwy klas okien warto zapamiętać, gdyż przydadzą się na następnych stronach, na których będziemy korzystali z funkcji API, by odwoływać się do okien MS Access.

poniedziałek, 1 lutego 2016

• Funkcje API - jak pobrać tytuł (tekst) okna

Czasami w trakcie działania aplikacji MS Access potrzebujemy sprawdzić jaki tytuł (lub tekst) ma okno w systemie Windows. MS Access posiada właściwości pozwalające na odczyt tytułów niektórych okien. Jest to właściwość obiekt.Caption obiektu formularz i obiektu raport. Właściwości obiekt.Caption nie należy mylić z właściwością obiekt.Name, gdyż ta ostatnia zwraca nazwę obiektu, która została podana w trakcie zapisywania projektu. Nazwa ta jest widoczna w „Oknie nawigacji”, dawniej zwanym „Oknem bazy danych”.

Warto pamiętać, że jeżeli w oknie „Arkusz właściwości”, w trybie „Projektowanie”, nie nadamy właściwości Tytuł (Caption) jakiejkowiek wartości (pozostawimy to pole puste), to otwarty formularz (raport) będzie miał tytuł odpowiadający jego nazwie, a właściwość obiekt.Caption będzie ciągiem zerowej długości "". Jak widać, okno formularza (raportu) może mieć tytuł odpowiadający nazwie obiektu obiekt.Name, lub jego tytułowi obiekt.Caption (jeżeli takowa właściwość została ustawiona w oknie „Projektowanie”)

Zagadnienie pobrania tytułu okna jest bardziej skomplikowane, w przypadku pobierania tytułu okna Aplikacji (napis na pasku tytułowym okna MS Access). Teoretycznie sprawa jest niby prosta. Tytuł okna bazy danych przechowywany jest we właściwości CurrentDb.Properties("AppTitle"), ale w przypadku próby pobrania tej właściwości, gdy nie jest ona ustawiona w oknie „Opcje programu Access/Bieżąca baza danych/Tytuł aplikacji”, program MS Access wygeneruje błąd Error.Number = 3270 i wyświetli okno komunikatu o treści:

Aby nasz kod działał prawidłowo, musimy obsłużyć błąd nr 3270, generowany przy próbie odczytu nieistniejącej właściwości "AppTitle", by wyświetlić odpowiednią informację, że nasza aplikacja nie ma ustawionego tytułu.


    MsgBox Forms("NazwaFormularza").Caption '(formularz musi być otwarty)
    ' lub
    MsgBox Me.Caption '(dla bieżącego formularza)
    ' podobnie dla raportu
    MsgBox Reports("NazwaRaportu").Caption '(raport musi być otwarty)
    ' lub
    MsgBox Me.Caption '(dla bieżącego raportu)

 
 ' Okno MS Access 
  ' dla okna bieżącej aplikacji musimy obsłużyć błąd nr 3270,
  ' generowany przy próbie odczytu nieistniejącej właściwości "AppTitle":
  Private Const conPropNotFoundError = 3270
  
  On Error Resume Next
    MsgBox CurrentDb.Properties("AppTitle") ' właściwość musi być ustawiona
    If Err.Number = conPropNotFoundError Then
      MsgBox "Bieżąca Aplikacja:" & vbNewLine & _
            CurrentDb.Name & vbNewLine & _
            "nie posiada tytułu."
      Err.Clear
    End If
  On Error GoTo 0
 

Ale nie zawsze jest tak prosto. Czasami potrzebujemy pobrać tekst (tytuł) okna aplikacji, która nie udostępnia metody pozwalajacej na pobranie tekstu okna. Wtedy z pomocą przychodzi interfejs Windows API i jego dwie funkcje:
• 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.

Option Compare Database
Option Explicit

' • Function GetTextWindow(hWind As Long;[LongLong];[LngPtr]) As String
' --------------------------------------------------------------
' autor: Zbigniew Bratko - 01.2016
' [hWind] - uchwyt okna, którego tytuł (tekst) będzie pobierany
'           w środowisku 32 bitowym liczba typu Long
'           w środowisku 64 bitowym liczba typy LongLong
'           w środowisku VBA7 może być typu LongPtr
' [Out] - zwraca tytuł (tekst) okna
' Przy niepowodzeniu zwraca ciąg zerowej długości ""
'

#If VBA7 Then
  ' Środowisko VBA 7 - zarówno 32 jak i 64 bitowe
  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 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 własna GetTextWindow
#If VBA7 Then
  ' Deklaracja funkcji - zarówno w 32 jak i 64 bitowym środowisku VBA 7
  Public Function GetTextWindow(hWind As LongPtr) As String
#Else
  ' Deklaracja funkcji - tylko 32 bitowe środowisko VBA 6
  Public Function GetTextWindow(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 buffor 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
   GetTextWindow = Left$(sBuffer, lLenText)
 
End Function

' przykładowe wywołanie:
Private Sub btnTest_Click()

  ' pobierz tytuł okna bieżącej aplikacji MS Access
  MsgBox GetTextWindow(Application.hWndAccessApp)

Exit Sub