form1.frm

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

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "工作站配置与用户登录信息"
   ClientHeight    =   2790
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5100
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2790
   ScaleWidth      =   5100
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton CmdRun 
      Caption         =   "运行(&R)"
      Height          =   495
      Left            =   120
      TabIndex        =   1
      Top             =   2040
      Width           =   1215
   End
   Begin VB.ListBox LstWksLogINfo 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1530
      Left            =   1440
      TabIndex        =   0
      Top             =   240
      Width           =   3255
   End
   Begin VB.Label Label8 
      AutoSize        =   -1  'True
      Caption         =   "登录域"
      Height          =   180
      Left            =   480
      TabIndex        =   9
      Top             =   1560
      Width           =   540
   End
   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      Caption         =   "登录服务器"
      Height          =   180
      Left            =   480
      TabIndex        =   8
      Top             =   1320
      Width           =   900
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      Caption         =   "用户名"
      Height          =   180
      Left            =   480
      TabIndex        =   7
      Top             =   1080
      Width           =   540
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "平台板本"
      Height          =   180
      Left            =   480
      TabIndex        =   6
      Top             =   720
      Width           =   720
   End
   Begin VB.Label Label4 
      Caption         =   "本地组"
      Height          =   180
      Left            =   480
      TabIndex        =   5
      Top             =   480
      Width           =   540
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "计算机"
      Height          =   180
      Left            =   480
      TabIndex        =   4
      Top             =   240
      Width           =   540
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      Height          =   255
      Left            =   4080
      TabIndex        =   3
      Top             =   2160
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      Height          =   255
      Left            =   1440
      TabIndex        =   2
      Top             =   2160
      Width           =   2535
   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
    Dim wui1            As WKSTA_USER_INFO_1
    bServer = "\\" & Environ$("COMPUTERNAME") & vbNullString
    dwServer = StrPtr(bServer)
    success = NetWkstaGetInfo(dwServer, 102, bufptr)
    LstWksLogINfo.Clear
    Label2.Caption = success
    If success = NERR_SUCCESS And success <> ERROR_MORE_DATA Then
        nStructSize = LenB(ws102)
        '将数据转换为WKSTA_INFO_102类型
        '并将其填写到列表框中.
        CopyMemory ws102, ByVal bufptr, nStructSize
        With LstWksLogINfo
            .AddItem "\\" & GetPointerToByteStringW(ws102.wki102_computername)
            .AddItem GetPointerToByteStringW(ws102.wki102_langroup)
            .AddItem GetPlatformID(ws102.wki102_platform_id) & _
                " " & ws102.wki102_ver_major & _
                "." & ws102.wki102_ver_minor
                .AddItem ""  'space
            '因为用户信息只能从Windows NT / 2000中返回
            '所以这里要测试操作平台id
            '如果平台有效，则继续
            Select Case ws102.wki102_platform_id
            Case PLATFORM_ID_NT
                wui1 = GetWorkstationUserInfo(dwServer)
                .AddItem GetPointerToByteStringW(wui1.wkui1_username)
                .AddItem GetPointerToByteStringW(wui1.wkui1_logon_server)
                .AddItem GetPointerToByteStringW(wui1.wkui1_logon_domain)
            Case Else
                .AddItem "不可用"
                .AddItem "不可用"
                .AddItem "不可用"
            End Select
        End With
    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(LstWksLogINfo.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
    Call SendMessage(LstWksLogINfo.hwnd, LB_SETTABSTOPS, 7&, TabArray(0))
    LstWksLogINfo.Refresh
   '设置Label控件的标题
    Label1.Caption = "函数调用成功(0)或错误次数:"
    Label2.Caption = ""
End Sub

Private Function GetWorkstationUserInfo(ByVal dwWorkstation As Long) As WKSTA_USER_INFO_1
    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 cnt             As Long
    Dim wui1            As WKSTA_USER_INFO_1
    success = NetWkstaUserEnum(dwWorkstation, 1, bufptr, MAX_PREFERRED_LENGTH, dwEntriesread, dwTotalentries, dwResumehandle)
    If success = NERR_SUCCESS And success <> ERROR_MORE_DATA Then
        nStructSize = LenB(wui1)
        If dwEntriesread > 0 Then
            '将数据转换为WKSTA_USER_INFO_1类型
            ' 虽然这个API函数可以枚举并返回当前所有登录入工作站
            '的用户,包括交互、服务及组登录信息。
            '但幸运的是，该API函数枚举的第一个
            '用户就是登录入当前会话中的用户，
            '所以我们在取得第一个用户名后，就退出了函数
            CopyMemory GetWorkstationUserInfo, ByVal bufptr, nStructSize
            '释放缓存并退出
            Call NetApiBufferFree(bufptr)
            Exit Function
        End If
    End If
    '释放缓存并退出
    Call NetApiBufferFree(bufptr)
End Function

Private Function GetPlatformID(ByVal dwPlatformID As Long) As String
    Select Case dwPlatformID
        Case PLATFORM_ID_DOS: GetPlatformID = "DOS"
        Case PLATFORM_ID_OS2: GetPlatformID = "Windows"
        Case PLATFORM_ID_NT:  GetPlatformID = "Windows NT"
        Case PLATFORM_ID_OSF: GetPlatformID = "OSF"
        Case PLATFORM_ID_VMS: GetPlatformID = "VMS"
        Case Else:
   End Select
End Function

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