form1.frm

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

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "获取用户登录信息"
   ClientHeight    =   2115
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5280
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2115
   ScaleWidth      =   5280
   StartUpPosition =   2  '屏幕中心
   Begin VB.ListBox LstUserInfo 
      Height          =   960
      Left            =   120
      TabIndex        =   7
      Top             =   480
      Width           =   4935
   End
   Begin VB.CommandButton CmdRun 
      Caption         =   "运行(&R)"
      Default         =   -1  'True
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   1560
      Width           =   975
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "其它域"
      Height          =   180
      Left            =   4200
      TabIndex        =   6
      Top             =   240
      Width           =   540
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "服务器"
      Height          =   180
      Left            =   3000
      TabIndex        =   5
      Top             =   240
      Width           =   540
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "域"
      Height          =   180
      Left            =   1560
      TabIndex        =   4
      Top             =   240
      Width           =   180
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "用户名"
      Height          =   180
      Left            =   120
      TabIndex        =   3
      Top             =   240
      Width           =   540
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "Label2"
      Height          =   255
      Left            =   3600
      TabIndex        =   2
      Top             =   1680
      Width           =   615
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "Label1"
      Height          =   255
      Left            =   1200
      TabIndex        =   1
      Top             =   1680
      Width           =   2175
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CmdRun_Click()
    Dim bufptr          As Long
   Dim dwServer        As Long
   Dim dwEntriesread   As Long
   Dim dwTotalentries  As Long
   Dim dwResumehandle  As Long
   Dim nStatus         As Long
   Dim nStructSize     As Long
   Dim cnt             As Long
   Dim bServer         As String
   Dim wui1            As WKSTA_USER_INFO_1
   bServer = "\\" & Environ$("COMPUTERNAME") & vbNullString
   dwServer = StrPtr(bServer)
   LstUserInfo.Clear
  '开始do循环
   Do
     '调用NetWkstaUserEnum函数，并指定信息级别为1
      nStatus = NetWkstaUserEnum(dwServer, _
                                 1, _
                                 bufptr, _
                                 MAX_PREFERRED_LENGTH, _
                                 dwEntriesread, _
                                 dwTotalentries, _
                                 dwResumehandle)
      Label2.Caption = nStatus
     '判断函数调用是否成功。只有本地组管理员成员可以
     '在本地或远程服务器上成功执行函数NetWkstaUserEnum
      If nStatus = NERR_SUCCESS Or _
         nStatus = ERROR_MORE_DATA Then
         If dwEntriesread > 0 Then
            nStructSize = LenB(wui1)
           '对所有的入口进行循环操作
            For cnt = 0 To dwEntriesread - 1
              '转换数据类型为WKSTA_USER_INFO_1，并将其加入到列表中
               CopyMemory wui1, ByVal bufptr + (nStructSize * cnt), nStructSize
               LstUserInfo.AddItem GetPointerToByteStringW(wui1.wkui1_username) & vbTab & _
                             GetPointerToByteStringW(wui1.wkui1_logon_domain) & vbTab & _
                             GetPointerToByteStringW(wui1.wkui1_logon_server) & vbTab & _
                             GetPointerToByteStringW(wui1.wkui1_oth_domains)
            Next
         Else:
           '错误：当函数成功调用，但没有返回数据时则执行下一语句。
           '例如枚举Win9x机器上的用户信息时则会发生这类错误。
            LstUserInfo.AddItem "未返回数据：可能是Win9x机器"
            
         End If
      Else:  '错误
         LstUserInfo.AddItem "调用错误" & nStatus
      End If
  '当存在其它的入口时，继续调用函数NetWkstaUserEnum
   Loop While nStatus = ERROR_MORE_DATA
  '释放bufptr缓存
   Call NetApiBufferFree(bufptr)
End Sub

Private Sub Form_Load()
    ReDim TabArray(0 To 3) As Long
   
   TabArray(0) = 58
   TabArray(1) = 130
   TabArray(2) = 171
   TabArray(3) = 197
   
  '设置列表框的制表位
   Call SendMessage(LstUserInfo.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(LstUserInfo.hwnd, LB_SETTABSTOPS, 4&, TabArray(0))
   LstUserInfo.Refresh

   
   Label1.Caption = "调用成功(0)或错误:"
   Label2.Caption = ""

End Sub

Private Function GetPointerToByteStringW(ByVal dwData As Long) As String
  
   Dim tmp() As Byte
   Dim tmplen As Long
   If dwData <> 0 Then
      tmplen = lstrlenW(dwData) * 2
      If tmplen <> 0 Then
         ReDim tmp(0 To (tmplen - 1)) As Byte
         CopyMemory tmp(0), ByVal dwData, tmplen
         GetPointerToByteStringW = tmp
     End If
   End If
End Function