Logged in users

[Kpatel]

There are certain codes that are available that can list all the users who
are currently logged into a database. However, they do not seem to be
working for secured databases. Could any one point me to a sample code that
works on a secured database. Here is a link that I have found:

http://support.microsoft.com/?id=198755

Any help would be appreciated.

Thanks

 

[Douglas J Steele]

You need to use an appropriate Connection string, rather than what they
should when they open cn and cn2.

Check Carl Prothman's site at
http://www.carlprothman.net/Default.aspx?tabid=87#OLEDBProviderForMicrosoftJet
for details of what connection string to use.

 

[Kpatel]

Hi

Thanks for your response. However, this would require me to hard code my
user id and password. Which I am not too comfortable doing. Also, even if I
do provide my user id and password, it tells me that the file is already
opened by another user and does not give me the information I am looking for.
Here is another link that has a zipped file which seems to be of more
interest to me. Again this does not take into consideration a secured
database. I would greatly appreciate if you could help me modify this code
so that I can use it in my secured database.

Thanks in advance

 

[Kpatel]

Sorry forgot to put the link in. Here it is:
http://forums.devarticles.com/micro...d-out-who-s-logged-in-the-database-11887.html

Thanks

 

[Douglas J. Steele]

There's no way to find out who's in the database unless you can connect to
it. That means you have to provide credentials.

Unless you're trying to run code from the database in which the code is
running, in which case you can use

Set cn = CurrentProject.Connection

(I have no idea why cn2 is declared in the KB article!)

 

[Kpatel]

Thanks for your response. When I made the change you suggested I got another
error - Run-time error 3704: "Operation is not allowed when the object is
closed".

Also, did you get a chance to check out the code that was included in the
zipped file in the link that I provided? That is the perfect thing that I
want. However, it does not seem to be working for secured databases.

Thanks in advance.

 

[Douglas J. Steele]

Copy-and-paste the exact code you're trying to use now.

Sorry, I can't be bothered downloading the database.

 

[Kpatel]

Here is the code that is in the database:

Private Sub cmdExecute_Click()
On Error GoTo ErrHandler

With Me.txtDBPath
If Not IsNull(.Value) Then
If Len(Dir$(.Value, vbNormal)) Then
Me.lbxLDBInfo.RowSourceType = vbNullString
If (Me.chkUserRoster.Enabled And (Me.chkUserRoster)) Then
m_blnUseRosterLayout = True
Me.optDisplayOptions.Enabled = False
Call sUseUserRoster
Else
Me.optDisplayOptions.Enabled = True
m_blnUseRosterLayout = False
Call sDisplayUsers
End If
Me.lbxLDBInfo.RowSourceType = "fListFill"
End If
End If
End With
ExitHere:
Exit Sub
ErrHandler:
With Err
MsgBox "Error: " & .Number & vbCrLf & .Description, _
vbCritical Or vbOKOnly, .Source
End With
Resume ExitHere
End Sub

The functions that are being called here all require the database name
(me.txtdbpath.value). Here is where I am having trouble. I don't know what
value I should give this field in order for it to lookup users in a secured
database.

Thanks for all the time that you have put into this. I appreciate all your
help and effort. Do let me know if I am not being very clear at any point.

Thanks

 

[Douglas J. Steele]

fListFill is obviously a function that's supposed to populate your listbox.

What's the code for it?

 

[Kpatel]

Here it the code for that:

Function fListFill(ctl As Control, varID As Variant, varRow As Variant, _
varCol As Variant, varCode As Variant) As Variant
'Callback function to fill the multirow-multicolumn listbox
'
Dim varRet As Variant
Const TWIPS = 1440
Const COLUMN_COUNT = 2
Const ROSTER_COLUMN_COUNT = 5
Const ROSTER_ERROR_MSG = "Couldn't retrieve info from the LDB file"

On Error GoTo ErrHandler
Select Case varCode

Case acLBInitialize
varRet = True

Case acLBOpen
varRet = Timer

Case acLBGetRowCount
varRet = m_tLDBInfo.intUserCount + 1

Case acLBGetColumnWidth
'Set the widths of the column
'TWIPS converts to the appropriate
'VBA Units of measurements, TWIPS.
Select Case varCol
Case 0: varRet = 1.5 * TWIPS
Case 1: varRet = 1.5 * TWIPS
Case 2: varRet = 0.9 * TWIPS
Case 3: varRet = 0.9 * TWIPS
Case 4: varRet = 0.9 * TWIPS
End Select

Case acLBGetColumnCount
varRet = (IIf(m_blnUseRosterLayout, ROSTER_COLUMN_COUNT,
COLUMN_COUNT))

Case acLBGetValue
'Return the particular class member's value
'depending on which column is being populated
Select Case varCol
Case 0:
' First row contains column headings
If m_tLDBInfo.intUserCount = 0 Or (Me.optDisplayOptions)
= 8 Then
Me.lblErrorMsg.Caption = IIf(m_blnUseRosterLayout,
ROSTER_ERROR_MSG, m_tLDBInfo.strErrorMsg)
If varRow = 0 Then
varRet = vbNullString
End If
Else
Me.lblErrorMsg.Caption = vbNullString
If varRow = 0 Then
If IsNull(Me.txtDBPath) Then
varRet = vbNullString
Else
varRet = "Machine Name"
End If
Else
varRet = m_tLDBInfo.atLUI(varRow -
1).strMachineName
End If
End If

Case 1:
If varRow = 0 Then
If m_tLDBInfo.intUserCount = 0 Or
(Me.optDisplayOptions) = 8 Then
varRet = vbNullString
Me.lblErrorMsg.Caption =
IIf(m_blnUseRosterLayout, ROSTER_ERROR_MSG, m_tLDBInfo.strErrorMsg)
Else
Me.lblErrorMsg.Caption = vbNullString
varRet = "User currently logged in"
End If
Else
If m_tLDBInfo.intUserCount = 0 Then
varRet = vbNullString
Else
varRet = m_tLDBInfo.atLUI(varRow - 1).strUserName
End If
End If
Case 2:
If varRow = 0 Then
If m_tLDBInfo.intUserCount = 0 Then
varRet = vbNullString
Me.lblErrorMsg.Caption =
IIf(m_blnUseRosterLayout, ROSTER_ERROR_MSG, m_tLDBInfo.strErrorMsg)
Else
Me.lblErrorMsg.Caption = vbNullString
varRet = "Login Name"
End If
Else
If m_tLDBInfo.intUserCount = 0 Then
varRet = vbNullString
Else
varRet = m_tLDBInfo.atLUI(varRow - 1).strLoginName
End If
End If
Case 3:
If varRow = 0 Then
If m_tLDBInfo.intUserCount = 0 Then
varRet = vbNullString
Me.lblErrorMsg.Caption =
IIf(m_blnUseRosterLayout, ROSTER_ERROR_MSG, m_tLDBInfo.strErrorMsg)
Else
Me.lblErrorMsg.Caption = vbNullString
varRet = "Connected?"
End If
Else
If m_tLDBInfo.intUserCount = 0 Then
varRet = vbNullString
Else
varRet = CStr(CBool(m_tLDBInfo.atLUI(varRow -
1).blnConnected))
End If
End If
Case 4:
If varRow = 0 Then
If m_tLDBInfo.intUserCount = 0 Then
varRet = vbNullString
Me.lblErrorMsg.Caption =
IIf(m_blnUseRosterLayout, ROSTER_ERROR_MSG, m_tLDBInfo.strErrorMsg)
Else
Me.lblErrorMsg.Caption = vbNullString
varRet = "Suspect State?"
End If
Else
If m_tLDBInfo.intUserCount = 0 Then
varRet = vbNullString
Else
varRet = m_tLDBInfo.atLUI(varRow -
1).varSuspectState
End If
End If
End Select
End Select

fListFill = varRet
ExitHere:
Exit Function
ErrHandler:
Resume ExitHere
End Function

I would like to thank you for all the time that you are putting into this
for me. There are several codes involved in this. I don't know which are
the ones that need to be changed to make it work for my secured database.
And I don't know if I should paste the entire code or not. Do let me know so
I can do the needful.

Thanks

 

[Douglas J Steele]

Since m_tLDBInfo is the recordset you're trying to use, it's all about how
you open that recordset.

Realistically, since you're only using that recordset inside fListFill, you
should be opening it there (in the acLBInitialize section). I'm assuming
you've declared it as global to the form (or perhaps even to the database?):
there's not really a need for that since, as I said, you'll not going to be
using it anywhere else. You could declare it as Static inside fListFill so
that it'll be available to you while the function is populating the list
box.

I understand that you've got lots of code involved, and that it's difficult
to know exactly what to post. The thing is, though, I've already indicated
several times that the entire issue boils down to what Connection object you
use, and you're not showing me that!

 

[Kpatel]

Hi,

I think this is the code that you are expecting to see:

Private Sub sUseUserRoster()
' Modified version of code found in the following KB Article
' Q198755 - http://support.microsoft.com/support/kb/articles/Q198/7/55.ASP
' ACC2000: Checking Who Logged into Database with Jet UserRoster
'
On Error GoTo ErrHandler
Dim cn As Object
Dim Rs As Object
Dim i As Integer
Const adSchemaProviderSpecific = -1

Set cn = CreateObject("ADODB.Connection")
Set Rs = CreateObject("ADODB.Recordset")

cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.Open "Data Source=" & Me.txtDBPath

' The user roster is exposed as a provider-specific schema rowset
' in the Jet 4 OLE DB provider. You have to use a GUID to
' reference the schema, as provider-specific schemas are not
' listed in ADO's type library for schema rowsets

Set Rs = cn.OpenSchema(adSchemaProviderSpecific, _
, "{947bb102-5d43-11d1-bdbf-00c04fb92675}")

m_tLDBInfo.strErrorMsg = vbNullString

With m_tLDBInfo
If Rs.EOF Then
Stop
Else
Do While Not Rs.EOF
ReDim Preserve .atLUI(i)
.atLUI(i).strMachineName = Rs(0)
.atLUI(i).strUserName = fGetRemoteLoggedUserID(Rs(0))
.atLUI(i).strLoginName = Rs(1)
.atLUI(i).blnConnected = Rs(2)
.atLUI(i).varSuspectState = Rs(3)
Rs.MoveNext
.intUserCount = i
i = i + 1
Loop
End If
Me.lblUserCount.Caption = .intUserCount
End With

ExitHere:
On Error Resume Next
Rs.Close
Set Rs = Nothing
cn.Close
Set cn = Nothing
Exit Sub
ErrHandler:
With Err
MsgBox "Error: " & .Number & vbCrLf & .Description, _
vbCritical Or vbOKOnly, .Source
End With
Resume ExitHere
End Sub

Do let me know if this isn't the one.

Thanks

 

[Douglas J Steele]

And so we're back full circle...

As I said before, in order to find out who's in the database, you must be
able to connect to it. That means you have to provide credentials. If you've
already got a connection to the data, you can use that.

Did you try replacing

cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.Open "Data Source=" & Me.txtDBPath

with

Set cn = CurrentProject.Connection

as I suggested?

 

[Kpatel]

I did change the value for cn to CurrentProject.Connection. Now I get the
error cannot find file MSLDBUSR.DLL. I have the following code that refers
to this file:

Private Declare Function LDBUser_GetUsers Lib "MSLDBUSR.DLL" _
(lpszUserBuffer() As String, ByVal lpszFilename As String, _
ByVal nOptions As Long) As Integer

Private Declare Function LDBUser_GetError Lib "MSLDBUSR.DLL" _
(ByVal nErrorNo As Long) As String


Also I have downloaded jetutils.exe from Microsoft's download center, which
includes this DLL file:

http://support.microsoft.com/?id=176670

Does this file need to be saved at any specific location in order for this
code to work?

Thanks

 

[Douglas J Steele]

Why do you have those declarations? You don't need them when you're using
the OpenSchema approach: they provide another way to get at the same
information.

 

[Kpatel]

I have these declarations at the very beginning of the code. This is not a
code that I have written. I got this code from the link that I had posted
earlier.

http://forums.devarticles.com/micro...d-out-who-s-logged-in-the-database-11887.html

So does this mean it would be safe to remove these declarations from the code?

Thanks

 

[Kpatel]

I tried commenting those declarations and and it would not work. LDB_GETUSRS
is being used in another procedure.