我将电脑信使功能启用后,有时候莫名奇妙发送信息失败,经检查信使服务关闭,所以我想有没有办法用VB定时检测信使服务的开启和关闭状态,如果开启不做任何动作,如果关闭则开启该功能。而不是等信息发送失败了才去手动开启功能。机子本身没有任何问题。

解决方案 »

  1.   

    这是用 API-Guide 的例子改的,你自己改成按名称匹配
    Option ExplicitConst ERROR_MORE_DATA = 234
    Const SERVICE_ACTIVE = &H1
    Const SERVICE_INACTIVE = &H2
    Const SC_MANAGER_ENUMERATE_SERVICE = &H4
    Const SERVICE_WIN32_OWN_PROCESS As Long = &H10
    Const SERVICE_WIN32_SHARE_PROCESS As Long = &H20
    Const SERVICE_WIN32 As Long = SERVICE_WIN32_OWN_PROCESS + SERVICE_WIN32_SHARE_PROCESS'SERVICE_STATUS.dwCurrentState
    Private Const SERVICE_CONTINUE_PENDING As Long = &H5
    Private Const SERVICE_PAUSE_PENDING As Long = &H6
    Private Const SERVICE_PAUSED As Long = &H7
    Private Const SERVICE_RUNNING As Long = &H4
    Private Const SERVICE_START_PENDING As Long = &H2
    Private Const SERVICE_STOP_PENDING As Long = &H3
    Private Const SERVICE_STOPPED As Long = &H1
    Private Type SERVICE_STATUS
        dwServiceType As Long
        dwCurrentState As Long
        dwControlsAccepted As Long
        dwWin32ExitCode As Long
        dwServiceSpecificExitCode As Long
        dwCheckPoint As Long
        dwWaitHint As Long
    End Type
    Private Type ENUM_SERVICE_STATUS
        lpServiceName As Long
        lpDisplayName As Long
        ServiceStatus As SERVICE_STATUS
    End Type
    Private Declare Function OpenSCManager Lib "advapi32.dll" Alias "OpenSCManagerA" (ByVal lpMachineName As String, ByVal lpDatabaseName As String, ByVal dwDesiredAccess As Long) As Long
    Private Declare Function EnumServicesStatus Lib "advapi32.dll" Alias "EnumServicesStatusA" (ByVal hSCManager As Long, ByVal dwServiceType As Long, ByVal dwServiceState As Long, lpServices As Any, ByVal cbBufSize As Long, pcbBytesNeeded As Long, lpServicesReturned As Long, lpResumeHandle As Long) As Long
    Private Declare Function CloseServiceHandle Lib "advapi32.dll" (ByVal hSCObject As Long) As Long
    Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (szDest As String, szcSource As Long) As Long
    Private Sub Form_Load()
        'KPD-Team 2000
        'URL: http://www.allapi.net/
        'E-Mail: [email protected]
        Dim hSCM As Long, lpEnumServiceStatus() As ENUM_SERVICE_STATUS, lngServiceStatusInfoBuffer As Long
        Dim strServiceName As String * 250, lngBytesNeeded As Long, lngServicesReturned As Long
        Dim hNextUnreadEntry As Long, lngStructsNeeded As Long, lngResult As Long, i As Long
        'Open connection to Service Control Manager.
        hSCM = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_ENUMERATE_SERVICE)
        If hSCM = 0 Then
            MsgBox "OpenSCManager failed. LastDllError = " & CStr(Err.LastDllError)
            Exit Sub
        End If
        'Get buffer size (bytes) without passing a buffer
        'and make sure starts at 0th entry.
        hNextUnreadEntry = 0
        lngResult = EnumServicesStatus(hSCM, SERVICE_WIN32, SERVICE_ACTIVE Or SERVICE_INACTIVE, ByVal &H0, &H0, lngBytesNeeded, lngServicesReturned, hNextUnreadEntry)
        'We should receive MORE_DATA error.
        If Not Err.LastDllError = ERROR_MORE_DATA Then
            MsgBox "LastDLLError = " & CStr(Err.LastDllError)
            Exit Sub
        End If
        'Calculate the number of structures needed.
        lngStructsNeeded = lngBytesNeeded / Len(lpEnumServiceStatus(0)) + 1
        'Redimension the array according to our calculation.
        ReDim lpEnumServiceStatus(lngStructsNeeded - 1)
        'Get buffer size in bytes.
        lngServiceStatusInfoBuffer = lngStructsNeeded * Len(lpEnumServiceStatus(0))
        'Get services information starting entry 0.
        hNextUnreadEntry = 0
        lngResult = EnumServicesStatus(hSCM, SERVICE_WIN32, SERVICE_ACTIVE Or SERVICE_INACTIVE, lpEnumServiceStatus(0), lngServiceStatusInfoBuffer, lngBytesNeeded, lngServicesReturned, hNextUnreadEntry)
        If lngResult = 0 Then
            MsgBox "EnumServicesStatus failed. LastDllError = " & CStr(Err.LastDllError)
            Exit Sub
        End If
        'Get the strings and display them.
        Me.AutoRedraw = True
        Me.Print "All registered services:" + vbCrLf
        For i = 0 To lngServicesReturned - 1
            Me.Print (lpEnumServiceStatus(i).ServiceStatus.dwCurrentState = SERVICE_RUNNING), ;
            lngResult = lstrcpy(ByVal strServiceName, ByVal lpEnumServiceStatus(i).lpServiceName)
            Me.Print StripTerminator(strServiceName), " - ";
            lngResult = lstrcpy(ByVal strServiceName, ByVal lpEnumServiceStatus(i).lpDisplayName)
            Me.Print StripTerminator(strServiceName)
        Next i
        'Clean up.
        CloseServiceHandle (hSCM)
    End SubFunction StripTerminator(sInput As String) As String
        Dim ZeroPos As Integer
        ZeroPos = InStr(1, sInput, Chr$(0))
        If ZeroPos > 0 Then
            StripTerminator = Left$(sInput, ZeroPos - 1)
        Else
            StripTerminator = sInput
        End If
    End Function
      

  2.   

    设置自动启动 shell "sc.exe config Messenger start= auto" 
    查询启动设置 shell "sc.exe qc Messenger" 在BAIDU上发帖回复如上,运行xp可以,win2000报错,大家一起讨论一下。
      

  3.   

    不知道上面Tiger_Zhao 提供的程序2000下可不可以?明天公司试一下
      

  4.   

    只要不是被禁用,可以用下面的方法启动/关闭(Win2000 下用 Command.exe 代替 Cmd.exe)
    shell "cmd.exe /c net start Messenger"
    shell "cmd.exe /c net stop Messenger"
    其实不用判断,直接调用 net start,如果已启动会很快返回。
      

  5.   

    to Tiger_Zhao:请问xp、2000直接调用net start怎么操作?开启或关闭