Notifying and then forcing users to disconnect from client/server database

Greetings michaelhbaker!

  While this might be looking like a good idea for now,... you are going to get a lot of flack from users the first few time they claim "data loss" from getting kicked off the application.
  You would be far better off Scheduling and Publishing time when maintenance will be getting performed.

  In the application you can use a form timer to periodically test a table on the server side for a value that indicates that all users should exit the application.
  In my application this is in a table called tzSettings and is called "EverybodyOutOfThePool"

  if the routine for the form timer detects your code to vacate the app.... application.quit.
regards
jack

goliak:  are you reading all the posts before you post?

What I have is a table which contains userids and their email addresses
These userids are used to authenticate the users when using the access database, so only registered users can use it

I do backups so I created a form which lists users and the administrator has the option to send email to them

to get a list of users, here is my code



'Structures
Private Type FILETIME
    dwLowDateTime As Long           'The low-order dword of the 64-bit integer specifying the date and time
    dwHighDateTime As Long          'The high-order dword of the 64-bit integer specifying the date and time
End Type

Public Type LDB_USER_INFO
    strUserName As String
    strLoginName As String
    strMachineName As String
    blnConnected As Boolean
    varSuspectState As Variant
End Type
 
Public Type LDB_INFO
    intUserCount As Integer
    strErrorMsg As String
    atLUI() As LDB_USER_INFO
End Type

Private Type SID_IDENTIFIER_AUTHORITY
    Value(5) As Byte
End Type
 
Private Declare Function apiRegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As Long, phkResult As Long) As Long
Private Declare Function apiRegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function apiRegCloseKey Lib "advapi32.dll" Alias "RegCloseKey" (ByVal hKey As Long) As Long
Private Declare Function apiFormatMsgLong Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, ByVal lpSource As Long, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Declare Function apiAllocateAndInitializeSid Lib "advapi32.dll" Alias "AllocateAndInitializeSid" (pIdentifierAuthority As SID_IDENTIFIER_AUTHORITY, ByVal nSubAuthorityCount As Byte, ByVal nSubAuthority0 As Long, ByVal nSubAuthority1 As Long, ByVal nSubAuthority2 As Long, ByVal nSubAuthority3 As Long, ByVal nSubAuthority4 As Long, ByVal nSubAuthority5 As Long, ByVal nSubAuthority6 As Long, ByVal nSubAuthority7 As Long, lpPSid As Any) As Long
Private Declare Function apiLookupAccountSid Lib "advapi32.dll" Alias "LookupAccountSidA" (ByVal stuSystemTimeName As String, sId As Any, ByVal Name As String, cbName As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Integer) As Long
Private Declare Function apiIsValidSid Lib "advapi32.dll" Alias "IsValidSid" (pSid As Any) As Long



'--------------------------------------------------------------------------------------------------------------------
' Function          CurrentDBUsers
' Description       Returns list of the current users logged in
' Returns           TRUE if done, FALSE otherwise
'--------------------------------------------------------------------------------------------------------------------
Public Function CurrentDBUsers(ByRef strUsers As String) As Boolean

    Dim objADOCon As Object
    Dim objRecSet As Object
    Dim i As Byte
    Dim sUser As String
    Dim vRV As String
    Dim sName As String


    On Error GoTo CDBUError
   
    Set objADOCon = CreateObject("ADODB.Connection")
    Set objRecSet = CreateObject("ADODB.Recordset")

    objADOCon.Provider = "Microsoft.Jet.OLEDB.4.0"
    objADOCon.Open "Data Source=" & g_clsGlobals.DBLocation

    Set objRecSet = objADOCon.OpenSchema(-1, , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")

    strUsers = "Machine Name;User;Full Name;Domain;Login Name" ';Connection;Suspect State"

    If objRecSet.EOF Then
        Stop
    Else
        Do While Not objRecSet.EOF
           
            Debug.Print "Machine Name", objRecSet(0)
            Debug.Print "UserName", GetRemoteLoggedUserID(objRecSet(0))
            Debug.Print "LoginName", objRecSet(1)
            Debug.Print "Connection", objRecSet(2)
            Debug.Print "SuspectState", objRecSet(3)
           
            'Get network userid
            sUser = GetRemoteLoggedUserID(objRecSet(0))
            i = InStr(1, sUser, "/")
           
            'Get full name
            sName = "Unknown"
            'MY DATABASE LOOKUP TO GET NAME - you do your own here
            If g_clsDB.dataLookup("Name", "Users", "User = '" & Left$(sUser, i - 1) & "'", vRV) = True Then
                If IsNull(vRV) = False Then sName = vRV
            End If
            strUsers = strUsers & ";" & TrimNull(objRecSet(0)) & ";" & Left$(sUser, i - 1) & ";" & sName & ";" & Mid$(sUser, i + 1) & ";" & objRecSet(1)
           
            objRecSet.MoveNext
        Loop
    End If

    CurrentDBUsers = True
    GoTo CDBUEnd

CDBUError:
    MsgBox "An error occurred when trying to get the list of logged on users." & vbCrLf & Err.Description, vbCritical, "Get Users"
    CurrentDBUsers = False

CDBUEnd:
    On Error Resume Next
    objRecSet.Close
    Set objRecSet = Nothing
    objADOCon.Close
    Set objADOCon = Nothing
End Function


'--------------------------------------------------------------------------------------------------------------------
' Function          GetRemoteLoggedUserID
' Description       Returns list of the current users logged in
' Returns           TRUE if done, FALSE otherwise
'--------------------------------------------------------------------------------------------------------------------
Private Function GetRemoteLoggedUserID(strMachineName As String) As String '
'
    Dim lRemoteUser As Long
    Dim i As Long, j As Long
    Dim lRv As Long
    Dim lSubKeyNameSize As Long
    Dim sSubKeyName As String
    Dim alSubAuthority() As Long, asTmpSubAuthority() As String
    Dim tFT As FILETIME
    Dim tAuthority As SID_IDENTIFIER_AUTHORITY
    Dim lSid As Long, lUserNameSize As Long, lDomainNameSize As Long
    Dim lSubAuthorityCount As Long, iSidType As Integer
    Dim sUserName As String, sDomainName As String

   
   
    On Error Resume Next

    GetRemoteLoggedUserID = ""
   
    lRv = apiRegConnectRegistry(TrimNull(strMachineName), &H80000003, lRemoteUser)
    If lRv <> 0& Then
        MsgBox "Registry Connection failed" & vbCrLf & GetAPIErrorMessage(Err.LastDllError), vbExclamation, "Get Users"
        Exit Function
    End If


    For i = 0 To 4
        tAuthority.Value(i) = 0
    Next
    i = 0

    lSubKeyNameSize = 260
    sSubKeyName = String$(lSubKeyNameSize, vbNullChar)

    lRv = apiRegEnumKeyEx(lRemoteUser, i, sSubKeyName, lSubKeyNameSize, 0, 0, 0, tFT)

    Do While lRv = 0& Or lRv = 234
   
        'We ignore 2 roots, Classes and .Default
        If InStr(1, sSubKeyName, "classes", vbTextCompare) = 0 And InStr(1, sSubKeyName, ".default", vbTextCompare) = 0 Then
           
            sSubKeyName = Left$(sSubKeyName, lSubKeyNameSize)
            asTmpSubAuthority = Split(sSubKeyName, "-")
            lSubAuthorityCount = UBound(asTmpSubAuthority)
           
            ReDim alSubAuthority(lSubAuthorityCount)
            For j = 3 To lSubAuthorityCount
                alSubAuthority(j - 3) = CLng(asTmpSubAuthority(j))
            Next
            lSubAuthorityCount = UBound(alSubAuthority) - 2

            With tAuthority
                .Value(5) = 5
                .Value(4) = 0
                .Value(3) = 0
                .Value(2) = 0
                .Value(1) = 0
                .Value(0) = 0
            End With

            If apiAllocateAndInitializeSid(tAuthority, _
                                            lSubAuthorityCount, _
                                            alSubAuthority(0), _
                                            alSubAuthority(1), _
                                            alSubAuthority(2), _
                                            alSubAuthority(3), _
                                            alSubAuthority(4), _
                                            alSubAuthority(5), _
                                            alSubAuthority(6), _
                                            alSubAuthority(7), _
                                            lSid) Then

                If apiIsValidSid(ByVal lSid) Then
                   
                    lUserNameSize = 1024
                    lDomainNameSize = 102
                    sUserName = String$(lUserNameSize - 1, vbNullChar)
                    sDomainName = String$(lDomainNameSize - 1, vbNullChar)
                   
                    lRv = apiLookupAccountSid(strMachineName, ByVal lSid, sUserName, lUserNameSize, sDomainName, lDomainNameSize, iSidType)
                    If lRv <> 0 Then
                        GetRemoteLoggedUserID = TrimNull(sUserName) & "/" & TrimNull(sDomainName)
                    Else
                        'MsgBox "Failed to lookup account." & vbCrLf & GetAPIErrorMessage(Err.LastDllError), vbExclamation, "Get Users"
                    End If
                End If
                If lSid Then Call sapiFreeSid(lSid)
            End If
        End If
       
        i = i + 1
        lSubKeyNameSize = 260
        sSubKeyName = String$(lSubKeyNameSize, vbNullChar)
        lRv = apiRegEnumKeyEx(lRemoteUser, i, sSubKeyName, lSubKeyNameSize, 0, 0, 0, tFT)
    Loop

    If (lSid) Then Call sapiFreeSid(lSid)
   
    Call apiRegCloseKey(lRemoteUser)
End Function

by the way, this is my code to send emails

https://www.experts-exchange.com/questions/20916531/Sending-Emails-In-Access-2002.html

Thanks.  The invisible form that runs all the time was the key.  Otherwise I have to put code in many forms.

michaelhbaker:  
can you explain how the answer you selected as the answer to your question is substantially different from the first comment I posted?

I am still new to this system and I hope I didn't act impulsively.  I assumed that I was suppose to select one of the responses.  The one I chose included the idea of a always running invisible form that would check the system maintenance flag.  This keeps me from having to include the code in every form in the application.  I actually got some benefit from a number of the responses.  Is there a way to split credit among more than one response.  Do I accept responses from all that I want to share in the credit?

I only mention this because other than goliaks form being invisible ( you could use the ever-present switchboard for the same task ) all the elements in his answer are already in my comment.  This is why I asked if he read the comments before he posted.

Normally you would chose the first best if two are the same, which in this case I thought was pretty dern close....

Have you seen this:  https://www.experts-exchange.com/Community_Support/help.jsp#hs5
?
-j-

I am submitting a request to the Page Editor to review this question.  
If he finds that goliak's answer and mine are essentially the same I will ask you to re-award the question.

I'm not sure I like the "culture" of this discussion.  I told you why I picked the other response.  I don't use the switchboard so the invisible form suggestion was a significant help.  Why are you so bent on getting this reversed?  If this is the way things operate in this forum, it may not be for me.

nevermind.

Hi Michael!

  Welcome to EE!  Glad to see you here.  I think you'll find EE a great place to hang out and get answers to your problems.  In fact, I see that in this thread you have had several<g>.  That sometimes can be a problem as it's often difficult to determine who should get credit.  EE does allow you to split points in accepting comments.  Jack has already posted a link to the help page:

https://www.experts-exchange.com/Community_Support/help.jsp#hs5

  which explains how to close questions.  Generally, you should consider who provided the most complete answer first in terms of giving credit.  In this case it's a bit tough as Jack did mention using a Form Timer in his first post, but didn't mention specifically that it could be a hidden one.  Other then that, his solution is totally correct and identical to goliak’s.  You have already explained that it was that point in goliak’s comment which is what gave you the clearest understanding to solve your problem and that's why you awarded him the points.

  I myself have been in Jack's position many times and have often wondered why a member accepted someone else's comment.  I have also been in goliak's position simply by expanding on what somewhat else said got awarded the answer, which in some cases was unfair as I simply made a comment to clear up some points made in another’s post, never expecting to receive the points.  These types of situations are exactly why the points split capability was added (it was not always available).

  Also, I wanted to point out that you offered a "B" grade.  You have gotten several good answers and in a very timely fashion (3 minutes<g> .... way to go Jack!).  This should have been an "A" grade.

  I am pointing this all out because EE is unique and it does take a bit of time to learn to use it well.  A major part of getting a good answer is in asking a good question.  Even if asked well, it's often difficult for Experts to understand a situation or have a good feel for your level of experience.  Jack didn't mention a hidden form most likely because it was implied that *any* form would work.  I probably would have done the same.

  However I'm not here to argue with you, but simply to help you use EE to its fullest extent.  I will handle this in whatever way you wish.  However, please appreciate and understand that all the Experts are volunteers and get recognition only through the points system.

Jim Dettman
MS Access PE.

BTW,

  To add a comment or two to the solution.  I would not simply dump users out of an app, but allow for a timed shutdown. So make your variable a number of minutes.  You can initially set the value to anything you want, then have the OnTimer code reduce the value each minute until it reaches zero at which point you quit.

 Also, not all openerations can be quit right away.  For example, if a user is in the middle of a edit.  You may want to add a couple of .undo's (control and record level).

  And last, if using JET 4.0 and ADO, you can set the database for a passive shutdown which means new users can't get in, but users already in can finish their work.

  I would however do your own system rather then using the feature built into the OLEDB provider for JET 4.0.  You maintain control that way and can do whatever you want.

Food for thought....
Jim.

Jim

Thanks for the clarifications and guidance.  I must admit I find the highly competitive environment for points a little difficult to handle, along with the grading system.  I will give this some more thought, but my office culture is much more laid back, we take a team approach and try to give everyone frequent encouragemnt for good work, but in a much less competitive framework.

Your web site is a good resource, but I am going to have to use it much more cautiously and only when I am really ready to participate in its culture.

mb

Michael,

<< I must admit I find the highly competitive environment for points a little difficult to handle, along with the grading system.>>

It does get a little intense at times<g>, but for the most part Experts get along very well.  Each TA (topic area) has a slightly different "flavor" depending on the Experts involved and their level of experience.  And while the points system does have it's drawbacks, it's also proven to have worked over the years fairly well.  While the focus has shifted a bit since premium members now get unlimited points, it's still working and what makes EE unique.

  I also wanted to clear up one point; I was *not* suggesting that goliak's response was jack's comment copied and changed (although that does sometimes happen :(  ).  After I re-read my response to you I realized it could have been interrupted that way.

  I hope you find EE enjoyable.  Let me know if you have any problems or questions in the future (I'll take the good comments too<g>).  My e-mail address is in my profile.

Jim Dettman
MS Access PE.