How to create a user table recording Windows logon

Posted on 2006-05-18
Last Modified: 2008-06-16
I'd like to create a table with a list of users giving their Windows domain logons plus the time of their logon.

When a user logs on their logon name should go into the table as well as their machine name.  Also a flag should be set to Yes to show they are logged in.  When they exit the database the flag should be set to No (to enable checking if anyone exits and leaves the database in a suspect state), and the logoff time recorded.

Question by:looper8
    LVL 65

    Expert Comment

    ok, the initiial form that u use or perhaps a AutoExec macro

    call this bit of code

    dim sUser as String

    sUser = Environ("Username")

    sSql = "INSERT INTO tblLogon (UserName, LoggedOnDate) VALUES ('" & sUser & "','" & Now() & "')"

    DoCmd.RunSql sSql

    LVL 65

    Expert Comment

    ok, forgot the flag

    sSql = "INSERT INTO tblLogon (UserName, LoggedOnDate, LogOnFlag) VALUES ('" & sUser & "','" & Now() & "','Y')"

    then all u need to do when they logoff (put in form_close of the last form thats used - ideally your main menu or something)

    sSql = "INSERT INTO tblLogon (UserName, LoggedOnDate, LogOnFlag) VALUES ('" & sUser & "','" & Now() & "','N')"

    LVL 38

    Expert Comment

    by:Jim P.
    Add the function below into your database then on whatever form you have open add the command
    docmd.setwarnings false
    Docmd.runsql "Insert into LoginHistoryTable (Users_Name, Login_Time) " & _
                        " Values( '" & GetUsersName() &"' , #" & Now() & "#)"
    docmd.setwarnings true

    Option Compare Database
    Option Explicit

     ' Declare for call to mpr.dll.
       Declare Function WNetGetUser Lib "mpr.dll" _
          Alias "WNetGetUserA" (ByVal lpName As String, _
          ByVal lpUsersName As String, lpnLength As Long) As Long

       Const NoError = 0       'The Function call was successful

    Public Function GetUsersName() As String

          ' Buffer size for the return string.
          Const lpnLength As Integer = 255

          ' Get return buffer space.
          Dim Status As Integer

          ' For getting user information.
          Dim lpName, lpUsersName As String

          ' Assign the buffer size constant to lpUsersName.
          lpUsersName = Space$(lpnLength + 1)

          ' Get the log-on name of the person using product.
          Status = WNetGetUser(lpName, lpUsersName, lpnLength)

          ' See whether error occurred.
          If Status = NoError Then
             ' This line removes the null character. Strings in C are null-
             ' terminated. Strings in Visual Basic are not null-terminated.
             ' The null character must be removed from the C strings to be used
             ' cleanly in Visual Basic.
             lpUsersName = Left$(lpUsersName, InStr(lpUsersName, Chr(0)) - 1)

             ' An error occurred.
             MsgBox "Unable to get the name."
          End If

          ' Display the name of the person logged on to the machine.
    '      MsgBox "The person logged on this machine is: " & lpUsersName
        GetUsersName = lpUsersName
    End Function
    LVL 65

    Expert Comment

    Im not aware of any auto close macros like there is AutoExec (called when DB starts)
    I think Word has one but not ms access
    LVL 65

    Expert Comment

    Environ is one option, there is another which Ive just found the link to

    LVL 65

    Expert Comment

    and the other bit of info I was going to provide, do u want to store their IP address as well? if so, that is also easily achieved.

    Option Explicit

    Private Const IP_SUCCESS As Long = 0
    Private Const WS_VERSION_REQD As Long = &H101
    Private Const MIN_SOCKETS_REQD As Long = 1
    Private Const SOCKET_ERROR As Long = -1
    Private Const INADDR_NONE As Long = &HFFFFFFFF
    Private Const MAX_WSADescription As Long = 256
    Private Const MAX_WSASYSStatus As Long = 128
    Private Type WSADATA
        wVersion As Integer
        wHighVersion As Integer
        szDescription(0 To MAX_WSADescription) As Byte
        szSystemStatus(0 To MAX_WSASYSStatus) As Byte
        wMaxSockets As Long
        wMaxUDPDG As Long
        dwVendorInfo As Long
    End Type
    Private Declare Function gethostbyname Lib "WSOCK32.DLL" _
                                           (ByVal hostname As String) As Long
    Private Declare Sub CopyMemory Lib "kernel32" _
                                   Alias "RtlMoveMemory" _
                                   (xDest As Any, _
                                    xSource As Any, _
                                    ByVal nbytes As Long)
    Private Declare Function WSAStartup Lib "WSOCK32.DLL" _
                                        (ByVal wVersionRequired As Long, _
                                         lpWSADATA As WSADATA) As Long
    Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
    Private Declare Function inet_addr Lib "WSOCK32.DLL" _
                                       (ByVal s As String) As Long
    Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _
                                             (ByVal Buffer As String, _
                                              Size As Long) As Long

    Public Function GetIPFromHostName(ByVal sHostName As String) As String
    'converts a host name to an IP address.
        Dim nbytes As Long
        Dim ptrHosent As Long  'address of hostent structure
        Dim ptrName As Long    'address of name pointer
        Dim ptrAddress As Long    'address of address pointer
        Dim ptrIPAddress As Long
        Dim sAddress As String
        sAddress = Space$(4)
        ptrHosent = gethostbyname(sHostName & vbNullChar)
        If ptrHosent <> 0 Then
            ptrName = ptrHosent
            ptrAddress = ptrHosent + 12
            'get the IP address
            CopyMemory ptrName, ByVal ptrName, 4
            CopyMemory ptrAddress, ByVal ptrAddress, 4
            CopyMemory ptrIPAddress, ByVal ptrAddress, 4
            CopyMemory ByVal sAddress, ByVal ptrIPAddress, 4
            GetIPFromHostName = IPToText(sAddress)
        End If
    End Function

    Private Function IPToText(ByVal IPAddress As String) As String
        IPToText = CStr(Asc(IPAddress)) & "." & _
                   CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
                   CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
                   CStr(Asc(Mid$(IPAddress, 4, 1)))
    End Function

    Public Sub SocketsCleanup()
        If WSACleanup() <> 0 Then
            MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
        End If
    End Sub

    Public Function SocketsInitialize() As Boolean
        Dim WSAD As WSADATA
        SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
    End Function

    then to get the info,

    Sub TestingFunction()
        Dim sHost as String

        If SocketsInitialize() Then
            sHost = GetPcName
            MsgBox sHost & vbcrlf & GetIPFromHostName(sHost)
        End If
    End Sub
    LVL 1

    Author Comment

    Thanks guys.  I'll test this out this afternoon and let you know.

    But a question ... if you can use Environ("UserName") why would you go the the trouble of writing a whole sub to get the logon?  Are there drawbacks to Environ?
    LVL 1

    Author Comment

    OK, rockiroads ... I had to replace your Y and N with -1 and 0 but then it worked fine.

    Tried the IP function, but can't get it to work.  Pasted the main code into a new module, the other code into another module and ran testingfunction in the Immediate Window ... but GetPcName doesn't seem to exist!
    LVL 38

    Expert Comment

    by:Jim P.
    >>  if you can use Environ("UserName") why would

    It is fairly easy to spoof the  Environ("UserName") variable
    LVL 65

    Accepted Solution

    Sorry,. forgot one method to post

    Public Function GetPcName() As String
        Dim strBuf As String * 16, strPcName As String, lngPc As Long
        lngPc = GetComputerName(strBuf, Len(strBuf))
        If lngPc <> 0 Then
            strPcName = Left(strBuf, InStr(strBuf, vbNullChar) - 1)
            GetPcName = strPcName
            GetPcName = vbNullString
        End If
    End Function

    Environ uses environment variables. It was just one method of getting it.
    I prefer the use of API, like jimpen as shown and that link I gave u - points to this (use of api)

    I would recommend u use the API call. The one in my link isnt that big - here is the code

    Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
        "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

    Function fOSUserName() As String
    ' Returns the network login name
    Dim lngLen As Long, lngX As Long
    Dim strUserName As String
        strUserName = String$(254, 0)
        lngLen = 255
        lngX = apiGetUserName(strUserName, lngLen)
        If ( lngX > 0 ) Then
            fOSUserName = Left$(strUserName, lngLen - 1)
            fOSUserName = vbNullString
        End If
    End Function

    LVL 1

    Author Comment

    The whole thing works very well: I'm recording the user's logon (via the API call), IP address, PC name, time of database open/close.  The API stuff is rather over my head [:-), but hey it works!  Thanks very much esp rockiroads for your help.

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    How to run any project with ease

    Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
    - Combine task lists, docs, spreadsheets, and chat in one
    - View and edit from mobile/offline
    - Cut down on emails

    Introduction When developing Access applications, often we need to know whether an object exists.  This article presents a quick and reliable routine to determine if an object exists without that object being opened. If you wanted to inspect/ite…
    In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
    What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.
    With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…

    761 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    7 Experts available now in Live!

    Get 1:1 Help Now