WhoAmI and Access

I'm running Access 95 on a Windows system and Novell network. Can I write a VB for Access script to get the user ID?

Comments

  • Access has VB built into it so yes.
  • Try this... Create a module and copy this lot into it:

    Option Explicit

    Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    Private Declare Function NetUserGetInfo Lib "netapi32" (lpServer As Any, UserName As Byte, ByVal Level As Long, lpBuffer As Long) As Long
    Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal Buffer As Long) As Long
    Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
    Private Declare Function lstrlenW Lib "kernel32" (lpString As Any) As Long
    Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal codepage As Long, ByVal dwFlags As Long, lpWideCharStr As Any, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long

    Private Type USER_INFO_3
    usri3_name As Long
    usri3_password As Long
    usri3_password_age As Long
    usri3_priv As Long
    usri3_home_dir As Long
    usri3_comment As Long
    usri3_flags As Long
    usri3_script_path As Long
    usri3_auth_flags As Long
    usri3_full_name As Long
    usri3_usr_comment As Long
    usri3_parms As Long
    usri3_workstations As Long
    usri3_last_logon As Long
    usri3_last_logoff As Long
    usri3_acct_expires As Long
    usri3_max_storage As Long
    usri3_units_per_week As Long
    usri3_logon_hours As Byte
    usri3_bad_pw_count As Long
    usri3_num_logons As Long
    usri3_logon_server As String
    usri3_country_code As Long
    usri3_code_page As Long
    usri3_user_id As Long
    usri3_primary_group_id As Long
    usri3_profile As Long
    usri3_home_dir_drive As Long
    usri3_password_expired As Long
    End Type

    Private Const NERR_Success = 0
    Private Const NERR_BASE = 2100
    Private Const NERR_InvalidComputer = (NERR_BASE + 251)
    Private Const NERR_UseNotFound = (NERR_BASE + 150)
    Private Const CP_ACP = 0

    Private m_sUserName As String
    Private m_sComment As String


    Sub Getuser()
    Call GetUserData
    msgbox("Current User is: " & m_sUserName)
    End Sub

    Private Sub GetUserData(Optional sServer As String)
    Dim lpBuf As Long
    Dim ui3 As USER_INFO_3
    Dim bServer() As Byte
    Dim bUsername() As Byte

    m_sUserName = String(100, Chr$(0))
    GetUserName m_sUserName, 100
    m_sUserName = GetStrFromBufferA(m_sUserName)

    bServer = sServer & vbNullChar
    bUsername = m_sUserName & vbNullChar

    If (NetUserGetInfo(bServer(0), bUsername(0), 3, lpBuf) = NERR_Success) Then
    Call MoveMemory(ui3, ByVal lpBuf, Len(ui3))
    m_sComment = GetStrFromPtrW(ui3.usri3_comment)
    Call NetApiBufferFree(ByVal lpBuf)
    End If
    End Sub

    Public Function GetStrFromPtrW(lpszW As Long) As String
    Dim sRes As String

    sRes = String$(lstrlenW(ByVal lpszW) * 2, 0)
    Call WideCharToMultiByte(CP_ACP, 0, ByVal lpszW, -1, ByVal sRes, Len(sRes), 0, 0)
    GetStrFromPtrW = GetStrFromBufferA(sRes)
    End Function

    Public Function GetStrFromBufferA(sz As String) As String
    If InStr(sz, vbNullChar) Then
    GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
    Else
    GetStrFromBufferA = sz
    End If
    End Function



  • Thanks for your help.
    I had to rem out the "If (NetUserGetInfo...End if" statements. It was giving me a error message with my netapi32.dll. Can I keep the statements remmed out? Do I need a newer version of netapi32.dll?

    Trufaux

    : Try this... Create a module and copy this lot into it:
    :
    : Option Explicit
    :
    : Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    : Private Declare Function NetUserGetInfo Lib "netapi32" (lpServer As Any, UserName As Byte, ByVal Level As Long, lpBuffer As Long) As Long
    : Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal Buffer As Long) As Long
    : Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
    : Private Declare Function lstrlenW Lib "kernel32" (lpString As Any) As Long
    : Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal codepage As Long, ByVal dwFlags As Long, lpWideCharStr As Any, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
    :
    : Private Type USER_INFO_3
    : usri3_name As Long
    : usri3_password As Long
    : usri3_password_age As Long
    : usri3_priv As Long
    : usri3_home_dir As Long
    : usri3_comment As Long
    : usri3_flags As Long
    : usri3_script_path As Long
    : usri3_auth_flags As Long
    : usri3_full_name As Long
    : usri3_usr_comment As Long
    : usri3_parms As Long
    : usri3_workstations As Long
    : usri3_last_logon As Long
    : usri3_last_logoff As Long
    : usri3_acct_expires As Long
    : usri3_max_storage As Long
    : usri3_units_per_week As Long
    : usri3_logon_hours As Byte
    : usri3_bad_pw_count As Long
    : usri3_num_logons As Long
    : usri3_logon_server As String
    : usri3_country_code As Long
    : usri3_code_page As Long
    : usri3_user_id As Long
    : usri3_primary_group_id As Long
    : usri3_profile As Long
    : usri3_home_dir_drive As Long
    : usri3_password_expired As Long
    : End Type
    :
    : Private Const NERR_Success = 0
    : Private Const NERR_BASE = 2100
    : Private Const NERR_InvalidComputer = (NERR_BASE + 251)
    : Private Const NERR_UseNotFound = (NERR_BASE + 150)
    : Private Const CP_ACP = 0
    :
    : Private m_sUserName As String
    : Private m_sComment As String
    :
    :
    : Sub Getuser()
    : Call GetUserData
    : msgbox("Current User is: " & m_sUserName)
    : End Sub
    :
    : Private Sub GetUserData(Optional sServer As String)
    : Dim lpBuf As Long
    : Dim ui3 As USER_INFO_3
    : Dim bServer() As Byte
    : Dim bUsername() As Byte
    :
    : m_sUserName = String(100, Chr$(0))
    : GetUserName m_sUserName, 100
    : m_sUserName = GetStrFromBufferA(m_sUserName)
    :
    : bServer = sServer & vbNullChar
    : bUsername = m_sUserName & vbNullChar
    :
    : If (NetUserGetInfo(bServer(0), bUsername(0), 3, lpBuf) = NERR_Success) Then
    : Call MoveMemory(ui3, ByVal lpBuf, Len(ui3))
    : m_sComment = GetStrFromPtrW(ui3.usri3_comment)
    : Call NetApiBufferFree(ByVal lpBuf)
    : End If
    : End Sub
    :
    : Public Function GetStrFromPtrW(lpszW As Long) As String
    : Dim sRes As String
    :
    : sRes = String$(lstrlenW(ByVal lpszW) * 2, 0)
    : Call WideCharToMultiByte(CP_ACP, 0, ByVal lpszW, -1, ByVal sRes, Len(sRes), 0, 0)
    : GetStrFromPtrW = GetStrFromBufferA(sRes)
    : End Function
    :
    : Public Function GetStrFromBufferA(sz As String) As String
    : If InStr(sz, vbNullChar) Then
    : GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
    : Else
    : GetStrFromBufferA = sz
    : End If
    : End Function
    :
    :
    :
    :

  • WHat kind of network are you using? We use an NT network and have tried the script on NT & Win 2000 machines. What is the operating system of the client?

    I know you get an error if your not logged onto a network ie standard windows 98 log on.

    Does it work if you rem out the statements? The script was passed onto me so I'm a little unsure of its functionality, but it was part of a much bigger application to determine user passwords, network log's etc. I have only used it for excel based macro's for user rights, etc.

    If you want to try an updated dll drop me an e-mail at [email protected] and I'll e-mail the version from my machine to you.

    Cheers

    G
  • : Thanks for your help.
    : I had to rem out the "If (NetUserGetInfo...End if" statements. It was giving me a error message with my netapi32.dll. Can I keep the statements remmed out? Do I need a newer version of netapi32.dll?
    :
    : Trufaux
    :
    : : Try this... Create a module and copy this lot into it:
    : :
    : : Option Explicit
    : :
    : : Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    : : Private Declare Function NetUserGetInfo Lib "netapi32" (lpServer As Any, UserName As Byte, ByVal Level As Long, lpBuffer As Long) As Long
    : : Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal Buffer As Long) As Long
    : : Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
    : : Private Declare Function lstrlenW Lib "kernel32" (lpString As Any) As Long
    : : Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal codepage As Long, ByVal dwFlags As Long, lpWideCharStr As Any, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
    : :
    : : Private Type USER_INFO_3
    : : usri3_name As Long
    : : usri3_password As Long
    : : usri3_password_age As Long
    : : usri3_priv As Long
    : : usri3_home_dir As Long
    : : usri3_comment As Long
    : : usri3_flags As Long
    : : usri3_script_path As Long
    : : usri3_auth_flags As Long
    : : usri3_full_name As Long
    : : usri3_usr_comment As Long
    : : usri3_parms As Long
    : : usri3_workstations As Long
    : : usri3_last_logon As Long
    : : usri3_last_logoff As Long
    : : usri3_acct_expires As Long
    : : usri3_max_storage As Long
    : : usri3_units_per_week As Long
    : : usri3_logon_hours As Byte
    : : usri3_bad_pw_count As Long
    : : usri3_num_logons As Long
    : : usri3_logon_server As String
    : : usri3_country_code As Long
    : : usri3_code_page As Long
    : : usri3_user_id As Long
    : : usri3_primary_group_id As Long
    : : usri3_profile As Long
    : : usri3_home_dir_drive As Long
    : : usri3_password_expired As Long
    : : End Type
    : :
    : : Private Const NERR_Success = 0
    : : Private Const NERR_BASE = 2100
    : : Private Const NERR_InvalidComputer = (NERR_BASE + 251)
    : : Private Const NERR_UseNotFound = (NERR_BASE + 150)
    : : Private Const CP_ACP = 0
    : :
    : : Private m_sUserName As String
    : : Private m_sComment As String
    : :
    : :
    : : Sub Getuser()
    : : Call GetUserData
    : : msgbox("Current User is: " & m_sUserName)
    : : End Sub
    : :
    : : Private Sub GetUserData(Optional sServer As String)
    : : Dim lpBuf As Long
    : : Dim ui3 As USER_INFO_3
    : : Dim bServer() As Byte
    : : Dim bUsername() As Byte
    : :
    : : m_sUserName = String(100, Chr$(0))
    : : GetUserName m_sUserName, 100
    : : m_sUserName = GetStrFromBufferA(m_sUserName)
    : :
    : : bServer = sServer & vbNullChar
    : : bUsername = m_sUserName & vbNullChar
    : :
    : : If (NetUserGetInfo(bServer(0), bUsername(0), 3, lpBuf) = NERR_Success) Then
    : : Call MoveMemory(ui3, ByVal lpBuf, Len(ui3))
    : : m_sComment = GetStrFromPtrW(ui3.usri3_comment)
    : : Call NetApiBufferFree(ByVal lpBuf)
    : : End If
    : : End Sub
    : :
    : : Public Function GetStrFromPtrW(lpszW As Long) As String
    : : Dim sRes As String
    : :
    : : sRes = String$(lstrlenW(ByVal lpszW) * 2, 0)
    : : Call WideCharToMultiByte(CP_ACP, 0, ByVal lpszW, -1, ByVal sRes, Len(sRes), 0, 0)
    : : GetStrFromPtrW = GetStrFromBufferA(sRes)
    : : End Function
    : :
    : : Public Function GetStrFromBufferA(sz As String) As String
    : : If InStr(sz, vbNullChar) Then
    : : GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
    : : Else
    : : GetStrFromBufferA = sz
    : : End If
    : : End Function
    : :
    : :
    : :
    : :
    :
    :
    Try to use this

    This is Microsoft exam-le for Exel but I thin it will work at Access too

    Type the following code into a new module:


    ' Makes sure all variables are dimensioned in each subroutine.
    Option Explicit



    ' Access the GetUserNameA function in advapi32.dll and
    ' call the function GetUserName.
    Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
    (ByVal lpBuffer As String, nSize As Long) As Long



    ' Main routine to Dimension variables, retrieve user name
    ' and display answer.
    Sub Get_User_Name()



    ' Dimension variables
    Dim lpBuff As String * 25
    Dim ret As Long, UserName As String



    ' Get the user name minus any trailing spaces found in the name.
    ret = GetUserName(lpBuff, 25)
    UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)



    ' Display the User Name
    MsgBox UserName
    End Sub


    Run the macro Get_User_Name.
    Note that the current user name will appear in a message box.


  • Thanks. the code works fine.

    : : Thanks for your help.
    : : I had to rem out the "If (NetUserGetInfo...End if" statements. It was giving me a error message with my netapi32.dll. Can I keep the statements remmed out? Do I need a newer version of netapi32.dll?
    : :
    : : Trufaux
    : :
    : : : Try this... Create a module and copy this lot into it:
    : : :
    : : : Option Explicit
    : : :
    : : : Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    : : : Private Declare Function NetUserGetInfo Lib "netapi32" (lpServer As Any, UserName As Byte, ByVal Level As Long, lpBuffer As Long) As Long
    : : : Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal Buffer As Long) As Long
    : : : Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
    : : : Private Declare Function lstrlenW Lib "kernel32" (lpString As Any) As Long
    : : : Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal codepage As Long, ByVal dwFlags As Long, lpWideCharStr As Any, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
    : : :
    : : : Private Type USER_INFO_3
    : : : usri3_name As Long
    : : : usri3_password As Long
    : : : usri3_password_age As Long
    : : : usri3_priv As Long
    : : : usri3_home_dir As Long
    : : : usri3_comment As Long
    : : : usri3_flags As Long
    : : : usri3_script_path As Long
    : : : usri3_auth_flags As Long
    : : : usri3_full_name As Long
    : : : usri3_usr_comment As Long
    : : : usri3_parms As Long
    : : : usri3_workstations As Long
    : : : usri3_last_logon As Long
    : : : usri3_last_logoff As Long
    : : : usri3_acct_expires As Long
    : : : usri3_max_storage As Long
    : : : usri3_units_per_week As Long
    : : : usri3_logon_hours As Byte
    : : : usri3_bad_pw_count As Long
    : : : usri3_num_logons As Long
    : : : usri3_logon_server As String
    : : : usri3_country_code As Long
    : : : usri3_code_page As Long
    : : : usri3_user_id As Long
    : : : usri3_primary_group_id As Long
    : : : usri3_profile As Long
    : : : usri3_home_dir_drive As Long
    : : : usri3_password_expired As Long
    : : : End Type
    : : :
    : : : Private Const NERR_Success = 0
    : : : Private Const NERR_BASE = 2100
    : : : Private Const NERR_InvalidComputer = (NERR_BASE + 251)
    : : : Private Const NERR_UseNotFound = (NERR_BASE + 150)
    : : : Private Const CP_ACP = 0
    : : :
    : : : Private m_sUserName As String
    : : : Private m_sComment As String
    : : :
    : : :
    : : : Sub Getuser()
    : : : Call GetUserData
    : : : msgbox("Current User is: " & m_sUserName)
    : : : End Sub
    : : :
    : : : Private Sub GetUserData(Optional sServer As String)
    : : : Dim lpBuf As Long
    : : : Dim ui3 As USER_INFO_3
    : : : Dim bServer() As Byte
    : : : Dim bUsername() As Byte
    : : :
    : : : m_sUserName = String(100, Chr$(0))
    : : : GetUserName m_sUserName, 100
    : : : m_sUserName = GetStrFromBufferA(m_sUserName)
    : : :
    : : : bServer = sServer & vbNullChar
    : : : bUsername = m_sUserName & vbNullChar
    : : :
    : : : If (NetUserGetInfo(bServer(0), bUsername(0), 3, lpBuf) = NERR_Success) Then
    : : : Call MoveMemory(ui3, ByVal lpBuf, Len(ui3))
    : : : m_sComment = GetStrFromPtrW(ui3.usri3_comment)
    : : : Call NetApiBufferFree(ByVal lpBuf)
    : : : End If
    : : : End Sub
    : : :
    : : : Public Function GetStrFromPtrW(lpszW As Long) As String
    : : : Dim sRes As String
    : : :
    : : : sRes = String$(lstrlenW(ByVal lpszW) * 2, 0)
    : : : Call WideCharToMultiByte(CP_ACP, 0, ByVal lpszW, -1, ByVal sRes, Len(sRes), 0, 0)
    : : : GetStrFromPtrW = GetStrFromBufferA(sRes)
    : : : End Function
    : : :
    : : : Public Function GetStrFromBufferA(sz As String) As String
    : : : If InStr(sz, vbNullChar) Then
    : : : GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
    : : : Else
    : : : GetStrFromBufferA = sz
    : : : End If
    : : : End Function
    : : :
    : : :
    : : :
    : : :
    : :
    : :
    : Try to use this
    :
    : This is Microsoft exam-le for Exel but I thin it will work at Access too
    :
    : Type the following code into a new module:
    :
    :
    : ' Makes sure all variables are dimensioned in each subroutine.
    : Option Explicit
    :
    :
    :
    : ' Access the GetUserNameA function in advapi32.dll and
    : ' call the function GetUserName.
    : Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
    : (ByVal lpBuffer As String, nSize As Long) As Long
    :
    :
    :
    : ' Main routine to Dimension variables, retrieve user name
    : ' and display answer.
    : Sub Get_User_Name()
    :
    :
    :
    : ' Dimension variables
    : Dim lpBuff As String * 25
    : Dim ret As Long, UserName As String
    :
    :
    :
    : ' Get the user name minus any trailing spaces found in the name.
    : ret = GetUserName(lpBuff, 25)
    : UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
    :
    :
    :
    : ' Display the User Name
    : MsgBox UserName
    : End Sub
    :
    :
    : Run the macro Get_User_Name.
    : Note that the current user name will appear in a message box.
    :
    :
    :

Sign In or Register to comment.

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories