- Public Function GetDBCurrentUsers(pDataBasePath as String, pUsersList As Control, Optional ByVal pClearListFirst As Boolean = False)
- Dim rep As Long, LDBFile As String
- Dim FileID As Long, Buffer As String * 300
- Dim pos1 As Long, pos2 As Long
-
- 'On Error GoTo GetDBCurrentUsersError
-
- If pClearListFirst Then pUsersList.Clear
-
- 'Chemin du fichier de verrous de la base
- LDBFile = pDataBasePath & "\" & App.EXEName & ".LDB"
-
- 'Envoi de l'erreur dans le fichier d'erreur de l'application
- FileID = FreeFile
-
- Open LDBFile For Binary Access Read As FileID
-
- 'Lecture complète du fichier dans la structure
- Get FileID, , Buffer
- pos1 = 1
- Do
- pos2 = InStr(pos1 + 1, Buffer, Chr$(0))
- If pos2 > 0 Then If InStr(Mid$(Buffer, pos1, pos2 - pos1), " ") = 0 And pos2 - pos1 > 1 Then pUsersList.AddItem Mid$(Buffer, pos1, pos2 - pos1)
- pos1 = pos2 + 1
- Loop While pos1 > 0 And pos2 > 0
- Close FreeFile
-
- GetDBCurrentUsersError:
- Exit Function
- End Function
-
Public Function GetDBCurrentUsers(pDataBasePath as String, pUsersList As Control, Optional ByVal pClearListFirst As Boolean = False)
Dim rep As Long, LDBFile As String
Dim FileID As Long, Buffer As String * 300
Dim pos1 As Long, pos2 As Long
'On Error GoTo GetDBCurrentUsersError
If pClearListFirst Then pUsersList.Clear
'Chemin du fichier de verrous de la base
LDBFile = pDataBasePath & "\" & App.EXEName & ".LDB"
'Envoi de l'erreur dans le fichier d'erreur de l'application
FileID = FreeFile
Open LDBFile For Binary Access Read As FileID
'Lecture complète du fichier dans la structure
Get FileID, , Buffer
pos1 = 1
Do
pos2 = InStr(pos1 + 1, Buffer, Chr$(0))
If pos2 > 0 Then If InStr(Mid$(Buffer, pos1, pos2 - pos1), " ") = 0 And pos2 - pos1 > 1 Then pUsersList.AddItem Mid$(Buffer, pos1, pos2 - pos1)
pos1 = pos2 + 1
Loop While pos1 > 0 And pos2 > 0
Close FreeFile
GetDBCurrentUsersError:
Exit Function
End Function