Listing the current users of a shared database 
Author Message
 Listing the current users of a shared database

I'd like to be able to identify who is logged-on to a multi-user
database.  Problem is that all the suggestions I've seen so far (such
as msldbusr.dll, etc) list the machine name and not the workgroup
username.

Does anyone have a technique for identifying currently logged-on,
active users by their usernames?

Thanks,

Mike

--== Sent via Deja.com http://www.*-*-*.com/
---Share what you know. Learn what you don't.---



Sat, 10 Nov 2001 03:00:00 GMT  
 Listing the current users of a shared database
Hi Mike,

  If the names are different internally in the mdw, then you are probably
best off maintaining a Log table where every user is checked in upon
starting the mdb, and checkout upon exiting or after a timeout interval.

    HTH
    -- Dev


: I'd like to be able to identify who is logged-on to a multi-user
: database.  Problem is that all the suggestions I've seen so far (such
: as msldbusr.dll, etc) list the machine name and not the workgroup
: username.
:
: Does anyone have a technique for identifying currently logged-on,
: active users by their usernames?
:
: Thanks,
:
: Mike
:
:
:
: --== Sent via Deja.com http://www.deja.com/ ==--
: ---Share what you know. Learn what you don't.---



Sat, 10 Nov 2001 03:00:00 GMT  
 Listing the current users of a shared database


Quote:
> I'd like to be able to identify who is logged-on to a multi-user
> database.  Problem is that all the suggestions I've seen so far (such
> as msldbusr.dll, etc) list the machine name and not the workgroup
> username.

> Does anyone have a technique for identifying currently logged-on,
> active users by their usernames?

Mike,

We use a shareware program called LDBview.  I can't remember where we got it
though.  Might try download.com.

Good luck,
Dave



Sat, 10 Nov 2001 03:00:00 GMT  
 Listing the current users of a shared database
Dave,

Thanks for the suggestion.  I've tried LDBView.  I originally found it
in Jetutils.exe where it is bundled with a number of other utilities
including msldbusr.dll.

For anyone else who's interested, Jetutils.exe can be downloaded from
http://support.microsoft.com/download/support/mslfiles/Jetutils.exe

Unfortunately LDBView returns the machine name and not the logged-on
user name, so it doesn't really do what I want.

Regards,

Mike

--== Sent via Deja.com http://www.deja.com/ ==--
---Share what you know. Learn what you don't.---



Sun, 11 Nov 2001 03:00:00 GMT  
 Listing the current users of a shared database

Hiya,
This is a class I made based on an article in VBA/Office advisor
(http://www.advisor.com):

Option Compare Database
Option Explicit

Private Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type
Private Type SecInfo
  bMachine(1 To 32) As Byte
  bSecurity(1 To 32) As Byte
End Type
Private Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        Offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type

Private Type SecUser
  Name As String
  Machine As String
'  Offset As Integer
End Type

Private Const FILE_CURRENT = 1
Private Const FILE_BEGIN = 0
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3
Private Const FILE_FLAG_RANDOM_ACCESS = &H10000000
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const mcszSOURCE = "Security"

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA"
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal
dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal
dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal
hTemplateFile As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As
Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal
dwMoveMethod As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long,
lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead
As Long, lpOverlapped As OVERLAPPED) As Long
Private Declare Function LockFile Lib "kernel32" (ByVal hFile As Long,
ByVal dwFileOffsetLow As Long, ByVal dwFileOffsetHigh As Long, ByVal
nNumberOfBytesToLockLow As Long, ByVal nNumberOfBytesToLockHigh As Long)
As Long
Private Declare Function UnlockFile Lib "kernel32" (ByVal hFile As Long,
ByVal dwFileOffsetLow As Long, ByVal dwFileOffsetHigh As Long, ByVal
nNumberOfBytesToUnlockLow As Long, ByVal nNumberOfBytesToUnlockHigh As
Long) As Long
Private Declare Function CloseFile Lib "kernel32" Alias "CloseHandle"
(ByVal hFile As Long) As Long

Private mSecurity As SECURITY_ATTRIBUTES
Private mlFileHandle As Long
Private mszDbName As String
Private mszLockFile As String
Private KeepLock As Boolean
Property Let Database(FileName As String)
  Dim Db As Database
  If Not FileExist(FileName) Then
    Err.Raise 3024, "Security" & ".Database", "'" & FileName & "' Does
not Exist"
  Else
    On Error Resume Next
    Set Db = DBEngine(0).OpenDatabase(FileName, , True)
    If Err > 0 Then
      On Error GoTo 0
      Err.Raise 3343, "Security" & ".Database", "'" & FileName & "' is
not a Database"
    End If
    mszLockFile = Left(FileName, InStr(FileName, ".")) & "LDB"
    mszDbName = FileName
  End If
End Property
Property Get Database() As String
  Database = mszDbName
End Property
Private Function BytesToString(pbytArray() As Byte) As String
On Error Resume Next
  Dim szTemp As String
  szTemp = StrConv(pbytArray(), vbUnicode)
  BytesToString = Trim(Left$(szTemp, (InStr(1, szTemp, Chr(0))) - 1))
End Function
Private Function FileExist(FileName As String) As Boolean
  On Error Resume Next
  FileExist = Len(Dir(FileName)) > 0
End Function
Private Function HexToLong(ByVal strHex As String) As Long
  On Error Resume Next
  HexToLong = Val("&H" & strHex & "&")
End Function
Private Function GetLockFile(ByVal DbName As String) As Long
  Dim mszLockFile As String
  mszLockFile = Left(DbName, InStr(DbName, ".")) & "ldb"
  mlFileHandle = CreateFile(mszLockFile, _
                            GENERIC_READ Or GENERIC_WRITE, _
                            FILE_SHARE_READ Or FILE_SHARE_WRITE,
mSecurity, _
                            OPEN_EXISTING, _
                            FILE_FLAG_RANDOM_ACCESS Or
FILE_ATTRIBUTE_NORMAL, 0)
  With mSecurity
    .nLength = Len(mSecurity)
    .lpSecurityDescriptor = 0
    .bInheritHandle = True
  End With
  GetLockFile = mlFileHandle
End Function
Private Function ReadLockingFile(ByRef UserList As Variant, Optional
ByRef DbName As String = "", Optional ByRef UserCnt As Integer = 0) As
Integer
  Dim szMachine As String, szUser As String
  Dim uSecInfo As SecInfo
  ReDim aszTempUserList(0 To 254, 0 To 2) As String
  Dim aszUserList() As String
  Dim iaCnt As Integer, iCnt As Integer
  Dim iOffSet As Integer
  Dim lBytesRead As Long, szProcName As String
  Dim bResult As Long
  Dim uOverLapped As OVERLAPPED
  On Error GoTo 0
  szProcName = mcszSOURCE & ".ReadLockingFile"
  iOffSet = 0
  If Len(DbName) = 0 Then
    If Len(mszDbName) = 0 Then
      mszDbName = DBEngine(0)(0).Name
    End If
    DbName = mszDbName
  End If
  mszDbName = DbName
  mlFileHandle = GetLockFile(DbName)
  bResult = ReadFile(mlFileHandle, uSecInfo, 64, lBytesRead,
uOverLapped)
  If bResult = 0 Then
    UserCnt = 0
    UserList = Empty
    Err.Raise vbObjectError + 1050, szProcName, "Can't Read From
Security File"
  End If
  While bResult = 1
    With uSecInfo
      aszTempUserList(iaCnt, 0) = BytesToString(.bSecurity)
      aszTempUserList(iaCnt, 1) = BytesToString(.bMachine)
      aszTempUserList(iaCnt, 2) = iOffSet
      iaCnt = iaCnt + 1
      iOffSet = iOffSet + 64
    End With
    uOverLapped.Offset = iOffSet
    bResult = ReadFile(mlFileHandle, uSecInfo, 64, lBytesRead,
uOverLapped)
  Wend
  'ReDim aszTempUserList(0 To iaCnt, 0 To 2) As String
  If iaCnt > 0 Then
    ReDim Tmp(0 To iaCnt, 0 To 2) As String
    For iCnt = 0 To iaCnt - 1
      Tmp(iCnt, 0) = aszTempUserList(iCnt, 0)
      Tmp(iCnt, 1) = aszTempUserList(iCnt, 1)
      Tmp(iCnt, 2) = aszTempUserList(iCnt, 2)
    Next
    UserList = Tmp 'aszTempUserList
  Else
    UserList = Empty
  End If
  UserCnt = iaCnt
  ReadLockingFile = iaCnt

End Function
Function AllUsers(ByRef UserList As Variant, Optional ByRef DbName As
String = "", Optional ByRef UserCnt As Integer = 0) As Integer
  AllUsers = ReadLockingFile(UserList, DbName, UserCnt)
  CloseFile mlFileHandle
End Function
Function CurrentUsers(ByRef UserList As Variant, Optional ByRef DbName
As String = "", Optional ByRef CntUsers As Integer) As Integer
  Dim dwPos As Long
  Dim lLock As Long
  Dim lByte As Long
  Dim iaCnt As Integer
  Dim iOffSet As Integer
  ReDim aiUserLockOffset(255) As Integer
  dwPos = &H10000001
  iaCnt = 0
  ReadLockingFile UserList, DbName, CntUsers
  For dwPos = &H10000001 To &H100000FF
    lLock = LockFile(mlFileHandle, dwPos, 0, 1, 0)
    If lLock = 0 Then
      lByte = HexToLong(Right(Hex(dwPos), 2))
      iOffSet = lByte * 64 - 64
      aiUserLockOffset(iaCnt) = iOffSet
      iaCnt = iaCnt + 1
    Else
      lLock = UnlockFile(mlFileHandle, dwPos, 0, 1, 0)
    End If
  Next dwPos
  If iaCnt = 0 Then
    UserList = Empty
  End If
  CntUsers = iaCnt
  CurrentUsers = iaCnt
  CloseFile mlFileHandle
End Function

Function IsUserLoggedOn(ByVal UserName As String, Optional ByRef
MachineInfo As Variant, _
                        Optional ByRef UserCount As Integer = 0) As
Boolean
  'ReDim pBuffer(0 To 254) As SecUser
  Dim pBuffer As Variant
  Dim iaCnt As Integer, iUsrCnt As _
     Integer
  Dim bFound As Boolean, aszMachines() As String
  Dim bMachArray As Boolean, iCount As Integer

  ' Handle the optional variables.
  bMachArray = False
  If Not IsMissing(MachineInfo) Then bMachArray = True

  ' Initialize variables.
  UserCount = 0
  iCount = 0
  IsUserLoggedOn = False
  bFound = False

  ' Retrieve a two-dimensional array containing all
  ' the user and machine names currently using
  ' the database.
  CurrentUsers pBuffer

  ' Retrieve count. If zero then exit function.
  If IsEmpty(pBuffer) Then Exit Function
  iUsrCnt = UBound(pBuffer, 1)

  ' Determine if User is logged on.
  ' Redim the array to hold the machine names.
  If bMachArray Then
    ReDim aszMachines(255) As String

    ' Loop through the array.
    ' Store the machine names into an array.
    For iaCnt = 0 To iUsrCnt - 1
      If UCase$(UserName) = UCase$(pBuffer(iaCnt, 0)) Then
        aszMachines(iCount) = pBuffer(iaCnt, 1)
        iCount = iCount + 1
        bFound = True
       End If
    Next

    If bFound Then

      ' Redim the array and return array.
      ReDim Preserve aszMachines(iCount)

      MachineInfo = aszMachines

    End If
  Else
    ' Assign the count.
    For iaCnt = 0 To iUsrCnt - 1
      If UCase$(UserName) = UCase$(pBuffer(iaCnt, 0)) Then
        iCount = iCount + 1
       End If
    Next

  End If

  UserCount = iCount
  IsUserLoggedOn = (UserCount > 0)

  ' Clear the arrays.
  Erase pBuffer
  Erase aszMachines

End Function

Property Get GetUser(Index As Byte) As String
  Dim UserList As Variant
  Dim i As Byte
  CurrentUsers UserList
  If IsEmpty(UserList) Then
    GetUser = ""
  Else
    GetUser = UserList(Index, 0)
  End If
End Property

Property Get GetIndex(UserName As String) As Byte
  Dim UserList As Variant
  Dim i As Byte
  CurrentUsers UserList
  If IsEmpty(UserList) Then
    GetIndex = 0
  Else
    For i = 0 To UBound(UserList)
      If StrComp(UCase$(UserList(i, 0)), UCase$(UserName)) = 0 Then
        GetIndex = i + 1
        Exit For
      End If
    Next i
  End If
End Property

--
Regards
Pieter Wijnen


http://www.thuleeng.com

Tough guys don't take backup - tough guys cry a lot..

Good site to look for Access answers is:
http://home.att.net/~dashish

  wijnen.vcf
< 1K Download


Sun, 11 Nov 2001 03:00:00 GMT  
 Listing the current users of a shared database

Thanks Pieter.  Much appreciated.

Mike

Sent via Deja.com http://www.deja.com/
Share what you know. Learn what you don't.



Tue, 13 Nov 2001 03:00:00 GMT  
 Listing the current users of a shared database
Here is a simple solution to keep track of who is currently using the
database, and a log of who have used the database.

It is based on a hidden form that is open when the database is opened, and
is closed when the database is closed.

tblCurrentUsers:
Field, Type
LogID, Counter
CurrentUser, Text
Login, DateTime

tblUsersLog:
Field, Type
LogID, Counter
CurrentUser, Text
Login, DateTime
Logout, DateTime
Logtime, DateTime

frmCurrentUserLogID:
txtCurrentUserLogID

Private Sub Form_Close()
Dim dbs As Database, rst As Recordset, rstLog As Recordset
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblCurrentUsers", dbOpenTable)
rst.Index = "PrimaryKey"
rst.Seek "=", txtCurrentUserLogID
If Not rst.NoMatch Then
    Set rstLog = dbs.OpenRecordset("tblUsersLog", dbOpenTable)
    With rstLog
        .AddNew
        !CurrentUser = rst!CurrentUser
        !Login = rst!Login
        !Logout = Now
        !Logtime = !Logout - !Login
        .Update
        .Close
    End With
    rst.Delete
End If
rst.Close
dbs.Close
End Sub

Private Sub Form_Load()
Dim dbs As Database, rst As Recordset
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblCurrentUsers", dbOpenTable)
rst.AddNew
rst!CurrentUser = CurrentUser
rst!Login = Now
txtCurrentUserLogID = rst!LogID
rst.Update
rst.Close
dbs.Close
End Sub

Autoexec macro:
Action: OpenForm
Form name: frmCurrentUserLogID
Window Mode: Hidden



Fri, 16 Nov 2001 03:00:00 GMT  
 
 [ 7 post ] 

 Relevant Pages 

1. Is current database opened exclusive/shared?

2. List Users Share

3. Getting list of users that have permissions on a share

4. Listing Shared connected users under W95/98.

5. Shared folder user list

6. List of all files of a current user?

7. Kicking users off a shared database

8. Question about Access database shared by multi-user

9. Lock Database sharing after a specific number of simultanesly users

10. Determining current users logged on to database

11. Getting the User Group name using Current User Function

12. Current Domain User Name of logged in user?

 

 
Powered by phpBB® Forum Software