form1.frm

电子书“Visual Basic 6 网络编程实例教程.rar”

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "用户列表及其信息"
   ClientHeight    =   4605
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3780
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4605
   ScaleWidth      =   3780
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox Text5 
      Height          =   375
      Left            =   960
      TabIndex        =   10
      Text            =   "Text5"
      Top             =   3960
      Width           =   2655
   End
   Begin VB.TextBox Text4 
      Height          =   375
      Left            =   960
      TabIndex        =   9
      Text            =   "Text4"
      Top             =   3510
      Width           =   2655
   End
   Begin VB.TextBox Text3 
      Height          =   375
      Left            =   960
      TabIndex        =   8
      Text            =   "Text3"
      Top             =   3060
      Width           =   2655
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   960
      TabIndex        =   7
      Text            =   "Text2"
      Top             =   2610
      Width           =   2655
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   960
      TabIndex        =   6
      Text            =   "Text1"
      Top             =   2160
      Width           =   2655
   End
   Begin VB.ListBox List1 
      Height          =   1860
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3495
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "用户描述"
      Height          =   180
      Left            =   120
      TabIndex        =   5
      Top             =   4050
      Width           =   720
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "描述"
      Height          =   180
      Left            =   120
      TabIndex        =   4
      Top             =   3600
      Width           =   360
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "用户全名"
      Height          =   180
      Left            =   120
      TabIndex        =   3
      Top             =   3150
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "用户名"
      Height          =   180
      Left            =   120
      TabIndex        =   2
      Top             =   2700
      Width           =   540
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "服务器"
      Height          =   180
      Left            =   120
      TabIndex        =   1
      Top             =   2250
      Width           =   540
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()
    Dim tmp As String
   Dim bServername() As Byte
   tmp = rgbGetComputerName()
  '确保服务器名字符串有正确的格式
   If Len(tmp) Then
      If InStr(tmp, "\\") Then
            bServername = tmp & Chr$(0)
      Else: bServername = "\\" & tmp & Chr$(0)
      End If
   End If
   Text1.Text = tmp
   Call GetUserEnumInfo(bServername())
End Sub

Private Function GetUserEnumInfo(bServername() As Byte)
  
   Dim users() As Long
   Dim buff As Long
   Dim buffsize As Long
   Dim entriesread As Long
   Dim totalentries As Long
   Dim cnt As Integer
   buffsize = 255
   If NetUserEnum(bServername(0), 0, _
                   FILTER_NORMAL_ACCOUNT, _
                   buff, buffsize, _
                   entriesread, _
                   totalentries, 0&) = ERROR_SUCCESS Then
      ReDim users(0 To entriesread - 1) As Long
      CopyMemory users(0), ByVal buff, entriesread * 4
      For cnt = 0 To entriesread - 1
         List1.AddItem GetPointerToByteStringW(users(cnt))
      Next cnt
      NetApiBufferFree buff
   End If
End Function


Private Function rgbGetComputerName() As String
  '返回机器的名称
   Dim tmp As String
   tmp = Space$(MAX_COMPUTERNAME + 1)
   If GetComputerName(tmp, Len(tmp)) <> 0 Then
      rgbGetComputerName = TrimNull(tmp)
   End If
End Function


Private Function TrimNull(item As String)
   Dim pos As Integer
   pos = InStr(item, Chr$(0))
   If pos Then
         TrimNull = Left$(item, pos - 1)
   Else: TrimNull = item
   End If
End Function


Private Function GetUserNetworkInfo(bServername() As Byte, bUsername() As Byte) As USER_INFO
   Dim usrapi As USER_INFO_10
   Dim buff As Long
   If NetUserGetInfo(bServername(0), bUsername(0), 10, buff) = ERROR_SUCCESS Then
     '将buff中的数据复制到user_10结构中
      CopyMemory usrapi, ByVal buff, Len(usrapi)
     '获取需要的数据信息
      GetUserNetworkInfo.name = GetPointerToByteStringW(usrapi.usr10_name)
      GetUserNetworkInfo.full_name = GetPointerToByteStringW(usrapi.usr10_full_name)
      GetUserNetworkInfo.comment = GetPointerToByteStringW(usrapi.usr10_comment)
      GetUserNetworkInfo.usr_comment = GetPointerToByteStringW(usrapi.usr10_usr_comment)
      NetApiBufferFree buff
   End If
End Function


Private Function GetPointerToByteStringW(lpString As Long) As String
   Dim buff() As Byte
   Dim nSize As Long
   If lpString Then
     '因为是Unicode，所有要乘以2
      nSize = lstrlenW(lpString) * 2
      If nSize Then
         ReDim buff(0 To (nSize - 1)) As Byte
         CopyMemory buff(0), ByVal lpString, nSize
         GetPointerToByteStringW = buff
     End If
   End If
End Function


Private Sub List1_Click()
    Dim usr As USER_INFO
   Dim bUsername() As Byte
   Dim bServername() As Byte
   Dim tmp As String
  '确保服务器名和用户名参数中都有数据
   If Len(Text1.Text) And List1.ListIndex > -1 Then
      bUsername = List1.List(List1.ListIndex) & Chr$(0)
     '当本程序运行在Windows NT4和Windows 2000时，以本机器作为服务器参数，
     '如果连接到了一个PDC或BDC，则可直接传递这个名称作为服务器名，
     '而无需使用GetComputerName()的返回值
      tmp = Text1.Text
     '确保服务器名字符串有正确的格式
      If Len(tmp) Then
         If InStr(tmp, "\\") Then
               bServername = tmp & Chr$(0)
         Else: bServername = "\\" & tmp & Chr$(0)
         End If
      End If
     '返回用户的信息。该信息被直接存放在USER_INFO数据类型中
      usr = GetUserNetworkInfo(bServername(), bUsername())
      Text2.Text = usr.name
     '能否得到用户全名、描述信息以及用户的描述信息，
     '完全取决于“用户管理器”的列表信息
      Text3.Text = usr.full_name
      Text4.Text = usr.comment
      Text5.Text = usr.usr_comment
   End If
End Sub