Ciao,
come detto in precedenza potresti fare una cosa molto semplice in questo modo dove:
- viene creata una tabella con una colonna di tipo string dove salvare il nome dei pc client che hanno effettuato l'accesso all'applicazione
- in fase di open dell'applicazione creare un record nella tabella accessi
- controllare e ritornare all'applicazione se ci sono più client che hanno eseguito l'accesso
- iin questo caso è sufficiente avere come ritorno un valore booleano Vero o Falso per il quale accendi o spengi i tuoi semafori e/o altro
- in fase di close dell'applicazione eliminare il record di accesso creato nella tabella
Per ottemperare a quanto sopra riportato, puoi inserire nel progetto, in un modulo, delle funzioni public come da esempio:
' CHECK PC CLIENT ACCESS TO APPLICATION
Public Function MyCheckClientAccess() As Boolean
' set return default value
MyCheckClientAccess = False
' set table name
Dim tblName As String
tblName = "TblClientAccess"
' check if table exist in the database... and create table
MyCreateClientAccessTable (tblName)
' insert your computer name in the pc client access table
If DBEngine(0)(0).OpenRecordset("SELECT PcName FROM " & tblName & " WHERE PcName = '" & Environ("COMPUTERNAME") & "';", dbReadOnly).EOF Then
DBEngine(0)(0).Execute "INSERT INTO " & tblName & " (PcName) VALUES ('" & Environ("COMPUTERNAME") & "');"
End If
' check and return function value: true=there are multiple pc connected - False=there are no other pc connected
Dim varResult As Variant
varResult = DBEngine(0)(0).OpenRecordset("SELECT COUNT(*) FROM " & tblName & ";", dbReadOnly).Fields(0).Value
' set return value
If varResult > 1 Then MyCheckClientAccess = True
End Function
' CREATE TABLE PC CLIENT ACCESS
Public Sub MyCreateClientAccessTable(tblName As String)
' set variables database
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
' set db
Set db = CurrentDb
' check if extst
On Error Resume Next
Set tdf = db.TableDefs(tblName)
On Error GoTo 0
' if not exist create table
If tdf Is Nothing Then
' set tabledef
Set tdf = db.CreateTableDef(tblName)
' add column
Set fld = tdf.CreateField("PcName", dbText, 100)
tdf.Fields.Append fld
' add table in the database
db.TableDefs.Append tdf
End If
' close
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
End Sub
' DELETE PC NAME IN THE APPLICATION CLIENT ACCESS TABLE
Public Sub MyClosePcClientAccess()
DBEngine(0)(0).Execute "DELETE FROM TblClientAccess WHERE PcName = '" & Environ("COMPUTERNAME") & "';"
End Sub
Qui trovi tre funzioni:
- MyCheckClientAccess - questa funzione si occupa di:
- controllare se esiste la tabella e se non esiste la crea con la funzione MyCreateClientAccessTable
- MyCreateClientAccessTable - questa funzione viene richiamata dalla funzione MyCheckClientAccess
- se non esiste la tabella viene creata
- nella tabella viene creata una sola colonna di tipo string dove verrà memorizzato il nome del pc client che ha aperto l'applicazione
- MyClosePcClientAccess - questa funzione viene richiamata in fase di chiusura dell'applicazione e ha il compito di eliminare il record che contiene il nome del pc client che aveva aperto l'applicazione
** Ho cercato di commentare il codice il più possibile per una maggiore comprensione, verificare eventuali errori e nel caso apportare le modifiche e/o correzioni
Un esempio di come richiamare le funzioni sopra descritte:
' creating access to the application
If MyCheckClientAccess Then
MsgBox "Esistono più Client Collegati" ' Inserire le istruzioni per ACCENDERE IL SEMAFORO
Else
MsgBox "Non ci sono altri Client Collegati" ' Inserire le istruzioni per SPENGERE IL SEMAFORO
End If
Questa funzione viene richiamata in fase di open dell'applicazione e qui puoi gestire il valore di ritorno dove True = “Esistono più Client Collegati” e pertanto con questo valore puoi condizionare l'accensione del tuo semaforo per indicare che non si è soli. ;)
La stessa provvede a memorizzare in un nuovo record il nome del proprio pc client che ha aperto l'applicazione.
N.B. se ci sono più pc client con lo stesso nome e sono tutti collegati, il primo che esce dall'applicazione cancellerà non solo il proprio accesso ma anche tutti gli altri. Assicurarsi di avere i pc client con nome diverso, oppure memorizzare il mac address ( che corrisponde ad un nome univoco ) dei pc cliente invece del nome, oppure modificare la stringa sql per eliminare solo il primo pc client che corrisponde al nome.
' eliminates access to the application when closing
MyClosePcClientAccess
Questa funzione viene richiamata in fase di chiusura dell'applicazione ed eliminerà il record creato in fase di apertura dell'applicazione.
In definitiva non devi far altro che copiare le funzioni in un modulo e richiamarle come da esempi sopra riportati.
Non devi creare la tabella in quanto lo fa in modo automatico.
Gestire il valore di ritorno True or False per accendere o spengere il semaforo … o altri metodi che preferisci.
Una cosa che puoi fare con queste funzioni per esempio è quella di poter controllare a tuo piacimento o in automatico lo stato di connessioni, dei pc client, all'applicazione.
Per esempio puoi richiamare più volte nel corso dell'utilizzo dell'applicazione, la funzione MyCheckClientAccess e valutare il valore di ritorno che restituisce: se ritorna False allora spengere il semaforo, questo vuol dire che gli altri client nel frattempo si sono scollegati dall'applicazione.
Se invece ritorna True allora il semaforo rimane acceso (oppure si accende) ad indicare che altri client hanno aperto l'applicazione.
Per esempio puoi anche richiamare tale funzione in automatico con l'oggetto Timer fissando un certo intervallo di tempo e ogni tot secondi ti fa la verifica e accende o spenge il semaforo. Insomma, una cosa di questo tipo….
Oppure puoi inserire il richiamo della funzione in un Pulsante e a tuo piacimento quando fai il click ti esegue la funzione e accende o spenge il semaforo.
Una cosa da notare è quella di avere il semaforo acceso che indica l'esistenza di altri pc client che hanno aperto l'applicazione, ma di fatto sei l'unico ad aver aperto l'applicazione. Questo significa che uno o più pc cliente hanno aperto l'applicazione e hanno avuto una chiusura anomala della stessa. In questo caso rimarrà anche attivo il file .laccdb. Consultando la tabella accessi client puoi risalire al pc client che ha avuto tale anomalia.
Questo è solo un semplice esempio di cosa potresti fare e se fa al caso tuo verifica il nome della tabella che viene creata che non vada in conflitto con le altre che hai nel progetto… inserisci eventuali controlli… prova e riprova, fai dei test e vedi se può andar bene… ;)
N.B. puoi modificare la tabella aggiungendo tutte le colonne che desideri per memorizzare qualsiasi altri tipi di informazioni… per esempio la data/ora di acesso all'aplicazione , il nome del login di accesso al sistema operativo… ecc…ecc…
Per apportare queste modifiche intervenire in questo passo del codice:
Per esempio puoi implementare nel seguente modo le parti del codice per creare la tabella :
' if not exist create table
If tdf Is Nothing Then
' set tabledef
Set tdf = db.CreateTableDef(tblName)
' add column pc name
Set fld = tdf.CreateField("PcName", dbText, 100)
tdf.Fields.Append fld
' add column pc mac address
Set fld = tdf.CreateField("PcMacAddress", dbText, 100)
tdf.Fields.Append fld
' add column pc access date
Set fld = tdf.CreateField("PcDate", dbDate)
tdf.Fields.Append fld
' add table in the database
db.TableDefs.Append tdf
End If
e la parte di inserimento record pc client in questo modo :
' insert your computer name in the pc client access table
If DBEngine(0)(0).OpenRecordset("SELECT PcName FROM " & tblName & " WHERE PcName = '" & Environ("COMPUTERNAME") & "';", dbReadOnly).EOF Then
DBEngine(0)(0).Execute "INSERT INTO " & tblName & " (PcName, PcMacAddress, PcDate) VALUES ('" & _
Environ("COMPUTERNAME") & "', '" & _
GetMacAddress & "', #" & _
Now() & "#);"
End If
A tal fine inserire nel modulo la function GetMacAddress per estrarre il mac address del pc client… per esempio:
' GET MAC ADDRESS PC
Function GetMacAddress() As String
' set obj
Dim objWMI As Object
Dim colItems As Object
Dim objItem As Object
' set default return value
GetMacAddress = ""
' create obj wmi
Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
' get items
Set colItems = objWMI.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
' read
For Each objItem In colItems
' get mac address
If Not IsNull(objItem.MACAddress) Then
GetMacAddress = objItem.MACAddress
Exit For
End If
Next objItem
' close
Set objWMI = Nothing
Set colItems = Nothing
Set objItem = Nothing
End Function
A questo punto la tabella creata assumerà questo aspetto con le suddette info:
Il nome del Pc client che ha aperto l'applicazione, il suo MacAddress e la data ora di accesso.
(in questo caso le info riportate sono nomi e indirizzi di fantasia)
( Sono solo esempi da verificare e testare )