Link to home
Start Free TrialLog in
Avatar of Robert Hertie
Robert Hertie

asked on

How to use fGetFullNameOfLoggedUser on Access 64 bit

I'm using the fGetFullNameOfLoggedUser function provided by Dev Ashish
on http://access.mvps.org/access/api/api0066.htm to determine the name of
the logged on user.
This works perfectly on 32 bit Access. But on 64 bit Access it crashes on the
Call sapiCopyMem(pTmp, ByVal pBuf, Len(pTmp)) function call.
(I added PtrSafe to all the declare statements)

What else should I change to get this to work on 64 bit?


Option Compare Database

' ******** Code Start ********
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Private Type USER_INFO_2
    usri2_name As Long
    usri2_password  As Long  ' Null, only settable
    usri2_password_age  As Long
    usri2_priv  As Long
    usri2_home_dir  As Long
    usri2_comment  As Long
    usri2_flags  As Long
    usri2_script_path  As Long
    usri2_auth_flags  As Long
    usri2_full_name As Long
    usri2_usr_comment  As Long
    usri2_parms  As Long
    usri2_workstations  As Long
    usri2_last_logon  As Long
    usri2_last_logoff  As Long
    usri2_acct_expires  As Long
    usri2_max_storage  As Long
    usri2_units_per_week  As Long
    usri2_logon_hours  As Long
    usri2_bad_pw_count  As Long
    usri2_num_logons  As Long
    usri2_logon_server  As Long
    usri2_country_code  As Long
    usri2_code_page  As Long
End Type
 
Private Declare PtrSafe Function apiNetGetDCName _
    Lib "netapi32.dll" Alias "NetGetDCName" _
    (ByVal servername As Long, _
    ByVal DomainName As Long, _
    bufptr As Long) As Long
 
' function frees the memory that the NetApiBufferAllocate
' function allocates.
Private Declare PtrSafe Function apiNetAPIBufferFree _
    Lib "netapi32.dll" Alias "NetApiBufferFree" _
    (ByVal buffer As Long) _
    As Long
 
' Retrieves the length of the specified wide string.
Private Declare PtrSafe Function apilstrlenW _
    Lib "kernel32" Alias "lstrlenW" _
    (ByVal lpString As Long) _
    As Long
 
Private Declare PtrSafe Function apiNetUserGetInfo _
    Lib "netapi32.dll" Alias "NetUserGetInfo" _
    (servername As Any, _
    username As Any, _
    ByVal level As Long, _
    bufptr As Long) As Long
 
' moves memory either forward or backward, aligned or unaligned,
' in 4-byte blocks, followed by any remaining bytes
Private Declare PtrSafe Sub sapiCopyMem _
    Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)
 
Private Declare PtrSafe Function apiGetUserName Lib _
    "advapi32.dll" Alias "GetUserNameA" _
    (ByVal lpBuffer As String, _
    nSize As Long) _
    As Long
 
Private Const MAXCOMMENTSZ = 256
Private Const NERR_SUCCESS = 0
Private Const ERROR_MORE_DATA = 234&
Private Const MAX_CHUNK = 25
Private Const ERROR_SUCCESS = 0&
 
Function fGetFullNameOfLoggedUser(Optional strUserName As String) As String
'
' Returns the full name for a given UserID
'   NT/2000 only
' Omitting the strUserName argument will try and
' retrieve the full name for the currently logged on user
'
On Error GoTo ErrHandler
Dim pBuf As Long
Dim dwRec As Long
Dim pTmp As USER_INFO_2
Dim abytPDCName() As Byte
Dim abytUserName() As Byte
Dim lngRet As Long
Dim i As Long
 
    ' Unicode
    abytPDCName = fGetDCName() & vbNullChar
    If (Len(strUserName) = 0) Then strUserName = fGetUserName()
    abytUserName = strUserName & vbNullChar
 
    ' Level 2
    lngRet = apiNetUserGetInfo( _
                            abytPDCName(0), _
                            abytUserName(0), _
                            2, _
                            pBuf)
    If (lngRet = ERROR_SUCCESS) Then
        Call sapiCopyMem(pTmp, ByVal pBuf, Len(pTmp))
        fGetFullNameOfLoggedUser = fStrFromPtrW(pTmp.usri2_full_name)
    End If
 
    Call apiNetAPIBufferFree(pBuf)
ExitHere:
    Exit Function
ErrHandler:
    fGetFullNameOfLoggedUser = vbNullString
    Resume ExitHere
End Function
 
Private Function fGetUserName() As String
' Returns the network login name
Dim lngLen As Long, lngRet As Long
Dim strUserName As String
    strUserName = String$(254, 0)
    lngLen = 255
    lngRet = apiGetUserName(strUserName, lngLen)
    If lngRet Then
        fGetUserName = Left$(strUserName, lngLen - 1)
    End If
End Function
 
Function fGetDCName() As String
Dim pTmp As Long
Dim lngRet As Long
Dim abytBuf() As Byte
 
    lngRet = apiNetGetDCName(0, 0, pTmp)
    If lngRet = NERR_SUCCESS Then
        fGetDCName = fStrFromPtrW(pTmp)
    End If
    Call apiNetAPIBufferFree(pTmp)
End Function
 
Private Function fStrFromPtrW(pBuf As Long) As String
Dim lngLen As Long
Dim abytBuf() As Byte
 
    ' Get the length of the string at the memory location
    lngLen = apilstrlenW(pBuf) * 2
    ' if it's not a ZLS
    If lngLen Then
        ReDim abytBuf(lngLen)
        ' then copy the memory contents
        ' into a temp buffer
        Call sapiCopyMem( _
                abytBuf(0), _
                ByVal pBuf, _
                lngLen)
        ' return the buffer
        fStrFromPtrW = abytBuf
    End If
End Function
' ******** Code End *********
Avatar of crystal (strive4peace) - Microsoft MVP, Access
crystal (strive4peace) - Microsoft MVP, Access

fyi: the link you referenced will be going away as MVPs.org, a site long maintained by volunteers, is shuffling out its contents to other places.  The Access content, hosted by Arvin Meyer, is now on TheAccessWeb and the link is:

http://TheAccessWeb.com/

for the specific page you referenced, the link is:
http://theaccessweb.com/api/api0066.htm 

however, perhaps what you want is just this?
http://theaccessweb.com/api/api0008.htm 

less API calls to convert ... just this one:

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

which will probably work with this:

Private Declare PtrSafe Function apiGetUserName Lib "advapi32.dll" Alias
 "GetUserNameA" (ByVal lpBuffer As String, nSize As LongPtr) As Long
ASKER CERTIFIED SOLUTION
Avatar of Jim Dettman (EE MVE)
Jim Dettman (EE MVE)
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Robert Hertie

ASKER

Thank you crystal.
Yes that works without any more conversions.

It is actually used in the fGetFullNameOfLoggedUser as the last call before the
Call sapiCopyMem(pTmp, ByVal pBuf, Len(pTmp))
that makes access crash.
That gets me the windows userid, but what I need is the name of the user linked to this id.

Any suggestions how to achieve that last step?
<<Any suggestions how to achieve that last step?>>

  As I said, take a look at this comment:

https://www.experts-exchange.com/questions/27190589/GetUserName-fails-on-64bit-Access.html?anchorAnswerId=36167741#a36167741

  It contains a few links that cover 32 to 64 bit quite well.    The first is an article explaining the changes required for 64 bit (like using PrtSafe and LongLong).

 The second gives you all the calls for VBA/VB for 32 bit that need to be modified, and the third all the new 64 bit calls.

 There's also a link there for a code inspector, which will point out any other problems in your code.

Jim.
Thanks Jim.

I was able to get this to work by changing some of the elements of the USER_INFO_2 to LongPtr and also changing
some of the parameters of the api calls and vba functions to LongPtr.

It seems to work fine now for both 32 and 64 bit.