|
General |
| 6.165 Evitare una multisessione di Access |
| Giorgio Rancati |
|
Richiamando la funzione che segue all'apertura di un database Access, si verisfica se tale database è già aperto, nel qual caso il database viene subito richiuso evitando che venga aperta una seconda sessione di tale database.
Function IsMultisession() AS Boolean
'Questa Routine è stata sviluppata da GIORGIO RANCATI
'
Dim NomeLdb as String
Dim i AS Integer
NomeLdb = Application.CurrentDb.Name
Mid(NomeLdb, Len(NomeLdb) - 2, 3) = "Ldb"
'Apro l'LDB e controllo che non sia maggiore di 64 byte
'Ogni 64 byte è un accesso al Db
Open NomeLdb For Binary Access Read Write As #1
If LOF(1) > 64 Then i = -1
Close #1
If i Then
MsgBox "Impossibile aprire il database nello stesso tempo più di una volta"
Application.Quit
'Non serve ritornare nessun parametro perchè
'l'applicazione viene interrotta brutalmente
End If
IsMultisession=False
End Function
In alternativa alla funzione di cui sopra scritta da Giorgio Rancati, per non aprire un database in multisessione si può usare le funzioni che seguono, di autore non conosciuto e basate su DDE.
'***********************************************************************
' As duas funções a seguir rodam em qualquer versão do Access e servem
' para checar se já existe uma instância do arquivo mdb aberta.
' Caso positivo, a função IsRunning() não permite a nova abertura
' do banco de dados.
'
' FUNÇÕES: IsRunning() e TestDDELink(ByVal strAppName$)
'
'***********************************************************************
Function IsRunning()
Dim db As DAO.Database
Set db = CurrentDb()
If TestDDELink(db.Name) Then
MsgBox "Avviso:" & "@@L'aplicativo è già in esecuzione in" _
& vbCrLf & "un'altra istanza di Windows!", vbCritical, "Seconda istanza di un applicativo"
Application.Quit acQuitSaveNone
End If
End Function
' Função Auxiliar de IsRunning()
Function TestDDELink(ByVal strAppName$) As Integer
Dim varDDEChannel
On Error Resume Next
Application.SetOption ("Ignore DDE Requests"), True
varDDEChannel = DDEInitiate("MSAccess", strAppName)
' When the app isn't already running this will error
If Err Then
TestDDELink = False
Else
TestDDELink = True
DDETerminate varDDEChannel
DDETerminateAll
End If
Application.SetOption ("Ignore DDE Requests"), False
End Functio La funzione IsRunning() fa riferimento alla libreria Microsoft DAO quindi, se si usa una versione di Access successiva ad Access 97, occorre aggiungere ai riferimenti del database tale libreria. |