form1.frm

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

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H80000001&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "枚举服务器的会话"
   ClientHeight    =   4005
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7485
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4005
   ScaleWidth      =   7485
   StartUpPosition =   2  '屏幕中心
   Begin VB.ListBox List1 
      Height          =   2760
      Left            =   240
      TabIndex        =   1
      Top             =   480
      Width           =   6975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "运行(&R)"
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Top             =   3480
      Width           =   1095
   End
   Begin VB.Label Label8 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "供应商"
      ForeColor       =   &H00FFFFFF&
      Height          =   180
      Left            =   5640
      TabIndex        =   9
      Top             =   240
      Width           =   540
   End
   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "打开资源"
      ForeColor       =   &H00FFFFFF&
      Height          =   180
      Left            =   4560
      TabIndex        =   8
      Top             =   240
      Width           =   720
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "空闲"
      ForeColor       =   &H00FFFFFF&
      Height          =   180
      Left            =   3840
      TabIndex        =   7
      Top             =   240
      Width           =   360
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "存活"
      ForeColor       =   &H00FFFFFF&
      Height          =   180
      Left            =   3240
      TabIndex        =   6
      Top             =   240
      Width           =   360
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "计算机名"
      ForeColor       =   &H00FFFFFF&
      Height          =   180
      Left            =   1440
      TabIndex        =   5
      Top             =   240
      Width           =   720
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "用户名"
      ForeColor       =   &H00FFFFFF&
      Height          =   180
      Left            =   240
      TabIndex        =   4
      Top             =   240
      Width           =   540
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "Label2"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   5760
      TabIndex        =   3
      Top             =   3600
      Width           =   615
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "Label1"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   1680
      TabIndex        =   2
      Top             =   3600
      Width           =   3855
   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 Command1_Click()
    Dim bufptr          As Long  '输出
   Dim dwServer        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 usrname         As String
   Dim bServer         As String
   Dim si502           As SESSION_INFO_502
   bServer = "\\" & Environ$("COMPUTERNAME") & vbNullString
   dwServer = StrPtr(bServer)
   success = NetSessionEnum(dwServer, _
                            0&, _
                            0&, _
                            502, _
                            bufptr, _
                            MAX_PREFERRED_LENGTH, _
                            dwEntriesread, _
                            dwTotalentries, _
                            dwResumehandle)
   List1.Clear
   Label2.Caption = success
   If success = NERR_SUCCESS And _
      success <> ERROR_MORE_DATA Then
      nStructSize = LenB(si502)
      For cnt = 0 To dwEntriesread - 1
        '将数据转换为SESSION_INFO_502 type类型，并将其添加到列表中
         CopyMemory si502, ByVal bufptr + (nStructSize * cnt), nStructSize
       'sesi502_cname      : 建立会话的计算机名
       'sesi502_username   : 建立会话的用户名
       'sesi502_num_open   : 会话阿期间打开的文件、设备和管道的数量
       'sesi502_time       : 会话存活的时间，以秒为单位
       'sesi502_idle_time  : 会话空闲的时间，以秒为单位
       'sesi502_user_flags : 建立会话的方式
       'sesi502_cltype_name: 建立会话的客户类型
       'sesi502_transport  : 客户与服务器端通信的传输端口名
        usrname = GetPointerToByteStringW(si502.sesi502_username)
        If Len(usrname) > 0 Then
           '由于sesi502_time和sesi502_idle_time返回的时间值是以秒为单位的，
           '所以这里除以60，将其转换为分。
            List1.AddItem usrname & vbTab & _
                          GetPointerToByteStringW(si502.sesi502_cname) & vbTab & _
                          si502.sesi502_time \ 60 & vbTab & _
                          si502.sesi502_idle_time \ 60 & vbTab & _
                          si502.sesi502_num_open & vbTab & _
                          GetPointerToByteStringW(si502.sesi502_cltype_name)
        End If
      Next
   End If
   Call NetApiBufferFree(bufptr)
End Sub

Private Sub Form_Load()
    ReDim TabArray(0 To 5) As Long
   TabArray(0) = 58
   TabArray(1) = 140
   TabArray(2) = 171
   TabArray(3) = 198
   TabArray(4) = 229
   TabArray(5) = 468
  '设置列表框的制表位置
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 6&, TabArray(0))
   List1.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

Private Function GetSessionUserType(ByVal dwSessionType As Long) As String
   Select Case dwSessionType
      Case SESS_GUEST:        GetSessionUserType = "guest"
      Case SESS_NOENCRYPTION: GetSessionUserType = "no encryption"
      Case Else:              GetSessionUserType = ""
    End Select
End Function