Hi Nick
Here's the code that will allow you to read the names of the users that are
currently using the database. This is done by reading the .LDB file.
This code is from an actual application, so if you would like a copy of this
please let me know. I'll strip down the app and send you the pertinent pieces.
PS - LoggedOn is the name assigned to the list box that displays the users.
Also, this routine was created with Access 97, so you may have to modify it.
Best regards
Maurice St-Cyr
Micro Systems Consultants, Inc.
Option Compare Database
Option Explicit
' Declare a record type to break down the user info
Private Type UserRec
bMach(1 To 32) As Byte ' 1st 32 bytes hold machine name
bUser(1 To 32) As Byte ' 2nd 32 bytes hold user name
End Type
Private Sub Form_Open(Cancel As Integer)
Me.LoggedOn.RowSource = WhosOn()
End Sub
Private Sub OKBtn_Click()
DoCmd.Close A_FORM, "frmLoggedOn"
End Sub
Private Sub UpdateBtn_Click()
Me.LoggedOn.RowSource = WhosOn()
End Sub
'-------------------------------------------------------------------------
------------
' Subject : WhosOn()
' Purpose : Will read *.LDB file and read who's currently
' logged on and their station name.
'
' The LDB file has a 64 byte record.
'
' The station name starts at byte 1 and is null
' terminated.
'
' Log-in names start at the 33rd byte and are
' also null terminated.
'
'-------------------------------------------------------------------------
------------
Private Function WhosOn() As String
On Error GoTo Err_WhosOn
Dim iLDBFile As Integer, iStart As Integer
Dim iLOF As Integer, I As Integer
Dim sPath As String, X As String
Dim sLogStr As String, sLogins As String
Dim sMach As String, sUser As String
Dim rUser As UserRec ' Defined in General
Dim dbCurrent As DATABASE
' Get Path of current database. Should substitute this code
' for an attached table path in a multi-user environment.
Set dbCurrent = DBEngine.Workspaces(0).Databases(0)
sPath = dbCurrent.Name
dbCurrent.Close
' Iterate thru dbCurrent.LDB file for login names.
sPath = Left(sPath, InStr(1, sPath, ".")) + "LDB"
' Test for valid file, else Error
X = Dir(sPath)
iStart = 1
iLDBFile = FreeFile
Open sPath For Binary Access Read Shared As iLDBFile
iLOF = LOF(iLDBFile)
Do While Not EOF(iLDBFile)
Get iLDBFile, , rUser
With rUser
I = 1
sMach = ""
While .bMach(I) <> 0
sMach = sMach & Chr(.bMach(I))
I = I + 1
Wend
I = 1
sUser = ""
While .bUser(I) <> 0
sUser = sUser & Chr(.bUser(I))
I = I + 1
Wend
End With
sLogStr = sMach & " -- " & sUser
If InStr(sLogins, sLogStr) = 0 Then
sLogins = sLogins & sLogStr & ";"
End If
iStart = iStart + 64 'increment to next record offset
Loop
Close iLDBFile
WhosOn = sLogins
Exit_WhosOn:
Exit Function
Err_WhosOn:
If Err = 68 Then
MsgBox "Couldn't populate the list", 48, "No LDB File"
Else
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
Close iLDBFile
End If
Resume Exit_WhosOn
End Function
