Determine Which and How many Users are Connected to a Database

Category:

Database

Type:

Snippets

Difficulty:

Intermediate

Author:

Brian Gillham

Version Compatibility: Visual Basic 6

More information:

I think this may work on SQL but I have not tried it. It definitely works on JET4.0 As always the code is FREE. If you want support you pay. Enjoy

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

Code:

Public Function EmptyRS(ByVal oRS) As Boolean

On Error Resume Next

'Checks for an EMPTY RecordSet
    EmptyRS = True
    If Not oRS Is Nothing Then
        EmptyRS = ((oRS.BOF = True) And (oRS.EOF = True))
    End If

End Function

Public Function GetDBUsers() As ADODB.Recordset

' NOTES: Fields as follows
    ' 0 - COMPUTER_NAME:    Workstation
    ' 1 - LOGIN_NAME:       Name used to Login to DB
    ' 2 - CONNECTED:        True if Lock in LDB File
    ' 3 - SUSPECTED_STATE:  True if user has left database in a suspect state(else Null)

On Error GoTo LocalError

Const JET_SCHEMA_USERROSTER = "{947bb102-5d43-11d1-bdbf-00c04fb92675}"

' Return a Disconnected RecordSet
    If cnADO.State = adStateOpen Then
        Set GetDBUsers = cnADO.OpenSchema(adSchemaProviderSpecific, , JET_SCHEMA_USERROSTER)
        Set GetDBUsers.ActiveConnection = Nothing
    End If

LocalError:
End Function

Public Function GetDBUserCount() As Long

On Error GoTo LocalError

Dim lRS As ADODB.Recordset

Set lRS = GetDBUsers
    If Not EmptyRS(lRS) Then
        GetDBUserCount = lRS.RecordCount
        lRS.Close
    End If

LocalError:
    Set lRS = Nothing
End Function