Article ID: 159423
Article Last Modified on 6/29/2004
Option Explicit
Private Declare Function LStrCpy Lib "kernel" (ByVal Dest As _
String, ByVal Source As Any) As Integer
Private Declare Function NetGetDCName Lib "NETAPI.DLL" ( _
ByVal server As String, ByVal domain As String, ByVal buffer As _
String, ByVal cbBuffer As Integer) As Integer
Private Declare Function NetUserGetInfo Lib "NETAPI.DLL" (ByVal _
server As String, ByVal UserName As String, ByVal level As _
Integer, buffer As Any, ByVal cbBuffer As Integer, pcbTotal As _
Integer) As Integer
Private Declare Function NetUserGetGroups Lib "NETAPI.DLL" (ByVal _
server As String, ByVal UserName As String, ByVal level As _
Integer, ByVal buffer As String, ByVal cbBuffer As Integer, _
cEntriesRead As Integer, cTotalAvail As Integer) As Integer
Private Type USER_INFO_10
usri10_name As String * 22
usri10_comment As Long
usri10_usr_comment As Long
usri10_full_name As Long
usri10_extraspace As String * 400
End Type
Private Type group_users_info_0
grui0_name As String * 22
End Type
Private UserI As USER_INFO_10
Private Group As group_users_info_0
Public Function PointerToString(Pointer As Long) As String
Dim res As Integer
Dim buffer As String * 80
buffer = String(80, 0)
If Pointer > 0 Then
res = LStrCpy(buffer, Pointer)
End If
PointerToString = Left(buffer, InStr(buffer, Chr(0)) - 1)
End Function
Private Sub Command1_Click()
List1.Clear
Screen.MousePointer = vbHourglass
Dim domain As String
domain = Text1.Text
Dim user_name As String
user_name = Text2.Text
Dim dc_name As String
dc_name = String(22, 0)
Dim status As Long
'Get the name of the Domain Server
status = NetGetDCName("", domain, dc_name, Len(dc_name))
If status <> 0 Then
MsgBox "Domain not found."
Else
'Strip off the extra characters from dc_name
dc_name = Left(dc_name, InStr(dc_name, Chr(0)))
Dim cRead As Integer
Dim total As Integer
Dim allGroups As String * 255
allGroups = String(255, 0)
status = NetUserGetGroups(dc_name, user_name, 0, _
allGroups, 255, cRead, total)
If (status <> 0) Then
MsgBox "NetUserGetGroups fails."
Exit Sub
Else
Dim i As Integer
For i = 1 To total
Group.grui0_name = Trim(Left(allGroups, 21))
List1.AddItem Group.grui0_name
allGroups = Mid(allGroups, 22, Len(allGroups) - 22)
allGroups = Trim(allGroups)
Next i
End If
status = NetUserGetInfo(dc_name, user_name, 10, _
UserI, Len(UserI), total)
If (status <> 0) Then
MsgBox "User name not found."
Exit Sub
Else
List1.AddItem "User Name: " & Left(UserI.usri10_name, _
InStr(UserI.usri10_name, Chr(0)) - 1)
List1.AddItem "Comment: " & _
PointerToString(UserI.usri10_comment)
List1.AddItem "User Comment: " & _
PointerToString(UserI.usri10_usr_comment)
List1.AddItem "Full Name: " & _
PointerToString(UserI.usri10_full_name)
End If
End If
Screen.MousePointer = vbNormal
End Sub
151774 How to Call NetUserGetInfo from Visual Basic 4.0
Additional query words: kb16bitonly kbVBp400 kbVBp kbWinOS98
Keywords: kbhowto kbapi kbnetwork KB159423