NT brugerdatabase

Her er en af de rutiner jeg bruger i Delphi. Det er muligt det ikke siger dig noget fordi det ikke er VB, men du skal bruge samme API kald som jeg bruger:

procedure TNetServer.GetUsers (accountType : Integer; list : TStrings);
var
  wServerName : WideString;
  rv : NetAPIStatus;
  buffer : pointer;
  i, entriesRead, totalEntries : Integer;
  p : PUSER_INFO_0;
begin
  list.Clear;
  wServerName := ServerName;
  rv := NetUserEnum (PWideChar (wServerName), 0, accountType, buffer, MAX_PREFERRED_LENGTH,
                    entriesRead, totalEntries, NIL_HANDLE);
  if rv = NERR_Success then
    try
      p := PUSER_INFO_0 (buffer);
      for i := 0 to entriesRead - 1 do
      begin
        list.Add (p^.usri0_name);
        Inc (p)
      end
    finally
      NetAPIBufferFree (buffer)
    end
  else
    abort; {raise ENTException.Create (rv)}
end;

Tag et kig på API kaldet: NetUserEnum

Hvis du kopierer nedenstående ind, hentes brugernavn fra en server, eller en gruppe på en server

Option Explicit

Const FILTER_NORMAL_ACCOUNT = &H2
Const NERR_Success = 0
Const NERR_UserNotFound = 2221

Private Declare Function NetAPIBufferFree Lib "netapi32.dll" Alias "NetApiBufferFree" _
(ByVal Ptr As Long) As Long

Private Declare Function StrLen Lib "kernel32" Alias "lstrlenW" (ByVal Ptr As Long) As Long

Private Declare Function CopyMem Lib "kernel32" Alias "RtlMoveMemory" ( _
    hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long) As Long

Private Declare Function MyNetGroupEnumUsers0 Lib "netapi32.dll" Alias _
    "NetGroupGetUsers" ( _
    ByVal ServerName As String, _
    ByVal GroupName As String, _
    ByVal level As Long, _
    Buffer As Long, _
    ByVal PrefMaxLen As Long, _
    EntriesRead As Long, _
    TotalEntries As Long, _
    ResumeHandle As Long) As Long

Private Declare Function MyNetUserEnum0 Lib "netapi32.dll" Alias "NetUserEnum" _
    (ByVal ServerName As String, _
    ByVal level As Long, _
    ByVal lFilter As Long, _
    Buffer As Long, _
    ByVal PrefMaxLen As Long, _
    EntriesRead As Long, _
    TotalEntries As Long, _
    ResumeHandle As Long) As Long


'=============================================================
'Initial Author :  Jeff Hong YAN
'=============================================================
Function EnumerateUsersDomain(sMName As String, sGName As String, sReturn() As String) As Long
    Dim lResult As Long
    Dim lBufPtr As Long
    Dim lEntriesRead As Long
    Dim lTotalEntries As Long
    Dim lResumeHandle As Long
    Dim lBufLen As Long
    Dim sUName As String
    Dim i As Long
    Dim lUNPtr As Long

    Dim bTestArray() As Byte
    Dim sTest As String
    Dim lTheWord As Long
    Dim sNameTemp As String

    lBufLen = 255              'Buffer size
    lResumeHandle = 0          'Start med dette entry

    Dim swMName As String * 255    'Unicode string
    Dim swGName As String * 255    'Unicode string

    Dim bUNameTempArray() As Byte
    Dim lShift As Long

    swMName = StrConv(sMName & vbNullChar, vbUnicode)
    swGName = StrConv(sGName & vbNullChar, vbUnicode)

    ReDim sReturn(0)
    lShift = -1

    ReDim bUNameTempArray(255)

    Do
        If sGName = "" Then
            lResult = MyNetUserEnum0(swMName, 0&, FILTER_NORMAL_ACCOUNT, _
                lBufPtr, lBufLen, lEntriesRead, lTotalEntries, lResumeHandle)
        Else
            lResult = MyNetGroupEnumUsers0(swMName, swGName, 0, lBufPtr, _
                lBufLen, lEntriesRead, lTotalEntries, lResumeHandle)
        End If

      If lResult <> 0 And lResult <> 234 Then    ' 234 means multiple reads required
        Exit Function
      End If

      For i = 1 To lEntriesRead
            If lBufPtr = 0 Then Exit Function
            ReDim bTestArray(255)
            lResult = CopyMem(bTestArray(0), lBufPtr, 256&)
            lTheWord = CInt(bTestArray((i + lShift) * 4 + 3)) * 2 ^ 8 + _
                      CInt(bTestArray((i + lShift) * 4 + 2)) * 2 ^ 16 + _
                      CInt(bTestArray((i + lShift) * 4 + 1)) * 2 ^ 8 + _
                      CInt(bTestArray((i + lShift) * 4))
                     
            'Extract sub-strengen
            lResult = CopyMem(bUNameTempArray(0), lTheWord, 256&)
            sNameTemp = Left(bUNameTempArray, StrLen(lTheWord))
            If i - 1 > UBound(sReturn) Then
                ReDim Preserve sReturn(i - 1)
            End If
           
            sReturn(i - 1) = sNameTemp          'Indsæt det seneste navn i array
            Debug.Print "Name = " & sNameTemp  ' Print data i debug-window
      Next i
    Loop Until lEntriesRead = lTotalEntries

    lResult = NetAPIBufferFree(lBufPtr)    ' Frigiv den allokerede hukommelse igen
End Function



Private Sub Command1_Click()
    Dim sR() As String                ' Streng array der indeholder alle bruger-accounts
    Dim strComputer As String
    Dim strGruppe As String
   
    strComputer = "\\PC-CPHN-MIHE-NY"  ' navn på den server der skal aflevere brugere
    strGruppe = ""                    ' navnet på den gruppe hvis brugere der skal listes (tom gruppe = alle brugere)
   
    EnumerateUsersDomain strComputer, strGruppe, sR()
End Sub

Du skal selvfølgelig ændre computernavnet til den server der "ejer" de brugere du vil have oplysninger på...