我现在准备将一个VB应用(带form的)做成window service,要求用VB做,我在网上找到了些例子,但都没有成功,现在的现象是:服务能注册上,但在启动服务时报错,异常中断,下面是我写的代码,请看看哪里有问题(在执行StartService时报的错)。如果哪位大侠有现成可用的例子,请发送到,非常感谢!***basMain Module***
Private Const SERVICE_NAME As String = "ding test service555"Private hServiceStatus As Long
Private ServiceStatus As SERVICE_STATUSSub Main()    Dim hSCManager As Long
    Dim hService As Long
    Dim ServiceTableEntry As SERVICE_TABLE_ENTRY
    Dim B As Boolean
    Dim cmd As String
    Dim U As Long    ServiceTableEntry.lpServiceName = SERVICE_NAME
    ServiceTableEntry.lpServiceProc = FncPtr(AddressOf ServiceMain)
    
    B = StartServiceCtrlDispatcher(ServiceTableEntry)
    
End SubSub ServiceMain(ByVal dwArgc As Long, ByVal lpszArgv As Long)    Dim B As Boolean
    Dim U As Long
    Dim Z As Long
    
    hServiceStatus = RegisterServiceCtrlHandler(SERVICE_NAME, _
        AddressOf Handler)
    If (hServiceStatus = 0) Then
        Exit Sub
    End If
    
    
    ' Configuration Initiale
    ServiceStatus.dwServiceType = SERVICE_WIN32_OWN_PROCESS _
        Or SERVICE_INTERACTIVE_PROCESS
    
    ServiceStatus.dwCurrentState = SERVICE_START_PENDING
    ' Configuration des options accessibles depuis la bo?te de dialogue des services
    ' Les contr?les que vous ne décrivez pas ci-dessous apparaitront en grisé
    ServiceStatus.dwControlsAccepted = SERVICE_ACCEPT_STOP _
    Or SERVICE_ACCEPT_PAUSE_CONTINUE _
    Or SERVICE_ACCEPT_SHUTDOWN
    ServiceStatus.dwWin32ExitCode = 0
   ' ServiceStatus.dwServiceSpecificExitCode = 0
    ServiceStatus.dwCheckPoint = 0
    ServiceStatus.dwWaitHint = 0
    B = SetServiceStatus(hServiceStatus, ServiceStatus)
       
    Sleep 1000 * 10
    
    ServiceStatus.dwServiceType = SERVICE_WIN32_OWN_PROCESS _
    Or SERVICE_INTERACTIVE_PROCESS
    
    ServiceStatus.dwCurrentState = SERVICE_RUNNING
    ServiceStatus.dwControlsAccepted = SERVICE_ACCEPT_STOP _
    Or SERVICE_ACCEPT_PAUSE_CONTINUE _
    Or SERVICE_ACCEPT_SHUTDOWN
    ServiceStatus.dwWin32ExitCode = 0
   ' ServiceStatus.dwServiceSpecificExitCode = 0
    ServiceStatus.dwCheckPoint = 0
    ServiceStatus.dwWaitHint = 0
    
       
    B = SetServiceStatus(hServiceStatus, ServiceStatus)
    
    
End SubSub Handler(ByVal fdwControl As Long)    Dim B As Boolean
    Dim U As Long
    
    Select Case fdwControl
    
    
    Case SERVICE_CONTROL_PAUSE
        
        ' Ce produit lorsque l'option Pause est demandée
        ServiceStatus.dwCurrentState = SERVICE_PAUSED
    
    Case SERVICE_CONTROL_CONTINUE
    
        ' Ce produit lorsque l'option Start est demandée
        ServiceStatus.dwCurrentState = SERVICE_RUNNING
        
    Case SERVICE_CONTROL_STOP
    
        ' Ce produit lorsque l'option Stop est demandée
        ServiceStatus.dwWin32ExitCode = 0
        ServiceStatus.dwCurrentState = SERVICE_STOP_PENDING
        ServiceStatus.dwCheckPoint = 0
        ServiceStatus.dwWaitHint = 0 'Might want a time estimate
        B = SetServiceStatus(hServiceStatus, ServiceStatus)
        ServiceStatus.dwCurrentState = SERVICE_STOPPED
        
    
    Case SERVICE_CONTROL_INTERROGATE
        
        ' Passe ici pour envoyer l'état actuel du service
    
    Case Else
    
    End Select
    ' envoi l'état actuel
    B = SetServiceStatus(hServiceStatus, ServiceStatus)End SubFunction FncPtr(ByVal fnp As Long) As LongFncPtr = fnp
End Function***控制程序***Private hSCManager As Long
Private Const SERVICE_NAME As String = "ding test service555"Private hServiceStatus As Long
Private ServiceStatus As SERVICE_STATUS
Private Sub btnCreate_Click(Index As Integer)
    hSCManager = OpenSCManager(vbNullString, vbNullString, _
            SC_MANAGER_CREATE_SERVICE)
    If (hSCManager = 0) Then
        MsgBox "Open manager failed!"
        Exit Sub
    End If
    hService = CreateService(hSCManager, SERVICE_NAME, _
        SERVICE_NAME, SERVICE_ALL_ACCESS, _
        SERVICE_WIN32_OWN_PROCESS, _
        SERVICE_DEMAND_START, SERVICE_ERROR_NORMAL, _
        App.Path & "\" & "test4.exe", vbNullString, _
        vbNullString, vbNullString, vbNullString, _
        vbNullString)
    
    CloseServiceHandle hService
    
    CloseServiceHandle hSCManager
    MsgBox "Create service:" & SERVICE_NAME & " success!"
End SubPrivate Sub btnDelete_Click(Index As Integer)
    Dim bOK As Boolean
    
    hSCManager = OpenSCManager(vbNullString, vbNullString, _
            SC_MANAGER_CONNECT)
    If (hSCManager = 0) Then
        MsgBox "Open manager failed!"
        Exit Sub
    End If
    hService = OpenService(hSCManager, SERVICE_NAME, _
            SERVICE_ALL_ACCESS)
    If (hService = 0) Then
        MsgBox "Open service failed!"
        Exit Sub
    End If
    
    bOK = QueryServiceStatus(hService, ServiceStatus)
    If (ServiceStatus.dwCurrentState = SERVICE_RUNNING) Then
        bOK = ControlService(hService, SERVICE_CONTROL_STOP, ServiceStatus)
    End If
    
    DeleteService hService
            
    CloseServiceHandle hService
    
    CloseServiceHandle hSCManager
    MsgBox "Delete service:" & SERVICE_NAME & " success"
End SubPrivate Sub btnStart_Click(Index As Integer)
    Dim bOK As Boolean
    
    hSCManager = OpenSCManager(vbNullString, vbNullString, _
            SC_MANAGER_CONNECT)
    If (hSCManager <> 0) Then
        hService = OpenService(hSCManager, SERVICE_NAME, _
            SERVICE_START)
        If (hService <> 0) Then
            If (StartService(hService, 0, 0)) Then
               bOK = QueryServiceStatus(hService, ServiceStatus)
               Do While ServiceStatus.dwCurrentState = SERVICE_START_PENDING
                Sleep 1000 * 2
                bOK = QueryServiceStatus(hService, ServiceStatus)
               Loop
               
               
            Else
                MsgBox "Start service failed!"
            End If
        End If
    End If
    
    
    CloseServiceHandle hService
    
    CloseServiceHandle hSCManager
    MsgBox "start service:" & SERVICE_NAME & " success!"End SubPrivate Sub btnStop_Click(Index As Integer)
    Dim bOK As Boolean
    
    hSCManager = OpenSCManager(vbNullString, vbNullString, _
            SC_MANAGER_ALL_ACCESS)
    If (hSCManager = 0) Then
        MsgBox "Open manager failed!"
        Exit Sub
    End If
    hService = OpenService(hSCManager, SERVICE_NAME, _
            SERVICE_STOP Or SERVICE_QUERY_STATUS)
    If (hService = 0) Then
        MsgBox "Open service failed!"
        Exit Sub
    End If
    
    bOK = QueryServiceStatus(hService, ServiceStatus)
    If (ServiceStatus.dwCurrentState = SERVICE_RUNNING) Then
        bOK = ControlService(hService, SERVICE_CONTROL_STOP, ServiceStatus)
    End If
            
    CloseServiceHandle hService
    
    CloseServiceHandle hSCManager
    MsgBox "Stop service:" & SERVICE_NAME & " success!"
End SubPrivate Sub Form_Load()End Sub

解决方案 »

  1.   

    我没有用vb做过service程序,但是可以给你一下我的想法。
    把vb程序编译为可执行文件,然后用很方面做windows service的工具写个service,调用它。我现在常用的是C#,你如果不熟悉,可以用vb.net做个service,然后在service_onStart事件中调用vb的可执行程序。
      

  2.   

    yiway(一味) :   我按照你的方法做了:用C#做了一个Service,在OnStart()执行一个VB做到EXE,服务也可以启动,但是应用的窗口显示不出来,不知哪有问题。   可否把你的代码发给我,谢谢!
      

  3.   

    Windows服务编写原理及探讨(一) 
       
        要知道的是一个服务决不需要用户界面(所以应用窗口显示不出来)。大多数的服务将运行在那些被锁在某些黑暗的,冬暖夏凉的小屋子里的强大的服务器上面,即使有用户界面一般也没有人可以看到。如果服务提供任何用户界面如消息框,那么用户错过这些消息的可能性就极高了,所以服务程序通常以控制台程序的形式被编写,进入点函数是main()而不是WinMain()。http://www.frontfree.net/view/article_515_page1.html
      

  4.   

    用我C#做了个服务,也可以打开我的应用窗口了可是有个问题:
        用C#做的服务,需要有.net环境才能运行,要是在一个没装.net环境的机子上就无法启动了,我试过了,所以,还是不行。不知有何办法处理一下呢?   
      

  5.   

    要使用一個NTSVC.OCX的控件.
    我已發了一個例子到你的郵箱中.