form1.frm

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

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H00808000&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "网络工作站与用户信息"
   ClientHeight    =   3045
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7320
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3045
   ScaleWidth      =   7320
   StartUpPosition =   2  '屏幕中心
   Begin VB.ListBox LstWksInfo 
      Height          =   1500
      Left            =   240
      TabIndex        =   1
      Top             =   600
      Width           =   6975
   End
   Begin VB.CommandButton CmdRun 
      Caption         =   "运行(&R)"
      Default         =   -1  'True
      Height          =   495
      Left            =   360
      TabIndex        =   0
      Top             =   2400
      Width           =   1815
   End
   Begin VB.Label Label9 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "登录用户"
      ForeColor       =   &H00FFFFFF&
      Height          =   180
      Left            =   6000
      TabIndex        =   10
      Top             =   360
      Width           =   720
   End
   Begin VB.Label Label8 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "次版本号"
      ForeColor       =   &H00FFFFFF&
      Height          =   180
      Left            =   5160
      TabIndex        =   9
      Top             =   360
      Width           =   720
   End
   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "主版本号"
      ForeColor       =   &H00FFFFFF&
      Height          =   180
      Left            =   4320
      TabIndex        =   8
      Top             =   360
      Width           =   720
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "平台ID"
      ForeColor       =   &H00FFFFFF&
      Height          =   180
      Left            =   3600
      TabIndex        =   7
      Top             =   360
      Width           =   540
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "用户数"
      ForeColor       =   &H00FFFFFF&
      Height          =   180
      Left            =   2880
      TabIndex        =   6
      Top             =   360
      Width           =   540
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "本地组"
      ForeColor       =   &H00FFFFFF&
      Height          =   180
      Left            =   2040
      TabIndex        =   5
      Top             =   360
      Width           =   540
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "计算机"
      ForeColor       =   &H00FFFFFF&
      Height          =   180
      Left            =   360
      TabIndex        =   4
      Top             =   360
      Width           =   540
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Label2"
      ForeColor       =   &H00FFFFFF&
      Height          =   180
      Left            =   5280
      TabIndex        =   3
      Top             =   2520
      Width           =   1380
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Label1"
      ForeColor       =   &H00FFFFFF&
      Height          =   180
      Left            =   2280
      TabIndex        =   2
      Top             =   2520
      Width           =   2820
   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 CmdRun_Click()
    Dim bufptr          As Long
    Dim dwServer        As Long
    Dim success         As Long
    Dim nStructSize     As Long
    Dim bServer         As String
    Dim ws102           As WKSTA_INFO_102
    bServer = "\\" & Environ$("COMPUTERNAME") & vbNullString
    LstWksInfo.Clear
    Label2.Caption = success
    dwServer = StrPtr(bServer)
    success = NetWkstaGetInfo(dwServer, 102, bufptr)
    If success = NERR_SUCCESS And success <> ERROR_MORE_DATA Then
        nStructSize = LenB(ws102)
        '将数据转换为WKSTA_INFO_102类型
        '并将其填写到列表框中.
        '函数GetWorkstationUserName会返回dwServer所指定
        '的机器的当前注册用户名
        CopyMemory ws102, ByVal bufptr, nStructSize
        LstWksInfo.AddItem GetPointerToByteStringW(ws102.wki102_computername) & vbTab & _
            GetPointerToByteStringW(ws102.wki102_langroup) & vbTab & _
            ws102.wki102_logged_on_users & vbTab & _
            ws102.wki102_platform_id & vbTab & _
            ws102.wki102_ver_major & vbTab & _
            ws102.wki102_ver_minor & vbTab & _
            GetWorkstationUserName(dwServer)
    End If
    Call NetApiBufferFree(bufptr)
End Sub

Private Sub Form_Load()
    ReDim TabArray(0 To 6) As Long
    TabArray(0) = 78
    TabArray(1) = 129
    TabArray(2) = 159
    TabArray(3) = 198
    TabArray(4) = 227
    TabArray(5) = 253
    TabArray(6) = 302
    '清空列表框内容,设置列表位置
    Call SendMessage(LstWksInfo.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
    Call SendMessage(LstWksInfo.hwnd, LB_SETTABSTOPS, 7&, TabArray(0))
    LstWksInfo.Refresh
    '设置Label控件的标题
    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

Private Function GetWorkstationUserName(ByVal dwWorkstation As Long) As String
    Dim bufptr          As Long
    Dim dwEntriesread   As Long
    Dim dwTotalentries  As Long
    Dim dwResumehandle  As Long
    Dim success         As Long
    Dim nStructSize     As Long
    Dim wui0            As WKSTA_USER_INFO_0
    success = NetWkstaUserEnum(dwWorkstation, 0, bufptr, MAX_PREFERRED_LENGTH, _
            dwEntriesread, dwTotalentries, dwResumehandle)
    If success = NERR_SUCCESS And success <> ERROR_MORE_DATA Then
        nStructSize = LenB(wui0)
        If dwEntriesread > 0 Then
            '由于只需要用户名,所以将数据转换为WKSTA_USER_INFO_0类型
            ' 虽然这个API函数可以枚举并返回当前所有登录入工作站
            '的用户,包括交互、服务及组登录信息。
            '但幸运的是，该API函数枚举的第一个
            '用户就是登录入当前会话中的用户，
            '所以我们在取得第一个用户名后，就退出了函数
            CopyMemory wui0, ByVal bufptr, nStructSize
            GetWorkstationUserName = GetPointerToByteStringW(wui0.wkui0_username)
            '释放缓存并退出
            Call NetApiBufferFree(bufptr)
            Exit Function
        End If
    End If
    '如果参数dwWorkstation指向的是一个Win9x计算机
    'dwEntriesread的值就为0，此时返回一个缺省字符串
    GetWorkstationUserName = "n\a on Win9x"
    Call NetApiBufferFree(bufptr)
End Function