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 Long
Private Declare Function NetApiBufferAllocate _
Lib "netapi32.dll" _
(ByVal ByteCount As Long, _
Ptr As Long) As Long
Private Declare Function NetApiBufferFree _
Lib "netapi32" _
(ByVal pBuffer As Long) As Long
' ---------------------------------------------
' Possible errors with API call
' ---------------------------------------------
Private Const ERROR_ACCESS_DENIED As Long = 5
Private Const NERR_BASE As Long = 2100
Private Const NERR_GroupExists As Long = NERR_BASE + 123
Private Const NERR_NotPrimary As Long = NERR_BASE + 126
Private Const NERR_UserExists As Long = NERR_BASE + 124
Private Const NERR_PasswordTooShort As Long = NERR_BASE + 145
Private Const NERR_InvalidComputer As Long = NERR_BASE + 251
' ---------------------------------------------
' General constants used
' ---------------------------------------------
Private Const constUserInfoLevel3 As Long = 3
Private 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 = &H10000
Private 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 Long
End Type
Private 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
Digg
del.icio.us
Newvine
furl
StumbleUpon
BlinkList
Newsvine
Magnolia
Facebook
Tailrank
Slashdot
Technorati
Google Bookmarks
Yahoo Favorites
Windows Live
Ask
