Problems with NetAddUser

[Jeff Morgan]

I am working on a project that adds users and groups to a domain. Here is
the problem that I am having. When I execute the program on any machine
other than the Primary Domain Controller, I get a 123 error, which as near
as I can tell, essentially is saying it cannot find the PDC. Also, I get
the same error running the program on the PDC using the pointer to the name.
If I pass in a 0 for the server parameter, it works without a hitch.

Thinking that I wasn't calling it correctly, I incorporated a function that
returns a pointer to the PrimaryDC and used that value to pass into the NetAddUser
API, but still the same 123 error. I am stumped.

Any ideas as to why I cannot run this API would be helpful. I have to believe
that is can be done. Here is the code that I am using.

Thanks
Jeff Morgan

Function AddUser3(ByVal ServerName As String, ByVal uname As String, ByVal
PWD As String, ByVal full_name As String, ByVal Comment As String, ByVal
Group As String) As Long

On Error GoTo AddUserAPI_Err

Dim result As Long
Dim iSuccess As Integer
Dim COMPtr As Long
Dim UNPtr As Long
Dim PWDPtr As Long
Dim SNPtr As Long
Dim FNPtr As Long
Dim GrpPTR As Long
Dim tstPtr As Long
Dim ParmError As Long
Dim SNArray() As Byte
Dim COMArray() As Byte
Dim UNArray() As Byte
Dim PWDArray() As Byte
Dim FNArray() As Byte
Dim GRPArray() As Byte
Dim tstArray() As Byte
Dim sString As String




Dim adduser As Long
Dim UserStruct As UserInfo3




'
' Move to byte arrays
'
' SNArray = ServerName & vbNullChar
UNArray = uname & vbNullChar
PWDArray = PWD & vbNullChar
FNArray = full_name & vbNullChar
GRPArray = Group & vbNullChar
COMArray = Comment & vbNullChar
tstArray = vbNullChar

'
' Allocate buffer space
'
result = NetAPIBufferAllocate(UBound(UNArray) + 1, UNPtr)
result = NetAPIBufferAllocate(UBound(PWDArray) + 1, PWDPtr)
result = NetAPIBufferAllocate(UBound(FNArray) + 1, FNPtr)
'result = NetAPIBufferAllocate(UBound(SNArray) + 1, SNPtr)
result = NetAPIBufferAllocate(UBound(GRPArray) + 1, GrpPTR)
result = NetAPIBufferAllocate(UBound(COMArray) + 1, COMPtr)
result = NetAPIBufferAllocate(UBound(tstArray) + 1, tstPtr)
'

' Copy arrays to the buffer
'
result = StrToPtr(UNPtr, UNArray(0))
result = StrToPtr(PWDPtr, PWDArray(0))
result = StrToPtr(FNPtr, FNArray(0))
result = StrToPtr(GrpPTR, GRPArray(0))
result = StrToPtr(COMPtr, COMArray(0))
result = StrToPtr(tstPtr, tstArray(0))
'result = StrToPtr(SNPtr, SNArray(0))
'On Error Resume Next


With UserStruct
.Name = UNPtr
.Password = PWDPtr
.PasswordAge = 0
.Privilege = USER_PRIV_USER
.HomeDir = tstPtr
.Comment = COMPtr
.Flags = UF_SCRIPT
.ScriptPath = tstPtr
.AuthFlags = 0
.FullName = FNPtr
.UserComment = 0
.Parms = tstPtr
.Workstations = tstPtr
.LastLogon = 0
.LastLogoff = 0
.AcctExpires = TIMEQ_FOREVER
.MaxStorage = 0
.UnitsPerWeek = 0
.LogonHours = 0
.BadPwCount = 0
.NumLogons = 0
.LogonServer = 0
.CountryCode = 0
.CodePage = 0
.UserID = 0
.PrimaryGroupID = DOMAIN_GROUP_RID_USERS
.Profile = tstPtr
.HomeDirDrive = tstPtr
.PasswordExpired = 5

End With

' sString = GetPrimaryDCName("")
SNPtr = GetPrimaryDCPointer("")
result = NetUserAdd(SNPtr, 3, UserStruct, ParmError)
If result <> 0 Then
If result = 2224 Then
'User all ready exists! Add message to serrors array
ReDim Preserve sErrors(UBound(sErrors) + 1)
sErrors(UBound(sErrors)) = "User " & uname & " all ready exists
in domain"
Else
ReDim Preserve sErrors(UBound(sErrors) + 1)
sErrors(UBound(sErrors)) = "User " & uname & " not added as user
error # " & result
End If
Else
'User has been added, now to add to group
result = NetGroupAddUser(SNArray(0), GRPArray(0), UNArray(0))
If result <> 0 Then
ReDim Preserve sErrors(UBound(sErrors) + 1)
sErrors(UBound(sErrors)) = "User " & uname & " not added to group
error # " & result
End If
End If


' Release buffers from memory

result = NetAPIBufferFree(UNPtr)
result = NetAPIBufferFree(PWDPtr)
result = NetAPIBufferFree(SNPtr)
result = NetAPIBufferFree(FNPtr)
Exit Function

AddUserAPI_Err:

Select Case Err.Number
Case Else
MsgBox Err.Number & "--" & Err.Description
Resume Next

End Select



End Function

Option Explicit


Public Declare Function NetUserAdd Lib "netapi32" (lpServer As Any, ByVal
level As Long, lpUser As UserInfo3, lpError As Long) As Long

Public Declare Function NetGroupAdd Lib "netapi32.dll" (ServerName As Any,
ByVal level As Long, Buffer As GroupInfo1, ParmError As Long) As Long
Public Declare Function NetGetDCName Lib "netapi32.dll" (ServerName As Long,
DomainName As Byte, DCNPtr As Long) As Long
Public Declare Function NetUserDel Lib "netapi32.dll" (ServerName As Byte,
UserName As Byte) As Long
Public Declare Function NetGroupAddUser Lib "netapi32.dll" (ServerName As
Byte, GroupName As Byte, UserName As Byte) As Long
Public Declare Function NetGroupDelUser Lib "netapi32.dll" (ServerName As
Byte, GroupName As Byte, UserName As Byte) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest
As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Public Declare Function NetAPIBufferFree Lib "netapi32.dll" Alias "NetApiBufferFree"
(ByVal Ptr As Long) As Long
Public Declare Function NetAPIBufferAllocate Lib "netapi32.dll" Alias "NetApiBufferAllocate"
(ByVal ByteCount As Long, Ptr As Long) As Long
Public Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyW" (RetVal
As Byte, ByVal Ptr As Long) As Long
Public Declare Function StrToPtr Lib "kernel32" Alias "lstrcpyW" (ByVal Ptr
As Long, Source As Byte) As Long
Private Declare Sub lstrcpyW Lib "kernel32" (dest As Any, ByVal src As Any)


Public Type UserInfo3
' Level 0 starts here
Name As Long
' Level 1 starts here
Password As Long
PasswordAge As Long
Privilege As Long
HomeDir As Long
Comment As Long
Flags As Long
ScriptPath As Long
' Level 2 starts here
AuthFlags As Long
FullName As Long
UserComment As Long
Parms As Long
Workstations As Long
LastLogon As Long
LastLogoff As Long
AcctExpires As Long
MaxStorage As Long
UnitsPerWeek As Long
LogonHours As Long
BadPwCount As Long
NumLogons As Long
LogonServer As Long
CountryCode As Long
CodePage As Long
' ' Level 3 starts here
UserID As Long
PrimaryGroupID As Long
Profile As Long
HomeDirDrive As Long
PasswordExpired As Long
End Type

Public Type GroupInfo1
GroupName As Long
GroupComment As Long
End Type


Public Const DOMAIN_GROUP_RID_USERS = &H201
Public Const USER_MAXSTORAGE_UNLIMITED = -1&
Public Const USER_PRIV_ADMIN = 2
Public Const USER_PRIV_GUEST = 0
Public Const USER_PRIV_USER = 1
Public Const UF_SCRIPT = &H1
Public Const UF_ACCOUNTDISABLE = &H2
Public Const UF_HOMEDIR_REQUIRED = &H8
Public Const UF_LOCKOUT = &H10
Public Const UF_PASSWD_NOTREQD = &H20
Public Const UF_PASSWD_CANT_CHANGE = &H40
Public Const UF_NORMAL_ACCOUNT = &H200
Public Const FILTER_NORMAL_ACCOUNT = &H2

Public Const NERR_BASE = 2100
Public Const NERR_GroupExists = (NERR_BASE + 123)
Public Const NERR_InvalidComputer = (NERR_BASE + 251)
Public Const NERR_NotPrimary = (NERR_BASE + 126)
Public Const NERR_PasswordTooShort = (NERR_BASE + 145)
Public Const NERR_Success = 0&
Public Const NERR_UserExists = (NERR_BASE + 124)
Public Const TIMEQ_FOREVER = -1&




Public Function GetPrimaryDCName(ByVal dname As String) As String

Dim DCName As String, DCNPtr As Long
Dim DNArray() As Byte, DCNArray(100) As Byte
Dim result As Long

DNArray = dname & vbNullChar
' Lookup the Primary Domain Controller
result = NetGetDCName(0&, DNArray(0), DCNPtr)
' If result <> 0 Then
' MsgBox "Error: " & result
' Exit Function
' End If
lstrcpyW DCNArray(0), DCNPtr
result = NetAPIBufferFree(DCNPtr)
DCName = DCNArray()
GetPrimaryDCName = Left(DCName, InStr(DCName, Chr(0)) - 1)



End Function

Public Function GetPrimaryDCPointer(ByVal dname As String) As Long

Dim DCName As String, DCNPtr As Long
Dim DNArray() As Byte, DCNArray(100) As Byte
Dim result As Long

DNArray = dname & vbNullChar
' Lookup the Primary Domain Controller
result = NetGetDCName(0&, DNArray(0), DCNPtr)
' If result <> 0 Then
' MsgBox "Error: " & result
' Exit Function
' End If

GetPrimaryDCPointer = DCNPtr

result = NetAPIBufferFree(DCNPtr)


End Function

[Raul M. Fragoso]

Hi Jeff,

Try to use the module sent to your e-mail.
It works fine for me.

Hope this helps,

--
Raul M. Fragoso
raulf@zip.net

"Jeff Morgan" <jmorgan@usfamily.net> wrote in message
news:3a86d1f3$1@news.devx.com...
>
> I am working on a project that adds users and groups to a domain. Here is
> the problem that I am having. When I execute the program on any machine
> other than the Primary Domain Controller, I get a 123 error, which as near
> as I can tell, essentially is saying it cannot find the PDC. Also, I get
> the same error running the program on the PDC using the pointer to the
name.
> If I pass in a 0 for the server parameter, it works without a hitch.
>
> Thinking that I wasn't calling it correctly, I incorporated a function
that
> returns a pointer to the PrimaryDC and used that value to pass into the
NetAddUser
> API, but still the same 123 error. I am stumped.
>
> Any ideas as to why I cannot run this API would be helpful. I have to
believe
> that is can be done. Here is the code that I am using.
>
> Thanks
> Jeff Morgan
>
> Function AddUser3(ByVal ServerName As String, ByVal uname As String, ByVal
> PWD As String, ByVal full_name As String, ByVal Comment As String, ByVal
> Group As String) As Long
>
> On Error GoTo AddUserAPI_Err
>
> Dim result As Long
> Dim iSuccess As Integer
> Dim COMPtr As Long
> Dim UNPtr As Long
> Dim PWDPtr As Long
> Dim SNPtr As Long
> Dim FNPtr As Long
> Dim GrpPTR As Long
> Dim tstPtr As Long
> Dim ParmError As Long
> Dim SNArray() As Byte
> Dim COMArray() As Byte
> Dim UNArray() As Byte
> Dim PWDArray() As Byte
> Dim FNArray() As Byte
> Dim GRPArray() As Byte
> Dim tstArray() As Byte
> Dim sString As String
>
>
>
>
> Dim adduser As Long
> Dim UserStruct As UserInfo3
>
>
>
>
> '
> ' Move to byte arrays
> '
> ' SNArray = ServerName & vbNullChar
> UNArray = uname & vbNullChar
> PWDArray = PWD & vbNullChar
> FNArray = full_name & vbNullChar
> GRPArray = Group & vbNullChar
> COMArray = Comment & vbNullChar
> tstArray = vbNullChar
>
> '
> ' Allocate buffer space
> '
> result = NetAPIBufferAllocate(UBound(UNArray) + 1, UNPtr)
> result = NetAPIBufferAllocate(UBound(PWDArray) + 1, PWDPtr)
> result = NetAPIBufferAllocate(UBound(FNArray) + 1, FNPtr)
> 'result = NetAPIBufferAllocate(UBound(SNArray) + 1, SNPtr)
> result = NetAPIBufferAllocate(UBound(GRPArray) + 1, GrpPTR)
> result = NetAPIBufferAllocate(UBound(COMArray) + 1, COMPtr)
> result = NetAPIBufferAllocate(UBound(tstArray) + 1, tstPtr)
> '
>
> ' Copy arrays to the buffer
> '
> result = StrToPtr(UNPtr, UNArray(0))
> result = StrToPtr(PWDPtr, PWDArray(0))
> result = StrToPtr(FNPtr, FNArray(0))
> result = StrToPtr(GrpPTR, GRPArray(0))
> result = StrToPtr(COMPtr, COMArray(0))
> result = StrToPtr(tstPtr, tstArray(0))
> 'result = StrToPtr(SNPtr, SNArray(0))
> 'On Error Resume Next
>
>
> With UserStruct
> .Name = UNPtr
> .Password = PWDPtr
> .PasswordAge = 0
> .Privilege = USER_PRIV_USER
> .HomeDir = tstPtr
> .Comment = COMPtr
> .Flags = UF_SCRIPT
> .ScriptPath = tstPtr
> .AuthFlags = 0
> .FullName = FNPtr
> .UserComment = 0
> .Parms = tstPtr
> .Workstations = tstPtr
> .LastLogon = 0
> .LastLogoff = 0
> .AcctExpires = TIMEQ_FOREVER
> .MaxStorage = 0
> .UnitsPerWeek = 0
> .LogonHours = 0
> .BadPwCount = 0
> .NumLogons = 0
> .LogonServer = 0
> .CountryCode = 0
> .CodePage = 0
> .UserID = 0
> .PrimaryGroupID = DOMAIN_GROUP_RID_USERS
> .Profile = tstPtr
> .HomeDirDrive = tstPtr
> .PasswordExpired = 5
>
> End With
>
> ' sString = GetPrimaryDCName("")
> SNPtr = GetPrimaryDCPointer("")
> result = NetUserAdd(SNPtr, 3, UserStruct, ParmError)
> If result <> 0 Then
> If result = 2224 Then
> 'User all ready exists! Add message to serrors array
> ReDim Preserve sErrors(UBound(sErrors) + 1)
> sErrors(UBound(sErrors)) = "User " & uname & " all ready
exists
> in domain"
> Else
> ReDim Preserve sErrors(UBound(sErrors) + 1)
> sErrors(UBound(sErrors)) = "User " & uname & " not added as
user
> error # " & result
> End If
> Else
> 'User has been added, now to add to group
> result = NetGroupAddUser(SNArray(0), GRPArray(0), UNArray(0))
> If result <> 0 Then
> ReDim Preserve sErrors(UBound(sErrors) + 1)
> sErrors(UBound(sErrors)) = "User " & uname & " not added to
group
> error # " & result
> End If
> End If
>
>
> ' Release buffers from memory
>
> result = NetAPIBufferFree(UNPtr)
> result = NetAPIBufferFree(PWDPtr)
> result = NetAPIBufferFree(SNPtr)
> result = NetAPIBufferFree(FNPtr)
> Exit Function
>
> AddUserAPI_Err:
>
> Select Case Err.Number
> Case Else
> MsgBox Err.Number & "--" & Err.Description
> Resume Next
>
> End Select
>
>
>
> End Function
>
> Option Explicit
>
>
> Public Declare Function NetUserAdd Lib "netapi32" (lpServer As Any, ByVal
> level As Long, lpUser As UserInfo3, lpError As Long) As Long
>
> Public Declare Function NetGroupAdd Lib "netapi32.dll" (ServerName As Any,
> ByVal level As Long, Buffer As GroupInfo1, ParmError As Long) As Long
> Public Declare Function NetGetDCName Lib "netapi32.dll" (ServerName As
Long,
> DomainName As Byte, DCNPtr As Long) As Long
> Public Declare Function NetUserDel Lib "netapi32.dll" (ServerName As Byte,
> UserName As Byte) As Long
> Public Declare Function NetGroupAddUser Lib "netapi32.dll" (ServerName As
> Byte, GroupName As Byte, UserName As Byte) As Long
> Public Declare Function NetGroupDelUser Lib "netapi32.dll" (ServerName As
> Byte, GroupName As Byte, UserName As Byte) As Long
> Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
(hpvDest
> As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
> Public Declare Function NetAPIBufferFree Lib "netapi32.dll" Alias
"NetApiBufferFree"
> (ByVal Ptr As Long) As Long
> Public Declare Function NetAPIBufferAllocate Lib "netapi32.dll" Alias
"NetApiBufferAllocate"
> (ByVal ByteCount As Long, Ptr As Long) As Long
> Public Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyW" (RetVal
> As Byte, ByVal Ptr As Long) As Long
> Public Declare Function StrToPtr Lib "kernel32" Alias "lstrcpyW" (ByVal
Ptr
> As Long, Source As Byte) As Long
> Private Declare Sub lstrcpyW Lib "kernel32" (dest As Any, ByVal src As
Any)
>
>
> Public Type UserInfo3
> ' Level 0 starts here
> Name As Long
> ' Level 1 starts here
> Password As Long
> PasswordAge As Long
> Privilege As Long
> HomeDir As Long
> Comment As Long
> Flags As Long
> ScriptPath As Long
> ' Level 2 starts here
> AuthFlags As Long
> FullName As Long
> UserComment As Long
> Parms As Long
> Workstations As Long
> LastLogon As Long
> LastLogoff As Long
> AcctExpires As Long
> MaxStorage As Long
> UnitsPerWeek As Long
> LogonHours As Long
> BadPwCount As Long
> NumLogons As Long
> LogonServer As Long
> CountryCode As Long
> CodePage As Long
> ' ' Level 3 starts here
> UserID As Long
> PrimaryGroupID As Long
> Profile As Long
> HomeDirDrive As Long
> PasswordExpired As Long
> End Type
>
> Public Type GroupInfo1
> GroupName As Long
> GroupComment As Long
> End Type
>
>
> Public Const DOMAIN_GROUP_RID_USERS = &H201
> Public Const USER_MAXSTORAGE_UNLIMITED = -1&
> Public Const USER_PRIV_ADMIN = 2
> Public Const USER_PRIV_GUEST = 0
> Public Const USER_PRIV_USER = 1
> Public Const UF_SCRIPT = &H1
> Public Const UF_ACCOUNTDISABLE = &H2
> Public Const UF_HOMEDIR_REQUIRED = &H8
> Public Const UF_LOCKOUT = &H10
> Public Const UF_PASSWD_NOTREQD = &H20
> Public Const UF_PASSWD_CANT_CHANGE = &H40
> Public Const UF_NORMAL_ACCOUNT = &H200
> Public Const FILTER_NORMAL_ACCOUNT = &H2
>
> Public Const NERR_BASE = 2100
> Public Const NERR_GroupExists = (NERR_BASE + 123)
> Public Const NERR_InvalidComputer = (NERR_BASE + 251)
> Public Const NERR_NotPrimary = (NERR_BASE + 126)
> Public Const NERR_PasswordTooShort = (NERR_BASE + 145)
> Public Const NERR_Success = 0&
> Public Const NERR_UserExists = (NERR_BASE + 124)
> Public Const TIMEQ_FOREVER = -1&
>
>
>
>
> Public Function GetPrimaryDCName(ByVal dname As String) As String
>
> Dim DCName As String, DCNPtr As Long
> Dim DNArray() As Byte, DCNArray(100) As Byte
> Dim result As Long
>
> DNArray = dname & vbNullChar
> ' Lookup the Primary Domain Controller
> result = NetGetDCName(0&, DNArray(0), DCNPtr)
> ' If result <> 0 Then
> ' MsgBox "Error: " & result
> ' Exit Function
> ' End If
> lstrcpyW DCNArray(0), DCNPtr
> result = NetAPIBufferFree(DCNPtr)
> DCName = DCNArray()
> GetPrimaryDCName = Left(DCName, InStr(DCName, Chr(0)) - 1)
>
>
>
> End Function
>
> Public Function GetPrimaryDCPointer(ByVal dname As String) As Long
>
> Dim DCName As String, DCNPtr As Long
> Dim DNArray() As Byte, DCNArray(100) As Byte
> Dim result As Long
>
> DNArray = dname & vbNullChar
> ' Lookup the Primary Domain Controller
> result = NetGetDCName(0&, DNArray(0), DCNPtr)
> ' If result <> 0 Then
> ' MsgBox "Error: " & result
> ' Exit Function
> ' End If
>
> GetPrimaryDCPointer = DCNPtr
>
> result = NetAPIBufferFree(DCNPtr)
>
>
> End Function
>

[Raul M. Fragoso]

Hi Jeff,

Try to use the module sent to your e-mail.
It works fine for me.

Hope this helps,

--
Raul M. Fragoso
raulf@zip.net

"Jeff Morgan" <jmorgan@usfamily.net> wrote in message
news:3a86d1f3$1@news.devx.com...
>
> I am working on a project that adds users and groups to a domain. Here is
> the problem that I am having. When I execute the program on any machine
> other than the Primary Domain Controller, I get a 123 error, which as near
> as I can tell, essentially is saying it cannot find the PDC. Also, I get
> the same error running the program on the PDC using the pointer to the
name.
> If I pass in a 0 for the server parameter, it works without a hitch.
>
> Thinking that I wasn't calling it correctly, I incorporated a function
that
> returns a pointer to the PrimaryDC and used that value to pass into the
NetAddUser
> API, but still the same 123 error. I am stumped.
>
> Any ideas as to why I cannot run this API would be helpful. I have to
believe
> that is can be done. Here is the code that I am using.
>
> Thanks
> Jeff Morgan
>
> Function AddUser3(ByVal ServerName As String, ByVal uname As String, ByVal
> PWD As String, ByVal full_name As String, ByVal Comment As String, ByVal
> Group As String) As Long
>
> On Error GoTo AddUserAPI_Err
>
> Dim result As Long
> Dim iSuccess As Integer
> Dim COMPtr As Long
> Dim UNPtr As Long
> Dim PWDPtr As Long
> Dim SNPtr As Long
> Dim FNPtr As Long
> Dim GrpPTR As Long
> Dim tstPtr As Long
> Dim ParmError As Long
> Dim SNArray() As Byte
> Dim COMArray() As Byte
> Dim UNArray() As Byte
> Dim PWDArray() As Byte
> Dim FNArray() As Byte
> Dim GRPArray() As Byte
> Dim tstArray() As Byte
> Dim sString As String
>
>
>
>
> Dim adduser As Long
> Dim UserStruct As UserInfo3
>
>
>
>
> '
> ' Move to byte arrays
> '
> ' SNArray = ServerName & vbNullChar
> UNArray = uname & vbNullChar
> PWDArray = PWD & vbNullChar
> FNArray = full_name & vbNullChar
> GRPArray = Group & vbNullChar
> COMArray = Comment & vbNullChar
> tstArray = vbNullChar
>
> '
> ' Allocate buffer space
> '
> result = NetAPIBufferAllocate(UBound(UNArray) + 1, UNPtr)
> result = NetAPIBufferAllocate(UBound(PWDArray) + 1, PWDPtr)
> result = NetAPIBufferAllocate(UBound(FNArray) + 1, FNPtr)
> 'result = NetAPIBufferAllocate(UBound(SNArray) + 1, SNPtr)
> result = NetAPIBufferAllocate(UBound(GRPArray) + 1, GrpPTR)
> result = NetAPIBufferAllocate(UBound(COMArray) + 1, COMPtr)
> result = NetAPIBufferAllocate(UBound(tstArray) + 1, tstPtr)
> '
>
> ' Copy arrays to the buffer
> '
> result = StrToPtr(UNPtr, UNArray(0))
> result = StrToPtr(PWDPtr, PWDArray(0))
> result = StrToPtr(FNPtr, FNArray(0))
> result = StrToPtr(GrpPTR, GRPArray(0))
> result = StrToPtr(COMPtr, COMArray(0))
> result = StrToPtr(tstPtr, tstArray(0))
> 'result = StrToPtr(SNPtr, SNArray(0))
> 'On Error Resume Next
>
>
> With UserStruct
> .Name = UNPtr
> .Password = PWDPtr
> .PasswordAge = 0
> .Privilege = USER_PRIV_USER
> .HomeDir = tstPtr
> .Comment = COMPtr
> .Flags = UF_SCRIPT
> .ScriptPath = tstPtr
> .AuthFlags = 0
> .FullName = FNPtr
> .UserComment = 0
> .Parms = tstPtr
> .Workstations = tstPtr
> .LastLogon = 0
> .LastLogoff = 0
> .AcctExpires = TIMEQ_FOREVER
> .MaxStorage = 0
> .UnitsPerWeek = 0
> .LogonHours = 0
> .BadPwCount = 0
> .NumLogons = 0
> .LogonServer = 0
> .CountryCode = 0
> .CodePage = 0
> .UserID = 0
> .PrimaryGroupID = DOMAIN_GROUP_RID_USERS
> .Profile = tstPtr
> .HomeDirDrive = tstPtr
> .PasswordExpired = 5
>
> End With
>
> ' sString = GetPrimaryDCName("")
> SNPtr = GetPrimaryDCPointer("")
> result = NetUserAdd(SNPtr, 3, UserStruct, ParmError)
> If result <> 0 Then
> If result = 2224 Then
> 'User all ready exists! Add message to serrors array
> ReDim Preserve sErrors(UBound(sErrors) + 1)
> sErrors(UBound(sErrors)) = "User " & uname & " all ready
exists
> in domain"
> Else
> ReDim Preserve sErrors(UBound(sErrors) + 1)
> sErrors(UBound(sErrors)) = "User " & uname & " not added as
user
> error # " & result
> End If
> Else
> 'User has been added, now to add to group
> result = NetGroupAddUser(SNArray(0), GRPArray(0), UNArray(0))
> If result <> 0 Then
> ReDim Preserve sErrors(UBound(sErrors) + 1)
> sErrors(UBound(sErrors)) = "User " & uname & " not added to
group
> error # " & result
> End If
> End If
>
>
> ' Release buffers from memory
>
> result = NetAPIBufferFree(UNPtr)
> result = NetAPIBufferFree(PWDPtr)
> result = NetAPIBufferFree(SNPtr)
> result = NetAPIBufferFree(FNPtr)
> Exit Function
>
> AddUserAPI_Err:
>
> Select Case Err.Number
> Case Else
> MsgBox Err.Number & "--" & Err.Description
> Resume Next
>
> End Select
>
>
>
> End Function
>
> Option Explicit
>
>
> Public Declare Function NetUserAdd Lib "netapi32" (lpServer As Any, ByVal
> level As Long, lpUser As UserInfo3, lpError As Long) As Long
>
> Public Declare Function NetGroupAdd Lib "netapi32.dll" (ServerName As Any,
> ByVal level As Long, Buffer As GroupInfo1, ParmError As Long) As Long
> Public Declare Function NetGetDCName Lib "netapi32.dll" (ServerName As
Long,
> DomainName As Byte, DCNPtr As Long) As Long
> Public Declare Function NetUserDel Lib "netapi32.dll" (ServerName As Byte,
> UserName As Byte) As Long
> Public Declare Function NetGroupAddUser Lib "netapi32.dll" (ServerName As
> Byte, GroupName As Byte, UserName As Byte) As Long
> Public Declare Function NetGroupDelUser Lib "netapi32.dll" (ServerName As
> Byte, GroupName As Byte, UserName As Byte) As Long
> Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
(hpvDest
> As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
> Public Declare Function NetAPIBufferFree Lib "netapi32.dll" Alias
"NetApiBufferFree"
> (ByVal Ptr As Long) As Long
> Public Declare Function NetAPIBufferAllocate Lib "netapi32.dll" Alias
"NetApiBufferAllocate"
> (ByVal ByteCount As Long, Ptr As Long) As Long
> Public Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyW" (RetVal
> As Byte, ByVal Ptr As Long) As Long
> Public Declare Function StrToPtr Lib "kernel32" Alias "lstrcpyW" (ByVal
Ptr
> As Long, Source As Byte) As Long
> Private Declare Sub lstrcpyW Lib "kernel32" (dest As Any, ByVal src As
Any)
>
>
> Public Type UserInfo3
> ' Level 0 starts here
> Name As Long
> ' Level 1 starts here
> Password As Long
> PasswordAge As Long
> Privilege As Long
> HomeDir As Long
> Comment As Long
> Flags As Long
> ScriptPath As Long
> ' Level 2 starts here
> AuthFlags As Long
> FullName As Long
> UserComment As Long
> Parms As Long
> Workstations As Long
> LastLogon As Long
> LastLogoff As Long
> AcctExpires As Long
> MaxStorage As Long
> UnitsPerWeek As Long
> LogonHours As Long
> BadPwCount As Long
> NumLogons As Long
> LogonServer As Long
> CountryCode As Long
> CodePage As Long
> ' ' Level 3 starts here
> UserID As Long
> PrimaryGroupID As Long
> Profile As Long
> HomeDirDrive As Long
> PasswordExpired As Long
> End Type
>
> Public Type GroupInfo1
> GroupName As Long
> GroupComment As Long
> End Type
>
>
> Public Const DOMAIN_GROUP_RID_USERS = &H201
> Public Const USER_MAXSTORAGE_UNLIMITED = -1&
> Public Const USER_PRIV_ADMIN = 2
> Public Const USER_PRIV_GUEST = 0
> Public Const USER_PRIV_USER = 1
> Public Const UF_SCRIPT = &H1
> Public Const UF_ACCOUNTDISABLE = &H2
> Public Const UF_HOMEDIR_REQUIRED = &H8
> Public Const UF_LOCKOUT = &H10
> Public Const UF_PASSWD_NOTREQD = &H20
> Public Const UF_PASSWD_CANT_CHANGE = &H40
> Public Const UF_NORMAL_ACCOUNT = &H200
> Public Const FILTER_NORMAL_ACCOUNT = &H2
>
> Public Const NERR_BASE = 2100
> Public Const NERR_GroupExists = (NERR_BASE + 123)
> Public Const NERR_InvalidComputer = (NERR_BASE + 251)
> Public Const NERR_NotPrimary = (NERR_BASE + 126)
> Public Const NERR_PasswordTooShort = (NERR_BASE + 145)
> Public Const NERR_Success = 0&
> Public Const NERR_UserExists = (NERR_BASE + 124)
> Public Const TIMEQ_FOREVER = -1&
>
>
>
>
> Public Function GetPrimaryDCName(ByVal dname As String) As String
>
> Dim DCName As String, DCNPtr As Long
> Dim DNArray() As Byte, DCNArray(100) As Byte
> Dim result As Long
>
> DNArray = dname & vbNullChar
> ' Lookup the Primary Domain Controller
> result = NetGetDCName(0&, DNArray(0), DCNPtr)
> ' If result <> 0 Then
> ' MsgBox "Error: " & result
> ' Exit Function
> ' End If
> lstrcpyW DCNArray(0), DCNPtr
> result = NetAPIBufferFree(DCNPtr)
> DCName = DCNArray()
> GetPrimaryDCName = Left(DCName, InStr(DCName, Chr(0)) - 1)
>
>
>
> End Function
>
> Public Function GetPrimaryDCPointer(ByVal dname As String) As Long
>
> Dim DCName As String, DCNPtr As Long
> Dim DNArray() As Byte, DCNArray(100) As Byte
> Dim result As Long
>
> DNArray = dname & vbNullChar
> ' Lookup the Primary Domain Controller
> result = NetGetDCName(0&, DNArray(0), DCNPtr)
> ' If result <> 0 Then
> ' MsgBox "Error: " & result
> ' Exit Function
> ' End If
>
> GetPrimaryDCPointer = DCNPtr
>
> result = NetAPIBufferFree(DCNPtr)
>
>
> End Function
>