我现在准备将一个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
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
把vb程序编译为可执行文件,然后用很方面做windows service的工具写个service,调用它。我现在常用的是C#,你如果不熟悉,可以用vb.net做个service,然后在service_onStart事件中调用vb的可执行程序。
要知道的是一个服务决不需要用户界面(所以应用窗口显示不出来)。大多数的服务将运行在那些被锁在某些黑暗的,冬暖夏凉的小屋子里的强大的服务器上面,即使有用户界面一般也没有人可以看到。如果服务提供任何用户界面如消息框,那么用户错过这些消息的可能性就极高了,所以服务程序通常以控制台程序的形式被编写,进入点函数是main()而不是WinMain()。http://www.frontfree.net/view/article_515_page1.html
用C#做的服务,需要有.net环境才能运行,要是在一个没装.net环境的机子上就无法启动了,我试过了,所以,还是不行。不知有何办法处理一下呢?
我已發了一個例子到你的郵箱中.