form1.frm

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

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "枚举本机的服务"
   ClientHeight    =   6240
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   12945
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6240
   ScaleWidth      =   12945
   StartUpPosition =   2  '屏幕中心
   Begin VB.ListBox List1 
      Height          =   4560
      Left            =   240
      TabIndex        =   3
      Top             =   600
      Width           =   12375
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Command3"
      Height          =   495
      Left            =   5880
      TabIndex        =   2
      Top             =   5520
      Width           =   1215
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   495
      Left            =   4680
      TabIndex        =   1
      Top             =   5520
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   3480
      TabIndex        =   0
      Top             =   5520
      Width           =   1215
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "接收控制"
      Height          =   180
      Left            =   10680
      TabIndex        =   9
      Top             =   360
      Width           =   720
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "服务类型"
      Height          =   180
      Left            =   9000
      TabIndex        =   8
      Top             =   360
      Width           =   720
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "状态"
      Height          =   180
      Left            =   6840
      TabIndex        =   7
      Top             =   360
      Width           =   360
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "服务名称"
      Height          =   180
      Left            =   5160
      TabIndex        =   6
      Top             =   360
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "显示名称"
      Height          =   180
      Left            =   240
      TabIndex        =   5
      Top             =   360
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "枚举类型"
      Height          =   180
      Left            =   2520
      TabIndex        =   4
      Top             =   5640
      Width           =   720
   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()
    '正运行的服务
   EnumSystemServices SERVICE_ACTIVE, List1
End Sub

Private Sub Command2_Click()
    '未运行的服务
   EnumSystemServices SERVICE_INACTIVE, List1
End Sub

Private Sub Command3_Click()
    '所有的服务
   EnumSystemServices SERVICE_STATE_ALL, List1
End Sub

Private Sub Form_Load()
     ReDim TabArray(0 To 4) As Long
   
   TabArray(0) = 220
   TabArray(1) = 290
   TabArray(2) = 380
   TabArray(3) = 390
   TabArray(4) = 460
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 5&, TabArray(0))
   List1.Refresh
   Command1.Caption = "正运行的服务"
   Command2.Caption = "未运行的服务"
   Command3.Caption = "所有服务"
End Sub

'枚举本机的服务
Private Function EnumSystemServices(SERVICE_TYPE As Long, _
                                   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
  '建立与本地计算机的服务控制管理器的连接，
  '并打开本地服务控制管理器数据库。
   hSCManager = OpenSCManager(vbNullString, _
                              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 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 tmp As String
   If (dwType And SERVICE_WIN32_OWN_PROCESS) Then tmp = tmp & "本进程, "
   If (dwType And SERVICE_WIN32_SHARE_PROCESS) Then tmp = tmp & "共享, "
   If (dwType And SERVICE_KERNEL_DRIVER) Then tmp = tmp & "内核, "
   If (dwType And SERVICE_FILE_SYSTEM_DRIVER) Then tmp = tmp & "文件系统, "
   If (dwType And SERVICE_INTERACTIVE_PROCESS) Then tmp = tmp & "依存关系"
   GetServiceType = tmp
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