Login | Register   
LinkedIn
Google+
Twitter
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX


Tip of the Day
Language: NT
Expertise: Beginner
Apr 5, 1999

List NT Users on Domain

Question:
How do I list all the users on an NT domain with Visual Basic?

Answer:
The following code should get you started. Note that you need to add good error trapping to this code before using it in a production system:

 

Option Explicit

Private Declare Function NetUserEnum Lib "netapi32" (abytServer As Byte, ByVal Level As Long, _
    ByVal Flags As Long, lngBuffer As Long, ByVal MaxLen As Long, lpEntriesRead As Long, _
    lpTotalEntries As Long, lpResume_Handle As Long) As Long
Private Declare Sub CopyMem Lib "Kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, _
    ByVal lSize As Long)
Private Declare Function lstrlenW Lib "Kernel32" (ByVal lpString As Long) As Long
Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal pBuffer As Long) As Long

'-----------------------------------------------------------------
' Type declarations for the info passed back from NetUserEnum.
'-----------------------------------------------------------------
Private Type typUserInfo_10_API
    Name As Long
    Comment As Long
    UserComment As Long
    FullName As Long
End Type

Private Sub Command1_Click()
   Dim lngBuffer           As Long
   Dim abytServer()        As Byte
   Dim atypUsers()         As typUserInfo_10_API
   Dim lngTotalUsers       As Long
   Dim lngTotalUsersRead   As Long
   Dim lngRtn              As Long
   Dim lngResumeHwnd       As Long
   Dim lngCurrPos          As Long
   Dim strServerName       As String
   Dim strName             As String
   Dim strFullName         As String
   Dim strComment          As String
   Dim i                   As Long
   Const Flags& = 0
                
   strServerName = Trim$(Me.Text1.Text)
   If Len(strServerName) = 0 Then
      abytServer = ""
   Else
      If InStr(1, strServerName, "\\", vbTextCompare) <= 0 Then
         strServerName = "\\" & strServerName
      Else
         ' Already OK
      End If
      abytServer = strServerName & vbNullChar
   End If
      
    'call API to Enumerate users
   If Len(strServerName) <> 0 Then
      lngRtn = NetUserEnum(abytServer(0), 10, Flags, lngBuffer, _
                           &H4000, lngTotalUsersRead, _
                           lngTotalUsers, lngResumeHwnd)
   Else
      lngRtn = NetUserEnum(ByVal 0&, 10, Flags, lngBuffer, _
                           &H4000, lngTotalUsersRead, _
                           lngTotalUsers, lngResumeHwnd)
   End If
            
   If lngTotalUsersRead > 0 Then
      ReDim atypUsers(0 To lngTotalUsersRead - 1)
      CopyMem atypUsers(0), ByVal lngBuffer, Len(atypUsers(0)) * lngTotalUsersRead
      i = 0
         
      For i = 0 To lngTotalUsers - 1
         strName = PointerToStringW(atypUsers(i).Name)
         strFullName = PointerToStringW(atypUsers(i).FullName)
         strComment = PointerToStringW(atypUsers(i).Comment)
         Debug.Print strName, strFullName, strComment
      Next i
   End If
   
   If lngBuffer Then
      NetApiBufferFree lngBuffer
   End If
      
End Sub

Public Function PointerToStringW(lpStringW As Long) As String
   Dim yBuffer()   As Byte
   Dim lLen        As Long
   
   If lpStringW Then
   lLen = lstrlenW(lpStringW) * 2
      If lLen Then
         ReDim yBuffer(0 To (lLen - 1)) As Byte
         CopyMem yBuffer(0), ByVal lpStringW, lLen
         PointerToStringW = yBuffer
      End If
   End If
End Function
DevX Pro
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap