|
1.11 Jak uniemożliwić otwarcie drugiej instancji bazy ?
grupa: pl.comp.bazy-danych.msaccess
wątek: Raport i OpenArgs (< A'XP)
w oparciu o artykuł: Rafała Posmyka
<REM BraZby>
' Private Declare Function CreateMutex Lib "kernel32" _
Alias "CreateMutexA" _
(lpMutexAttributes As Long, _
ByVal bInitialOwner As Long, _
ByVal lpName As String) As Long
</BraZby>
Private Declare Function CreateMutex Lib "kernel32" _
Alias "CreateMutexA" _
(lpMutexAttributes As SECURITY_ATTRIBUTES, _
ByVal bInitialOwner As Long, _
ByVal lpName As String) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
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 Const ERROR_ALREADY_EXISTS = &HB7
Private hMutex As Long
' utwórzmy makro AutoExec:
' Action = RunCode
' FunctionName = rpCreateMutex ()
' a w module standardowym utwórzmy dwie publiczne Funkcje
Public Function rpCreateMutex() As Long
Dim sa As SECURITY_ATTRIBUTES
sa.nLength = Len(sa)
' <cyt>
' > Ano pozwoliłem sobie mlasnąć jeden (przykład):
' Zgadnijcie co zrobi poniższy kod
' (wykonany z makra Autoexec):
' ...
Rem hMutex = CreateMutex(0&, 1, "Mutex.myAppName")
hMutex = CreateMutex(sa, 1, "Mutex.myAppName")
If (Err.LastDllError = ERROR_ALREADY_EXISTS) Then
Call ReleaseMutex(hMutex)
Call CloseHandle(hMutex)
MsgBox "Pan pozwolił tylko raz !"
Application.Quit
Else
rpCreateMutex = 1
' ... DoCmd.OpenForm "frmStart"
End If
' ...
' No właśnie zapobiega, że baza zostanie otwarta więcej niż
' raz (pomijam problematykę klawisza <Shift>). A jak zaprzęgniemy
' do tego semafor to możemy nawet pozwolić wystartować n razy.
' </ cyt>
End Function
' funkcję poniższą powinniśmy uruchomić przy zamykaniu bazy,
' lub gdy chcemy zezwolić by była otwarta druga instancja bazy.
Public Function rpReleaseMutex() As Long
If hMutex <> 0 Then
If ReleaseMutex(hMutex) <> 0 Then _
rpReleaseMutex = CloseHandle(hMutex)
End If
End Function
ΔΔΔ | |
|
1.12 Jak sprawdzić, czy jest otwarta druga instancja MS Access ?
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
' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim lRet As Long
Const MY_CLASS_NAME As String = "OMain"
lRet = zbCountWindClass(MY_CLASS_NAME)
Select Case lRet
Case Is = 1
MsgBox "OK. Otwarta jest tylko bieżąca instancja MS Access"
Case Is > 1
MsgBox "Otwarto dodatkowo " & lRet - 1 & _
" egz. innych instancji Access'a"
' Application.Quit
Case Else
MsgBox "Nie znaleziono okna Access'a ?"
End Select
End Sub
' • sClassName - nazwa szukanej klasy okna,
' • sWinTitle - tytuł szukanego okna, dla ciągu zerowej długości
' zliczane są wszystkie okna klasy sClassName,
Private Function zbCountWindClass(sClassName As String, _
Optional sWinTitle As String = "") As Long
Dim hNext As Long
Dim lCount As Long
Dim hDsk As Long
' ciąg zerowej długości "" to nie to samo co vbNullString
If Len(sWinTitle) = 0 Then sWinTitle = vbNullString
hDsk = GetDesktopWindow
hNext = FindWindowEx(hDsk, ByVal hNext, ByVal sClassName, ByVal sWinTitle)
Do Until hNext = 0
lCount = lCount + 1
hNext = FindWindowEx(hDsk, ByVal hNext, sClassName, sWinTitle)
Loop
zbCountWindClass = lCount
End Function
ΔΔΔ | |
• I.1. Access - baza danych cz. 1 •