Problems with NetAddUser


DevX Home    Today's Headlines   Articles Archive   Tip Bank   Forums   

Results 1 to 3 of 3

Thread: Problems with NetAddUser

Hybrid View

  1. #1
    Jeff Morgan Guest

    Problems with NetAddUser


    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


  2. #2
    Raul M. Fragoso Guest

    Re: Problems with NetAddUser

    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
    >




  3. #3
    Raul M. Fragoso Guest

    Re: Problems with NetAddUser

    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
    >




Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
HTML5 Development Center
 
 
FAQ
Latest Articles
Java
.NET
XML
Database
Enterprise
Questions? Contact us.
C++
Web Development
Wireless
Latest Tips
Open Source


   Development Centers

   -- Android Development Center
   -- Cloud Development Project Center
   -- HTML5 Development Center
   -- Windows Mobile Development Center