Question:
How do I add and remove users from an NT server through VB? I have Web customers who are added and removed frequently from our Web site, where they require an ftp directory. When we get a new rep, I manually create a new ftp directory, create a new user, and assign permissions to a new ftp directory.
Answer:
The following code (paste into a form with 1 command button, Command1) will allow you to add a new user to NT:
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 LongPrivate Declare Function NetApiBufferAllocate _ Lib "netapi32.dll" _ (ByVal ByteCount As Long, _ Ptr As Long) As LongPrivate Declare Function NetApiBufferFree _ Lib "netapi32" _ (ByVal pBuffer 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 Command1_Click() Dim p_blnRtn As Boolean On Error Resume Next p_blnRtn = AddUser("", "MyUser2", "ABCDEF", "Long Name for MyUser", "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_typUserInfo3 As USER_INFO_3 If xi_strUserFullName = vbNullString Then xi_strUserName = xi_strUserName End If ' ------------------------------------------ ' Create byte arrays to avoid Unicode hassles ' ------------------------------------------ p_abytServerName = xi_strServerName & vbNullChar p_abytUserName = xi_strUserName & vbNullChar p_abytUserFullName = xi_strUserFullName & vbNullChar p_abytPassword = xi_strPassword & vbNullChar p_abytUserComment = xi_strUserComment & vbNullChar ' ------------------------------------------ ' Allocate buffer space ' ------------------------------------------ p_lngRtn = NetApiBufferAllocate(UBound(p_abytUserName), p_lngPtrUserName) p_lngRtn = NetApiBufferAllocate(UBound(p_abytUserFullName), p_lngPtrUserFullName) p_lngRtn = NetApiBufferAllocate(UBound(p_abytPassword), p_lngPtrPassword) p_lngRtn = NetApiBufferAllocate(UBound(p_abytUserComment), p_lngPtrUserComment) ' ------------------------------------------ ' 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 If ' ------------------------------------------ ' Be a good programmer and free the memory ' you've allocated ' ------------------------------------------ p_lngRtn = NetApiBufferFree(p_lngPtrUserName) p_lngRtn = NetApiBufferFree(p_lngPtrPassword) p_lngRtn = NetApiBufferFree(p_lngPtrUserFullName) p_lngRtn = NetApiBufferFree(p_lngPtrUserComment) End Function