home

Forms: Getting User Name (In a Secured Database)

5/23/01 9:56:37 AM
From Chris L: Date: 05/23/2001 07:56 AM
	
I recently got this code from www.mvps.org (I think) as shown below. What I
want to do is to be able to have a control on my form which will
automatically fill in the name of the person who is entering each record.
The idea being that this control will be disabled and so the user unable to
change this. (yes we do have a problem with people using each others name)
The problem I am having is that dont know quite what to do with the code.
Where should it go and how do I reference it to make the field automatically
filled in. The code is shown below for reference.

Thanks for any help.

Chris Lewis


Option Compare Database
Option Explicit

' ******** Code Start ********
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 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 Function apiNetAPIBufferFree _
Lib "netapi32.dll" Alias "NetApiBufferFree" _
(ByVal buffer As Long) _
As Long

' Retrieves the length of the specified wide string.
Private Declare Function apilstrlenW _
Lib "kernel32" Alias "lstrlenW" _
(ByVal lpString As Long) _
As Long

Private Declare 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 Sub sapiCopyMem _
Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)

Private Declare 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 *********

From Mark Mazur, 8:57 am
Hope this helps.....

In the form on open event try this,


dim networkname as string

networkname = fGetUserName

me.username = networkname


if the names are in a seperate table and the field is actually the ID to the
username then try this

dim getnamerst as recordset
dim networkname as string

networkname = fGetUserName

set getnamerst = currentdb.openrecordset("SELECT * FROM tblusers WHERE
UserName = '" & networkname & "'")
if getnamerst.eof = true then
msgbox "Can't find your name",,"Undefined User"
exit sub
else
me.username = getnamerst![userID]
end if
getnamerst.close

However, this code implies that your table of users also includes the
network name - this is what you would use to set the recordset...

set getnamerst = currentdb.openrecordset("SELECT * FROM tblusers WHERE
UserNetworkName = '" & networkname & "'")