Question:
I created a program to Add User Account to my NT Server. It reads from a text file which provides the user info. Everything works fine, except that the user’s full name takes the value from the user id. I used USER_INFO_2 and I specified the flag usri2_full_name to take the values from the text file (the value has been changed to unicode). This really puzzles me as the rest works fine. Please advice.
Answer:
It’s really hard to say without seeing both the code and the declares, but there are lots of way to go wrong with the unicode functions, and only a couple of ways to do it correctly. The following VB code will allow you to add users, including full names, to either the local machine or the server.
' ***********************************************' IN A MODULE (*.BAS) FILE' ***********************************************Option ExplicitPrivate Declare Function lstrlenW _ Lib "kernel32" (ByVal lpString As Long) As LongPrivate Declare Sub CopyMem _ Lib "kernel32" Alias "RtlMoveMemory" _ (pTo As Any, _ uFrom As Any, _ ByVal lSize As Long)' **************************************************' Inputs : ByVal xi_lngStrPtr:Long -- Pointer to a string' Outputs : String: Translated string' Description : When passed a pointer to a string,' : return that string' **************************************************Public Function PointerToStringW(xi_lngPtrString As Long) As StringOn Error Resume Next ' Don't accept error here Dim p_abytBuffer() As Byte Dim p_lngLength As Long If xi_lngPtrString <> 0 Then p_lngLength = lstrlenW(xi_lngPtrString) * 2 If p_lngLength Then ReDim p_abytBuffer(0 To (p_lngLength - 1)) As Byte CopyMem p_abytBuffer(0), ByVal xi_lngPtrString, p_lngLength PointerToStringW = p_abytBuffer End If End If On Error GoTo 0End Function' **************************************************' Inputs : ByVal xi_lngDWord:Long -- Pointer to a DWord' Outputs : String: Pointer' Description : When passed a DWord, return a pointer to' : that DWord' **************************************************Public Function PointerToDWord(xi_lngDWord As Long) As LongOn Error Resume Next ' Don't accept error here Dim p_lngRtn As Long If xi_lngDWord <> 0 Then CopyMem p_lngRtn, ByVal xi_lngDWord, 4 PointerToDWord = p_lngRtn End If On Error GoTo 0End Function' ***********************************************' IN A FORM (*.FRM) FILE' ***********************************************Option Explicit' ---------------------------------------------' API calls' ---------------------------------------------Private Declare Function NetUserAdd _ Lib "netapi32.dll" _ (ServerName As Byte, _ ByVal Level As Long, _ Buffer As USER_INFO_3, _ parm_err As Long) As Long' ---------------------------------------------' Possible errors with API call' ---------------------------------------------Private Const ERROR_ACCESS_DENIED As Long = 5Private Const NERR_BASE As Long = 2100Private Const NERR_GroupExists As Long = NERR_BASE + 123Private Const NERR_NotPrimary As Long = NERR_BASE + 126Private Const NERR_UserExists As Long = NERR_BASE + 124Private Const NERR_PasswordTooShort As Long = NERR_BASE + 145Private Const NERR_InvalidComputer As Long = NERR_BASE + 251' ---------------------------------------------' General constants used' ---------------------------------------------Private Const constUserInfoLevel3 As Long = 3Private Const TIMEQ_FOREVER As Long = -1&Private Const MAX_PATH As Long = 260&Private Const DOMAIN_GROUP_RID_USERS As Long = &H201&Private Const USER_MAXSTORAGE_UNLIMITED As Long = -1&' ---------------------------------------------' Used by usri3_flags element of data structure' ---------------------------------------------Private Const UF_SCRIPT As Long = &H1&Private Const UF_ACCOUNTDISABLE As Long = &H2&Private Const UF_HOMEDIR_REQUIRED As Long = &H8&Private Const UF_LOCKOUT As Long = &H10&Private Const UF_PASSWD_NOTREQD As Long = &H20&Private Const UF_PASSWD_CANT_CHANGE As Long = &H40&Private Const UF_DONT_EXPIRE_PASSWD As Long = &H10000Private Const STILL_ACTIVE As Long = &H103&Private Const UF_NORMAL_ACCOUNT As Long = &H200&Private Const UF_SERVER_TRUST_ACCOUNT As Long = &H2000&Private Const PROCESS_QUERY_INFORMATION As Long = &H400&Private Const UF_TEMP_DUPLICATE_ACCOUNT As Long = &H100&Private Const UF_INTERDOMAIN_TRUST_ACCOUNT As Long = &H800&Private Const UF_WORKSTATION_TRUST_ACCOUNT As Long = &H1000&' ---------------------------------------------' The USER_INFO_3 data structure' ---------------------------------------------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 Long usri3_bad_pw_count As Long usri3_num_logons As Long usri3_logon_server As Long 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 LongEnd TypePrivate Sub Command2_Click() Dim p_blnRtn As Boolean On Error Resume Next p_blnRtn = AddUser(xi_strServerName:="PDCNEW", _ xi_strUserName:="MyUser1", _ xi_strPassword:="ABCDEF", _ xi_strUserFullName:="Long Name for MyUser", _ xi_strUserComment:="This is a comment") If Err.Number <> 0 Then MsgBox "Error: " & Err.Description & " in the function " & Err.Source End If End Sub' **********************************************' Add a user either to NT -- you *MUST* have admin or' account operator priviledges to successfully run' this function' **********************************************Public Function AddUser(ByVal xi_strServerName As String, _ ByVal xi_strUserName As String, _ ByVal xi_strPassword As String, _ Optional ByVal xi_strUserFullName As String = vbNullString, _ Optional ByVal xi_strUserComment As String = vbNullString) As Boolean Dim p_strErr As String Dim p_lngRtn As Long Dim p_lngPtrUserName As Long Dim p_lngPtrPassword As Long Dim p_lngPtrUserFullName As Long Dim p_lngPtrUserComment As Long Dim p_lngParameterErr As Long Dim p_lngFlags As Long Dim p_abytServerName() As Byte Dim p_abytUserName() As Byte Dim p_abytPassword() As Byte Dim p_abytUserFullName() As Byte Dim p_abytUserComment() As Byte Dim p_strServerName As String Dim p_typUserInfo3 As USER_INFO_3 If xi_strUserFullName = vbNullString Then xi_strUserName = xi_strUserName End If If Len(xi_strServerName) < 1 Then p_strServerName = "" Else p_strServerName = UCase$(xi_strServerName) If Left$(p_strServerName, 2) <> "\" Then p_strServerName = "\" & p_strServerName End If End If ' ------------------------------------------ ' Create byte arrays to avoid Unicode hassles ' ------------------------------------------ p_abytServerName = p_strServerName & vbNullChar p_abytUserName = xi_strUserName & vbNullChar p_abytUserFullName = xi_strUserFullName & vbNullChar p_abytPassword = xi_strPassword & vbNullChar p_abytUserComment = xi_strUserComment & vbNullChar ' ------------------------------------------ ' Get pointers to the byte arrays ' ------------------------------------------ p_lngPtrUserName = VarPtr(p_abytUserName(0)) p_lngPtrUserFullName = VarPtr(p_abytUserFullName(0)) p_lngPtrPassword = VarPtr(p_abytPassword(0)) p_lngPtrUserComment = VarPtr(p_abytUserComment(0)) ' ------------------------------------------ ' Fill the VB structure ' ------------------------------------------ p_lngFlags = UF_NORMAL_ACCOUNT Or _ UF_SCRIPT Or _ UF_DONT_EXPIRE_PASSWD With p_typUserInfo3 .usri3_acct_expires = TIMEQ_FOREVER ' Never expires .usri3_comment = p_lngPtrUserComment ' Comment .usri3_flags = p_lngFlags ' There are a number of variations .usri3_full_name = p_lngPtrUserFullName ' User's full name .usri3_max_storage = USER_MAXSTORAGE_UNLIMITED ' Can use any amount of disk space .usri3_name = p_lngPtrUserName ' Name of user account .usri3_password = p_lngPtrPassword ' Password for user account .usri3_primary_group_id = DOMAIN_GROUP_RID_USERS ' You MUST use this constant for NetUserAdd .usri3_script_path = 0& ' Path of user's logon script .usri3_auth_flags = 0& ' Ignored by NetUserAdd .usri3_bad_pw_count = 0& ' Ignored by NetUserAdd .usri3_code_page = 0& ' Code page for user's language .usri3_country_code = 0& ' Country code for user's language .usri3_home_dir = 0& ' Can specify path of home directory of this user .usri3_home_dir_drive = 0& ' Drive letter assign to user's profile .usri3_last_logoff = 0& ' Not needed when adding a user .usri3_last_logon = 0& ' Ignored by NetUserAdd .usri3_logon_hours = 0& ' Null means no restrictions .usri3_logon_server = 0& ' Null means logon to domain server .usri3_num_logons = 0& ' Ignored by NetUserAdd .usri3_parms = 0& ' Used by specific applications .usri3_password_age = 0& ' Ignored by NetUserAdd .usri3_password_expired = 0& ' None-zero means user must change password at next logon .usri3_priv = 0& ' Ignored by NetUserAdd .usri3_profile = 0& ' Path to a user's profile .usri3_units_per_week = 0& ' Ignored by NetUserAdd .usri3_user_id = 0& ' Ignored by NetUserAdd .usri3_usr_comment = 0& ' User comment .usri3_workstations = 0& ' Workstations a user can log onto (null = all stations) End With ' ------------------------------------------' Attempt to add the user' ------------------------------------------ p_lngRtn = NetUserAdd(p_abytServerName(0), _ constUserInfoLevel3, _ p_typUserInfo3, _ p_lngParameterErr) ' ------------------------------------------' Check for error' ------------------------------------------ If p_lngRtn <> 0 Then AddUser = False Select Case p_lngRtn Case ERROR_ACCESS_DENIED p_strErr = "User doesn't have sufficient access rights." Case NERR_GroupExists p_strErr = "The group already exists." Case NERR_NotPrimary p_strErr = "Can only do this operation on the PDC of the domain." Case NERR_UserExists p_strErr = "The user account already exists." Case NERR_PasswordTooShort p_strErr = "The password is shorter than required." Case NERR_InvalidComputer p_strErr = "The computer name is invalid." Case Else p_strErr = "Unknown error #" & CStr(p_lngRtn) End Select On Error GoTo 0 Err.Raise Number:=p_lngRtn, _ Description:=p_strErr & vbCrLf & _ "Error in parameter " & p_lngParameterErr & _ " when attempting to add the user, " & xi_strUserName, _ Source:="Form1.AddUser" Else AddUser = True End IfEnd Function
