MartyConnelly
martyconnelly at shaw.ca
Thu Jun 29 13:13:54 CDT 2006
Some of those character strings returned by UserRoster are of C Type
zero length
and you have to step through chararacter by character and handle nulls
yourself
Here is an example I wrote years ago in 97 using ADO maybe it helps or
gives hints.
There is also code to give ISAM stats
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=28652&lngWId=1
basic guts
How to determine what users are connected to your Access database
and the machine name that it is connected to. This uses the Jet OLE DB
Provider Defined Schema Rowsets Constants
Global Const JET_SCHEMA_USERROSTER = "{947bb102-5d43-11d1-bdbf-
00c04fb92675}"
This avoids having to install the Msldbusr.dll provided with
the ldbviewer. Although you will need at least MDAC ADO 2.5 installed
to use this method. For ldbviewer see:
http://support.microsoft.com/support/kb/articles/Q176/6/70.ASP
Why do you need this? Often users will leave a database open and
you will need to shut it down for maintenance, this will tell you
which terminal or PC has it open as well as the User name. You won't
have to wander from office to office to see which terminal has been left
with the database open. It will also tell who's terminal has powered down
with database open.
' Constants
'
'The Microsoft Jet Provider defines a number of GUIDs
'and property values that are for provider-specific features
'and properties. Because they are provider-specific values,
'ADO does not expose them in enumeration values or constants
' for further info see:
' http://www.microsoft.com/data/ado/adotechinfo/dao2ado_9.htm
' http://msdn.microsoft.com/library/techart/daotoadoupdate_topic10.htm
'Remember to set reference to MS ADO 2.5 or higher
' Jet OLE DB Provider Defined Schema Rowsets Constants
Global Const JET_SCHEMA_USERROSTER = _
"{947bb102-5d43-11d1-bdbf-00c04fb92675}"
Global Const JET_SCHEMA_ISAMSTATS = _
"{8703b612-5d43-11d1-bdbf-00c04fb92675}"
' Microsoft Jet OLEDB:Database Locking Mode property values
Global Const JET_DATABASELOCKMODE_PAGE = 0
Global Const JET_DATABASELOCKMODE_ROW = 1
'Remember to set reference to MS ADO 2.5 or higher
' sample calls
'
'ADOUserRoster "C:\Program Files\Microsoft
Office\Office\Samples\Northwind.mdb"
'ADOUserStats "C:\Program Files\Microsoft
Office\Office\Samples\Northwind.mdb"
Function ADOUserRoster(strAccessMDBName As String) As String
Dim cnn As New ADODB.Connection
Dim rst As ADODB.Recordset
Dim varGetString As Variant
' Use before ADO calls
On Error GoTo AdoError
' Open the connection
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strAccessMDBName & ";"
' Open the user roster schema rowset
Set rst = cnn.OpenSchema(adSchemaProviderSpecific, , _
JET_SCHEMA_USERROSTER)
' Print the results to the debug window
'Column Description
'COMPUTER_NAME The name of the workstation as specified using
' the Network icon in Control Panel.
'LOGIN_NAME The name of the user used to log on to the database
' if the database has been secured; otherwise,
' the default value will be Admin.
'CONNECTED True, if there is a corresponding user lock
' in the .ldb file.
'SUSPECTED_STATE True, if the user has left the database
' in a suspect state; otherwise, Null.
Debug.Print "Computer Name Login Name" & _
" Connected Suspected State"
'can only grab once
'Use all defaults: get all rows, TAB column delimiter, CARRIAGE RETURN
'row delimiter, empty-string null delimiter
varGetString = rst.GetString(adClipString, , ",", ";", "?")
'computer name string has a couple of nulls in so remove
Dim ab() As Byte
Dim i As Long
Dim lstrlen As Long
lstrlen = (Len(varGetString) - 1) * 2
ab = varGetString
For i = 0 To lstrlen Step 2
Debug.Print Chr(ab(i)); ab(i); i
If ab(i) = 0 Then
ab(i) = 32
End If
Next i
' Format string for text box
varGetString = ab
varGetString = Replace(varGetString, ",0,", ", False ,")
varGetString = Replace(varGetString, ",-1,", ", True ,")
varGetString = Replace(varGetString, ",?", ", ?? ,")
varGetString = Replace(varGetString, ",", " ")
varGetString = Replace(varGetString, ";", vbCrLf)
Debug.Print varGetString
ADOUserRoster = "Computer Name Login Name" & _
" Connected Suspected State" & vbCrLf & _
varGetString
cnn.close
Set cnn = Nothing
Exit Function
' ADO Error/Exception Handler
AdoError:
Dim ErrNumber As Long
Dim ErrSource As String
Dim ErrDescription As String
ErrNumber = Err.Number
ErrSource = Err.Source
ErrDescription = Err.Description
AdoErrorExpanded cnn
cnn.close
Set cnn = Nothing
'where Cnn is Connection Object
End Function
Function ADOUserStats(strAccessMDBName As String) As String
' Grab Isam Statistics at call time
' Write up in Microsoft Jet Dabase Programmer's Guide
' similar to ISAMStats function
' IsamStats(StatNum as Long,Reset as Boolean)
Dim cnn As New ADODB.Connection
Dim rst As ADODB.Recordset
Dim strLine As String
Dim i As Integer
Dim strLargeLine As String
' Use before ADO calls
On Error GoTo AdoError
' Open the connection
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strAccessMDBName & ";"
' Open the user roster schema rowset
Set rst = cnn.OpenSchema(adSchemaProviderSpecific, , _
JET_SCHEMA_ISAMSTATS)
' Print the ISAM Stats results to the debug window
Debug.Print "ISAM Stats"
strLargeLine = "ISAM Stats" & vbCrLf
Debug.Print rst.GetString
With rst
.MoveFirst
Do While Not .EOF
strLine = ""
With .Fields
Debug.Print "Count=" & .Count
For i = 0 To .Count - 1
strLine = strLine & .Item(i).Name & ":" & _
.Item(i).Value & vbCrLf
Next
Debug.Print strLine
strLargeLine = strLargeLine & strLine & vbCrLf
End With
.MoveNext
Loop
End With
ADOUserStats = strLargeLine
cnn.close
Set cnn = Nothing
Exit Function
' ADO Error/Exception Handler
AdoError:
Dim ErrNumber As Long
Dim ErrSource As String
Dim ErrDescription As String
ErrNumber = Err.Number
ErrSource = Err.Source
ErrDescription = Err.Description
AdoErrorExpanded cnn
cnn.close
'where Cnn is Connection Object
End Function
Sub AdoErrorExpanded(Conn1 As ADODB.Connection)
' ADO Error/Exception Handler Expanded
Dim Errs1 As ADODB.Errors
Dim errLoop As ADODB.Error
Dim i As Long
Dim strMsgErr As String
i = 1
On Error Resume Next
' For any error condition, show results in debug
' Enumerate Errors collection and display properties
' of each Error object.
Set Errs1 = Conn1.Errors
For Each errLoop In Errs1
With errLoop
Debug.Print " Error #" & i & ":"
Debug.Print " ADO Error #" & .Number
Debug.Print " Description " & .Description
Debug.Print " Source " & .Source
Debug.Print " HelpFile " & .HelpFile
Debug.Print " HelpContext " & .HelpContext
Debug.Print " NativeError " & .NativeError
Debug.Print " SQLState " & .SQLState
strMsgErr = " Error #" & i & ":"
strMsgErr = strMsgErr & vbCrLf & " ADO Error #" & .Number
strMsgErr = strMsgErr & vbCrLf & " Description " & .Description
strMsgErr = strMsgErr & vbCrLf & " Source " & .Source
strMsgErr = strMsgErr & vbCrLf & " HelpFile " & .HelpFile
strMsgErr = strMsgErr & vbCrLf & " HelpContext " & .HelpContext
strMsgErr = strMsgErr & vbCrLf & " NativeError " & .NativeError
strMsgErr = strMsgErr & vbCrLf & " SQLState " & .SQLState
MsgBox strMsgErr
i = i + 1
End With
Next
With Conn1
Debug.Print "ADO Version: " & .Version & vbCrLf & _
"DBMS Name: " & .Properties("DBMS Name") & vbCrLf & _
"DBMS Version: " & .Properties("DBMS Version") & vbCrLf & _
"OLE DB Version: " & .Properties("OLE DB Version") & vbCrLf & _
"Provider Name: " & .Properties("Provider Name") & vbCrLf & _
"Provider Version: " & .Properties("Provider Version") & vbCrLf
Debug.Print "ADO Version: " & .Version & vbCrLf & _
"DBMS Name: " & .Properties("DBMS Name") & vbCrLf & _
"DBMS Version: " & .Properties("DBMS Version") & vbCrLf & _
"OLE DB Version: " & .Properties("OLE DB Version") & vbCrLf & _
"Provider Name: " & .Properties("Provider Name") & vbCrLf & _
"Provider Version: " & .Properties("Provider Version") & vbCrLf & _
"Driver Name: " & .Properties("Driver Name") & vbCrLf & _
"Driver Version: " & .Properties("Driver Version") & vbCrLf & _
"Driver ODBC Version: " & .Properties("Driver ODBC Version")
End With
End Sub
--
Marty Connelly
Victoria, B.C.
Canada