Newsgroup: it.comp.lang.visual-basic
Titolo: Creare da VB un utente NT4

Salve a tutti,
mi chiedevo se fosse possibile creare una procedura VB6 che mi permetta di
creare utenti NT4, senza però usare il comando NET USER.
Grazie - Alessio

 creare utenti NT4, senza però usare il comando NET USER.
Le dichiarazioni delle strutture e costanti primarie le trovi
nell'Api Text Viewer. Aggiungo solo quelle a cui modifico
il nome e le costanti che possono non esserci (in base alla
versione di VB - tu usi la v.6 ma altri potrebbero avere la v.5)
C'è da aggiungere una gestione degli errori che è praticamente
inesistente.
Public Const USER_PRIV_MASK = &H3
Public Const USER_PRIV_GUEST = &H0
Public Const USER_PRIV_USER = &H1
Public Const USER_PRIV_ADMIN = &H2
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 DEFAULT_FLAG = &H0
Public Const MAX_FLAG = &HFFFFFFFF
Public Declare Function NetAddUser Lib "netapi32.dll" _
    Alias "NetUserAdd" ( _
    lpServer As Any, _
    ByVal Level As Long, _
    lpUser As USER_INFO_2, _
    lpError As Long) As Long
'Converte il puntatore passato in una stringa
'Usata da Net_GetPDCName
Public Function PointerToString(lpwString As Long) As String
Dim arrBuff() As Byte
Dim strLen As Long
   'Ritorna la stringa il cui puntatore è lpwString
   If lpwString > 0 Then
      strLen = lstrlenW(lpwString) * 2
      If strLen > 0 Then
         ReDim arrBuff(0 To (strLen - 1)) As Byte
         CopyMemory arrBuff(0), ByVal lpwString, strLen
         PointerToString = arrBuff
      End If
   End If
End Function
Public Function Net_GetPDCName( _
        ComputerName As String, _
        DomainName As String) As String
'ComputerName => Puntatore alla stringa che contiene
'il nome del server remote nel quale eseguire il comando
'Una stringa nulla indica la macchina locale
'
'DomainName => Puntatore alla stringa che contiene il nome del
'dominio. Una stringa nulla indica che la funzione ritorna il nome
'del domain controller per il dominio primario (PDC).
Dim arrComputer() As Byte
Dim arrDomain() As Byte
Dim lngRet As Long
Dim lpBuffer As Long
Dim lpstrResult As String
    If Trim$(ComputerName) = "" Then
        'La funzione viene eseguita nella macchina locale
        arrComputer = vbNullChar
    Else
        'Controllo della sintassi (trivial)
        If InStr(ComputerName, "\\") = 1 Then
            arrComputer = ComputerName & vbNullChar
        Else
            arrComputer = "\\" & ComputerName & vbNullChar
        End If
    End If
    'If...Then...Else perché occorrerebbe un controllo migliore
    If Trim$(DomainName) = "" Then
        'Dominio predefinito
        arrDomain = vbNullChar
    Else
        arrDomain = DomainName & vbNullChar
    End If
    lngRet = NetGetDCName(arrComputer(0), arrDomain(0), lpBuffer)
    'La funzione ha avuto successo. Ottiene la stringa
    'in base al suo puntatore
    If lngRet = NERR_Success And lpBuffer Then
        lpstrResult = PointerToString(lpBuffer)
    End If
    'Pulisce il buffer
    If lpBuffer > 0 Then
        Call NetApiBufferFree(lpBuffer)
    End If
    GetPDCName = lpstrResult
End Function
'Aggiunge un utente al gruppo globale predefinito.
'Non vengono settate tutte le opzioni che permette la
'struttura USER_INFO_2. Per definire una gruppo di
'appartenenza diverso da quello predefinito, utilizza la
'struttura USER_INFO_3.
Public Function Net_AddUser( _
        ByVal ServerName As String, _
        ByVal UserName As String, _
        ByVal Password As String, _
        FullName As String,
        Comment As String,
        HomeDrive As String,
        HomeDir As String, _
        Script As String) As Long
Dim arrServerName() As Byte
Dim arrUserName() As Byte
Dim arrPassword() As Byte
Dim arrHomeDir() As Byte
Dim arrHomeDrive() As Byte
Dim arrComment() As Byte
Dim arrScript() As Byte
Dim arrFullName() As Byte
Dim ptrServerName As Long
Dim UserName As Long
Dim ptrPassword As Long
Dim ptrHomeDir As Long
Dim ptrHomeDrive As Long
Dim ptrComment As Long
Dim ptrScript As Long
Dim ptrFullName As Long
Dim lngRet As Long
Dim lngError As Long
Dim udtUserInfo As USER_INFO_2
    If Len(ServerName) = 0 Then
        ServerName = GetPDCName("", "")
    End If
    arrServerName = ServerName & vbNullChar
    arrUserName = UserName & vbNullChar
    arrPassword = Password & vbNullChar
    arrHomeDir = HomeDir & vbNullChar
    arrHomeDrive = HomeDrive & vbNullChar
    arrComment = Comment & vbNullChar
    arrScript = Script & vbNullChar
    arrFullName = FullName & vbNullChar
    Call NetAPIBufferAllocate(UBound(arrServerName) +1, ptrServerName)
    Call NetAPIBufferAllocate(UBound(arrUserName) +1, ptrUserName)
    Call NetAPIBufferAllocate(UBound(arrPassword) +1, ptrPassword)
    Call NetAPIBufferAllocate(UBound(arrHomeDir) +1, ptrHomeDir)
    Call NetAPIBufferAllocate(UBound(arrHomeDrive) +1, ptrHomeDrive)
    Call NetAPIBufferAllocate(UBound(arrComment) +1, ptrComment)
    Call NetAPIBufferAllocate(UBound(arrScript) +1, ptrScript)
    Call NetAPIBufferAllocate(UBound(arrFullName) +1, ptrFullName)
    With udtUserInfo
        .ptrName = ptrUserName
        .ptrPassword = ptrPassword
        .dwPasswordAge = 0
        .dwPriv = USER_PRIV_USER
        .ptrHomeDir = ptrHomeDir
        .ptrComment = ptrComment
        .dwFlags = UF_NORMAL_ACCOUNT Or UF_SCRIPT
        .ptrScriptPath = DEFAULT_FLAG
        .dwAuthFlags = DEFAULT_FLAG
        .ptrFullName = ptrFullName
        .ptrComment2 = DEFAULT_FLAG
        .ptrParms = DEFAULT_FLAG
        .ptrWorkstations = DEFAULT_FLAG
        .dwLastLogon = DEFAULT_FLAG
        .dwLastLogoff = DEFAULT_FLAG
        .dwAccountExpires = MAX_FLAG
        .dwMaxStorage = DEFAULT_FLAG
        .dwUnitsPerWeek = DEFAULT_FLAG
        .pbLogonHours = DEFAULT_FLAG
        .dwBadPasswordCount = MAX_FLAG
        .dwNumLogons = MAX_FLAG
        .ptrLogonServer = DEFAULT_FLAG
        .dwCountryCode = DEFAULT_FLAG
        .dwCodePage = DEFAULT_FLAG
    End With
    lngRet = NetAddUser( _
            arrServerName(0), _
            2, _
            udtUserInfo, _
            lngError)
    Call NetAPIBufferFree(ptrServerName)
    Call NetAPIBufferFree(ptrUserName)
    Call NetAPIBufferFree(ptrPassword)
    Call NetAPIBufferFree(ptrHomeDir)
    Call NetAPIBufferFree(ptrHomeDrive)
    Call NetAPIBufferFree(ptrComment)
    Call NetAPIBufferFree(ptrScript)
    Call NetAPIBufferFree(ptrFullName)
    'Ritorna un eventuale errore
    Net_AddUser = lngRer
End Function