form1.frm

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

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "获取网络用户全名"
   ClientHeight    =   4215
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4380
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4215
   ScaleWidth      =   4380
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton mdDetail 
      Caption         =   "详细信息(&D)"
      Default         =   -1  'True
      Height          =   495
      Left            =   1440
      TabIndex        =   12
      Top             =   3360
      Width           =   1215
   End
   Begin VB.TextBox TxtUserComment 
      Height          =   375
      Left            =   1440
      TabIndex        =   11
      Text            =   "TxtUserComment"
      Top             =   2760
      Width           =   2055
   End
   Begin VB.TextBox TxtComment 
      Height          =   375
      Left            =   1440
      TabIndex        =   10
      Text            =   "TxtComment"
      Top             =   2280
      Width           =   2055
   End
   Begin VB.TextBox TxtUserFullName 
      Height          =   375
      Left            =   1440
      TabIndex        =   9
      Text            =   "TxtUserFullName"
      Top             =   1800
      Width           =   2055
   End
   Begin VB.TextBox TxtUserName 
      Height          =   375
      Left            =   1440
      TabIndex        =   8
      Text            =   "TxtUserName"
      Top             =   1320
      Width           =   2055
   End
   Begin VB.TextBox TxtComputerName 
      Height          =   375
      Left            =   1440
      TabIndex        =   7
      Text            =   "TxtComputerName"
      Top             =   600
      Width           =   2055
   End
   Begin VB.TextBox TxtGetUserName 
      Height          =   375
      Left            =   1440
      TabIndex        =   6
      Text            =   "TxtGetUserName"
      Top             =   120
      Width           =   2055
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "用户名"
      Height          =   180
      Left            =   360
      TabIndex        =   5
      Top             =   1440
      Width           =   540
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "用户全名"
      Height          =   180
      Left            =   360
      TabIndex        =   4
      Top             =   1920
      Width           =   720
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "说明"
      Height          =   180
      Left            =   360
      TabIndex        =   3
      Top             =   2400
      Width           =   360
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "用户说明"
      Height          =   180
      Left            =   360
      TabIndex        =   2
      Top             =   2880
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "获取用户名"
      Height          =   180
      Left            =   360
      TabIndex        =   1
      Top             =   240
      Width           =   900
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "获取机器名"
      Height          =   180
      Left            =   360
      TabIndex        =   0
      Top             =   720
      Width           =   900
   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 Type USER_INFO
    name          As String
    fullname     As String
    comment       As String
    usrcomment   As String
End Type

Private Function zyGetComputerName() As String
'返回计算机名称
    Dim tmp As String
    tmp = Space$(MAX_COMPUTERNAME + 1)
    If GetComputerName(tmp, Len(tmp)) <> 0 Then
    zyGetComputerName = 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 zyGetUserName() As String
'返回用户名
    Dim tmp As String
    tmp = Space$(MAX_USERNAME)
    If GetUserName(tmp, Len(tmp)) Then
        zyGetUserName = TrimNull(tmp)
    End If
End Function

Private Sub Form_Load()
    TxtGetUserName = zyGetUserName()
    TxtComputerName = zyGetComputerName()
End Sub

Private Sub mdDetail_Click()
    Dim usr As USER_INFO
    Dim bUsername() As Byte
    Dim bServername() As Byte
    Dim tmp As String
    '这里假定服务器和用户参数中都包含有数据
    If Len(TxtGetUserName) > 0 And Len(TxtComputerName) > 0 Then
        bUsername = TxtGetUserName.Text & Chr$(0)
        '本例程使用当前机器作为服务器
        '它工作在NT4或Win2000上。
        '如果是已经连接上了一个PDC或BDC，
        '则以它们的名称作为服务器名称。
        '代替这里的函数zyGetUserName返回的值
        tmp = TxtComputerName.Text
        '确保服务器名有正确的格式
        If Len(tmp) Then
            If InStr(tmp, "\\") Then
                bServername = tmp & Chr$(0)
                Else: bServername = "\\" & tmp & Chr$(0)
            End If
        End If
        '根据传递的用户名，返回用户信息。
        '返回值将直接被赋给我们定义的
        '非API USER_INFO数据类型（简称为UDTs）。
        usr = GetUserNetworkInfo(bServername(), bUsername())
        TxtUserName = usr.name
        '该函数能否返回用户全名
        '说明文字或用户说明，
        '取决于用户管理器中的用户列表
        TxtUserFullName = usr.fullname
        TxtComment = usr.comment
        TxtUserComment = usr.usrcomment
    End If
End Sub

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
        '将缓存中的数据复制到API user_INFO_10结构中
        CopyMemory usrapi, ByVal buff, Len(usrapi)
        '选取结构中的每个成员，将其放入UDT的相应成员中返回。
        GetUserNetworkInfo.name = GetPointerToByteStringW(usrapi.usr10_name)
        GetUserNetworkInfo.fullname = GetPointerToByteStringW(usrapi.usr10_full_name)
        GetUserNetworkInfo.comment = GetPointerToByteStringW(usrapi.usr10_comment)
        GetUserNetworkInfo.usrcomment = 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