form1.frm

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

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "本地与远程机上的服务"
   ClientHeight    =   6555
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   10485
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6555
   ScaleWidth      =   10485
   StartUpPosition =   2  '屏幕中心
   Begin VB.ListBox List1 
      Height          =   4020
      Left            =   360
      TabIndex        =   4
      Top             =   1080
      Width           =   9975
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   1320
      TabIndex        =   3
      Text            =   "Combo1"
      Top             =   360
      Width           =   1935
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Index           =   2
      Left            =   3360
      TabIndex        =   2
      Top             =   5520
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Index           =   1
      Left            =   2160
      TabIndex        =   1
      Top             =   5520
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Index           =   0
      Left            =   960
      TabIndex        =   0
      Top             =   5520
      Width           =   1215
   End
   Begin VB.Label Label8 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "机器"
      Height          =   180
      Left            =   360
      TabIndex        =   12
      Top             =   360
      Width           =   360
   End
   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "枚举类型"
      Height          =   180
      Left            =   120
      TabIndex        =   11
      Top             =   5640
      Width           =   720
   End
   Begin VB.Label Label6 
      BackStyle       =   0  'Transparent
      Caption         =   "名称"
      Height          =   255
      Left            =   480
      TabIndex        =   10
      Top             =   840
      Width           =   735
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "接收控制"
      Height          =   180
      Left            =   8400
      TabIndex        =   9
      Top             =   840
      Width           =   720
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "服务类型"
      Height          =   180
      Left            =   6360
      TabIndex        =   8
      Top             =   840
      Width           =   720
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "状态"
      Height          =   180
      Left            =   5280
      TabIndex        =   7
      Top             =   840
      Width           =   360
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Label2"
      Height          =   180
      Left            =   3720
      TabIndex        =   6
      Top             =   840
      Width           =   540
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Label1"
      Height          =   180
      Left            =   960
      TabIndex        =   5
      Top             =   6240
      Width           =   7020
   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 lastIndex As Long

Private Sub Combo1_Click()
    If Combo1.ListIndex > -1 Then
      Command1(lastIndex).Value = True
   End If
End Sub

Private Sub Command1_Click(Index As Integer)
    Dim sMachine As String
   If Combo1.ListIndex > -1 Then
      sMachine = Combo1.List(Combo1.ListIndex)
      Select Case Index
         Case 0:
           '正运行的服务
            EnumSystemServices SERVICE_ACTIVE, sMachine, List1
         Case 1:
           '停止的服务
            EnumSystemServices SERVICE_INACTIVE, sMachine, List1
         Case 2:
           '所有的服务
            EnumSystemServices SERVICE_STATE_ALL, sMachine, List1
      End Select
      lastIndex = Index
   End If
End Sub

Private Sub Form_Load()
    ReDim TabArray(0 To 4) As Long
   TabArray(0) = 150
   TabArray(1) = 220
   TabArray(2) = 270
   TabArray(3) = 342
   TabArray(4) = 390
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 5&, TabArray(0))
   List1.Refresh
   Command1(0).Caption = "存活的服务"
   Command1(1).Caption = "停止的服务"
   Command1(2).Caption = "所有的服务"
  '如果添加到列表中的机器比较多，最好
  '将下面这条语句移动到按钮事件处理程序中，
  '这样，可以加快表单的装载速度
   Call GetServers(vbNullString)
End Sub

Private Function EnumSystemServices(SERVICE_TYPE As Long, _
                                   sMachine As String, _
                                   ctl As Control) As Long
   Dim hSCManager As Long
   Dim pntr() As ENUM_SERVICE_STATUS
   Dim cbBuffSize As Long
   Dim cbRequired As Long
   Dim dwReturned As Long
   Dim hEnumResume As Long
   Dim cbBuffer As Long
   Dim success As Long
   Dim i As Long
   Dim sSvcName As String
   Dim sDispName As String
   Dim dwState As Long
   Dim dwType As Long
   Dim dwCtrls As Long
  '更改Label1的标题，显示正进行的操作
   Label1.Caption = "浏览" & sMachine & "上的" & Command1(SERVICE_TYPE - 1).Caption
  '建立与本地计算机的服务控制管理器的连接，
  '并打开本地服务控制管理器数据库。
   hSCManager = OpenSCManager("\\" & sMachine, _
                              vbNullString, _
                              SC_MANAGER_ENUMERATE_SERVICE)
   If hSCManager <> 0 Then
      '调用EnumServicesStatus获取缓存的大小
     '在调用EnumServicesStatus时，将参数cbBuffer和hEnumResume设置为0，
     '可获取存放结构数组所需的缓存的大小。该值将由参数cbRequired带回。
     '此时，EnumServicesStatus调用失败(返回0)，
     '且Err.LastDLLError的值为ERROR_MORE_DATA。
      success = EnumServicesStatus(hSCManager, _
                                   SERVICE_WIN32, _
                                   SERVICE_TYPE, _
                                   ByVal &H0, _
                                   &H0, _
                                   cbRequired, _
                                   dwReturned, _
                                   hEnumResume)
     '如success为0，且LastDllError值为ERROR_MORE_DATA，
     '则可使用返回信息创建所需的缓存
      If success = 0 And Err.LastDllError = ERROR_MORE_DATA Then
         '计算结构的数量，并重定义结构数组
         cbBuffer = (cbRequired \ SIZEOF_SERVICE_STATUS) + 1
         ReDim pntr(0 To cbBuffer)
        '设置cbBuffSize为缓存的大小
         cbBuffSize = cbBuffer * SIZEOF_SERVICE_STATUS
        '枚举服务。如古成功，则返回非0值，否则返回0。
        'hEnumResume必须比设置为0。
         hEnumResume = 0
         If EnumServicesStatus(hSCManager, _
                               SERVICE_WIN32, _
                               SERVICE_TYPE, _
                               pntr(0), _
                               cbBuffSize, _
                               cbRequired, _
                               dwReturned, _
                               hEnumResume) Then
           '从pntr()数组中提取所需的信息
            With ctl
               .Clear
               For i = 0 To dwReturned - 1
                  sDispName = GetStrFromPtrA(ByVal pntr(i).lpDisplayName)
                  sSvcName = GetStrFromPtrA(ByVal pntr(i).lpServiceName)
                  dwState = pntr(i).ServiceStatus.dwCurrentState
                  dwType = pntr(i).ServiceStatus.dwServiceType
                  dwCtrls = pntr(i).ServiceStatus.dwControlsAccepted
                  .AddItem sDispName & vbTab & _
                           sSvcName & vbTab & _
                           GetServiceState(dwState) & vbTab & _
                           GetServiceType(dwType) & vbTab & _
                           GetServiceControl(dwCtrls)
               Next
            End With
         Else: MsgBox "EnumServicesStatus; error " & CStr(Err.LastDllError)
         End If  'If EnumServicesStatus
      Else: MsgBox "ERROR_MORE_DATA not returned; error " & CStr(Err.LastDllError)
      End If  'If success = 0 And Err.LastDllError
   Else: MsgBox "OpenSCManager failed; error = " & CStr(Err.LastDllError)
   End If  'If hSCManager <> 0
  '关闭SCM数据库句柄
   Call CloseServiceHandle(hSCManager)
  '返回服务的数量
   EnumSystemServices = dwReturned
End Function

Private Function GetServers(sDomain As String) As Long
  '列举域中可见的指定类型的服务器
   Dim bufptr          As Long
   Dim dwEntriesread   As Long
   Dim dwTotalentries  As Long
   Dim dwResumehandle  As Long
   Dim se100           As SERVER_INFO_100
   Dim success         As Long
   Dim nStructSize     As Long
   Dim cnt             As Long
   nStructSize = LenB(se100)
  '使用MAX_PREFERRED_LENGTH，以让函数为返回的数据分配足够的空间
  '调用函数列举网络中的所有机器(SV_TYPE_ALL)，
  '可以通过组合掩码位来列举几种类型的服务器。
  '例如，0X00000003就是SV_TYPE_WORKSTATION（0X00000001）
  '和SV_TYPE_SERVER（0X00000002）的组合。
  '参数dwServerName必须为Null. 参数level的值(这里为100)
  '指定了函数使用的数据结构(此为SERVER_INFO_100)
  '成员domain的值为Null，以返回域中的所有的机器。
   success = NetServerEnum(0&, _
                           100, _
                           bufptr, _
                           MAX_PREFERRED_LENGTH, _
                           dwEntriesread, _
                           dwTotalentries, _
                           SV_TYPE_WORKSTATION Or SV_TYPE_SERVER, _
                           0&, _
                           dwResumehandle)
   If success = NERR_SUCCESS And _
      success <> ERROR_MORE_DATA Then
    '提取返回的数据，并添加到列表中
      For cnt = 0 To dwEntriesread - 1
        '获取数据，并将其转换为LOCALGROUP_INFO_1结构类型
         CopyMemory se100, ByVal bufptr + (nStructSize * cnt), nStructSize
         Combo1.AddItem GetPointerToByteStringW(se100.sv100_name)
      Next
   End If
  '释放bufptr
   Call NetApiBufferFree(bufptr)
End Function


Private Function GetStrFromPtrA(ByVal lpszA As Long) As String
   GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
   Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function


Private Function GetServiceControl(dwControl As Long) As String
   Dim tmp As String
   If dwControl Then
      If (dwControl And SERVICE_ACCEPT_STOP) Then tmp = tmp & "停止, "
      If (dwControl And SERVICE_ACCEPT_PAUSE_CONTINUE) Then tmp = tmp & "暂停, "
      If (dwControl And SERVICE_ACCEPT_SHUTDOWN) Then tmp = tmp & "关闭"
   End If
   GetServiceControl = tmp
End Function


Private Function GetServiceType(dwType As Long) As String
   Dim sType As String
   If (dwType And SERVICE_WIN32_OWN_PROCESS) Then sType = sType & "本的进程, "
   If (dwType And SERVICE_WIN32_SHARE_PROCESS) Then sType = sType & "共享进程, "
   If (dwType And SERVICE_KERNEL_DRIVER) Then sType = sType & "核心驱动器, "
   If (dwType And SERVICE_FILE_SYSTEM_DRIVER) Then sType = sType & "文件系统, "
   If (dwType And SERVICE_INTERACTIVE_PROCESS) Then sType = sType & "交互进程"
   GetServiceType = sType
End Function


Private Function GetServiceState(dwState As Long) As String
   Select Case dwState
      Case SERVICE_STOPPED: GetServiceState = "停止"
      Case SERVICE_START_PENDING: GetServiceState = "启动期间"
      Case SERVICE_STOP_PENDING: GetServiceState = "停止期间"
      Case SERVICE_RUNNING: GetServiceState = "正运行"
      Case SERVICE_CONTINUE_PENDING: GetServiceState = "继续期间"
      Case SERVICE_PAUSE_PENDING: GetServiceState = "暂停期间"
      Case SERVICE_PAUSED: GetServiceState = "已停止"
   End Select
End Function