Bonjour,
je suis sous 2000 et VB6.
J'ai récupérer le code ci-dessous pour faire un service NT.
L'isntallation et la désinstallation fonctionne, par contre son exécution - même depuis l'éditeur Ms de service - plante ainsi :
Pendant la fenêtre "Windows essaie de démarrer le service..."
j'ai la fenêtre "MMC
Impossible de démarrer le service sur Ordinateur local.
Erreur 1067 : le processus s'est arrêté inopinément."
Puis la fenêtre "Erruer du programme
<le processus s'est déjà terminé> a généré des erreurs et sera fermé par Windows.
"
Dans le journal des erreurs, j'ai :
"Le service Monservice s'est terminé de manière inattendue. Ceci s'est produit 1 fois. L'action corrective suivante va être effectuée dans 0 millisecondes : Aucune action.
"
Quesqu'un peut'il m'aider ?
Grand merci par avance.
Zephyrin
*****************
Option Explicit
Private Const SERVICE_WIN32_OWN_PROCESS = &H10&
Private Const SERVICE_WIN32_SHARE_PROCESS = &H20&
Private Const SERVICE_WIN32 = SERVICE_WIN32_OWN_PROCESS + _
SERVICE_WIN32_SHARE_PROCESS
Private Const SERVICE_ACCEPT_STOP = &H1
Private Const SERVICE_ACCEPT_PAUSE_CONTINUE = &H2
Private Const SERVICE_ACCEPT_SHUTDOWN = &H4
Private Const SC_MANAGER_CONNECT = &H1
Private Const SC_MANAGER_CREATE_SERVICE = &H2
Private Const SC_MANAGER_ENUMERATE_SERVICE = &H4
Private Const SC_MANAGER_LOCK = &H8
Private Const SC_MANAGER_QUERY_LOCK_STATUS = &H10
Private Const SC_MANAGER_MODIFY_BOOT_CONFIG = &H20
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SERVICE_QUERY_CONFIG = &H1
Private Const SERVICE_CHANGE_CONFIG = &H2
Private Const SERVICE_QUERY_STATUS = &H4
Private Const SERVICE_ENUMERATE_DEPENDENTS = &H8
Private Const SERVICE_START = &H10
Private Const SERVICE_STOP = &H20
Private Const SERVICE_PAUSE_CONTINUE = &H40
Private Const SERVICE_INTERROGATE = &H80
Private Const SERVICE_USER_DEFINED_CONTROL = &H100
Private Const SERVICE_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
SERVICE_QUERY_CONFIG Or _
SERVICE_CHANGE_CONFIG Or _
SERVICE_QUERY_STATUS Or _
SERVICE_ENUMERATE_DEPENDENTS Or _
SERVICE_START Or _
SERVICE_STOP Or _
SERVICE_INTERROGATE Or _
SERVICE_USER_DEFINED_CONTROL)
Private Const SERVICE_DEMAND_START As Long = &H3
Private Const SERVICE_ERROR_NORMAL As Long = &H1
Private Enum SERVICE_CONTROL
SERVICE_CONTROL_STOP = &H1
SERVICE_CONTROL_PAUSE = &H2
SERVICE_CONTROL_CONTINUE = &H3
SERVICE_CONTROL_INTERROGATE = &H4
SERVICE_CONTROL_SHUTDOWN = &H5
End Enum
Private Enum SERVICE_STATE
SERVICE_STOPPED = &H1
SERVICE_START_PENDING = &H2
SERVICE_STOP_PENDING = &H3
SERVICE_RUNNING = &H4
SERVICE_CONTINUE_PENDING = &H5
SERVICE_PAUSE_PENDING = &H6
SERVICE_PAUSED = &H7
End Enum
Private Type SERVICE_TABLE_ENTRY
lpServiceName As String
lpServiceProc As Long
lpServiceNameNull As Long
lpServiceProcNull As Long
End Type
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 Declare Function StartServiceCtrlDispatcher _
Lib "ADVAPI32.DLL" Alias "StartServiceCtrlDispatcherA" _
(lpServiceStartTable As SERVICE_TABLE_ENTRY) As Long
Private Declare Function RegisterServiceCtrlHandler _
Lib "ADVAPI32.DLL" Alias "RegisterServiceCtrlHandlerA" _
(ByVal lpServiceName As String, ByVal lpHandlerProc As Long) _
As Long
Private Declare Function SetServiceStatus _
Lib "ADVAPI32.DLL" (ByVal hServiceStatus As Long, _
lpServiceStatus As SERVICE_STATUS) As Long
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 CreateService _
Lib "ADVAPI32.DLL" Alias "CreateServiceA" _
(ByVal hSCManager As Long, ByVal lpServiceName As String, _
ByVal lpDisplayName As String, ByVal dwDesiredAccess As Long, _
ByVal dwServiceType As Long, ByVal dwStartType As Long, _
ByVal dwErrorControl As Long, ByVal lpBinaryPathName As String, _
ByVal lpLoadOrderGroup As String, ByVal lpdwTagId As String, _
ByVal lpDependencies As String, ByVal lp As String, _
ByVal lpPassword As String) As Long
Private Declare Function DeleteService _
Lib "ADVAPI32.DLL" (ByVal hService As Long) As Long
Declare Function CloseServiceHandle _
Lib "ADVAPI32.DLL" (ByVal hSCObject As Long) As Long
Declare Function OpenService _
Lib "ADVAPI32.DLL" Alias "OpenServiceA" _
(ByVal hSCManager As Long, ByVal lpServiceName As String, _
ByVal dwDesiredAccess As Long) As Long
' Indiquez ici le nom du service, c'est lui qui apparait dans la boite de dialogue des services
Private Const SERVICE_NAME As String = "MonService"
Private hServiceStatus As Long
Private ServiceStatus As SERVICE_STATUS
Private piFichierDebug As Integer
' Installation du service
' MonService.exe install
' Désinstallation du service
' MonService.exe uninstall
' Après avoir installé le service, vous pouvez le configurer :
' Panneau de configuration, Services, Cliquez sur votre service, puis démarrage
Sub 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
On Error Resume Next
cmd = Trim(LCase(Command()))
Select Case cmd
Case "install"
' Installe le Service
hSCManager = OpenSCManager(vbNullString, vbNullString, _
SC_MANAGER_CREATE_SERVICE)
hService = CreateService(hSCManager, SERVICE_NAME, _
SERVICE_NAME, SERVICE_ALL_ACCESS, _
SERVICE_WIN32_OWN_PROCESS, _
SERVICE_DEMAND_START, SERVICE_ERROR_NORMAL, _
App.Path & "\" & App.EXEName, vbNullString, _
vbNullString, vbNullString, vbNullString, _
vbNullString)
CloseServiceHandle hService
CloseServiceHandle hSCManager
Case "uninstall"
' Désinstalle le Service
hSCManager = OpenSCManager(vbNullString, vbNullString, _
SC_MANAGER_CREATE_SERVICE)
hService = OpenService(hSCManager, SERVICE_NAME, _
SERVICE_ALL_ACCESS)
DeleteService hService
CloseServiceHandle hService
CloseServiceHandle hSCManager
Case Else
piFichierDebug = FreeFile
Open "D:\DEV\Kezen\KezenSrv\Debug.log" For Append Shared As #piFichierDebug
Print #piFichierDebug, "*************** DEBUT ***************"
'Démarre le service
ServiceTableEntry.lpServiceName = SERVICE_NAME
ServiceTableEntry.lpServiceProc = FncPtr(AddressOf ServiceMain)
B = StartServiceCtrlDispatcher(ServiceTableEntry)
Print #piFichierDebug, "*************** FIN ***************"
Close #piFichierDebug
End Select
End Sub
Sub ServiceMain(ByVal dwArgc As Long, ByVal lpszArgv As Long)
Dim B As Boolean
Dim U As Long
Dim Z As Long
On Error Resume Next
' Configuration Initiale
ServiceStatus.dwServiceType = SERVICE_WIN32_OWN_PROCESS
Print #piFichierDebug, Err.Number
Print #piFichierDebug, Err.Description
Print #piFichierDebug, Err.Source
Print #piFichierDebug, ""
Err.Clear
ServiceStatus.dwCurrentState = SERVICE_START_PENDING
Print #piFichierDebug, Err.Number
Print #piFichierDebug, Err.Description
Print #piFichierDebug, Err.Source
Print #piFichierDebug, ""
Err.Clear
' 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
Print #piFichierDebug, Err.Number
Print #piFichierDebug, Err.Description
Print #piFichierDebug, Err.Source
Print #piFichierDebug, ""
Err.Clear
ServiceStatus.dwWin32ExitCode = 0
Print #piFichierDebug, Err.Number
Print #piFichierDebug, Err.Description
Print #piFichierDebug, Err.Source
Print #piFichierDebug, ""
Err.Clear
ServiceStatus.dwServiceSpecificExitCode = 0
Print #piFichierDebug, Err.Number
Print #piFichierDebug, Err.Description
Print #piFichierDebug, Err.Source
Print #piFichierDebug, ""
Err.Clear
ServiceStatus.dwCheckPoint = 0
Print #piFichierDebug, Err.Number
Print #piFichierDebug, Err.Description
Print #piFichierDebug, Err.Source
Print #piFichierDebug, ""
Err.Clear
ServiceStatus.dwWaitHint = 0
Print #piFichierDebug, Err.Number
Print #piFichierDebug, Err.Description
Print #piFichierDebug, Err.Source
Print #piFichierDebug, ""
Err.Clear
hServiceStatus = RegisterServiceCtrlHandler(SERVICE_NAME, AddressOf Handler)
Print #piFichierDebug, Err.Number
Print #piFichierDebug, Err.Description
Print #piFichierDebug, Err.Source
Print #piFichierDebug, ""
Err.Clear
ServiceStatus.dwCurrentState = SERVICE_START_PENDING
Print #piFichierDebug, Err.Number
Print #piFichierDebug, Err.Description
Print #piFichierDebug, Err.Source
Print #piFichierDebug, ""
Err.Clear
B = SetServiceStatus(hServiceStatus, ServiceStatus)
Print #piFichierDebug, Err.Number
Print #piFichierDebug, Err.Description
Print #piFichierDebug, Err.Source
Print #piFichierDebug, ""
Err.Clear
ServiceStatus.dwCurrentState = SERVICE_RUNNING
Print #piFichierDebug, Err.Number
Print #piFichierDebug, Err.Description
Print #piFichierDebug, Err.Source
Print #piFichierDebug, ""
Err.Clear
B = SetServiceStatus(hServiceStatus, ServiceStatus)
Print #piFichierDebug, Err.Number
Print #piFichierDebug, Err.Description
Print #piFichierDebug, Err.Source
Print #piFichierDebug, ""
Err.Clear
' Ici votre programme, ou l'appelle de votre fonction
'B = Mafonction(MesVariables)
'B = pbActionsKezen
B = pbTest
Print #piFichierDebug, Err.Number
Print #piFichierDebug, Err.Description
Print #piFichierDebug, Err.Source
Print #piFichierDebug, ""
Err.Clear
'' Si une erreur se produit, vous pouvez utiliser ceci:
''Gestion_Erreur:
'' SetServerStatus SERVICE_STOP_PENDING
'' Clean up
'' SetServerStatus SERVICE_STOPPED
End Sub
Sub 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 Sub
Function FncPtr(ByVal fnp As Long) As Long
FncPtr = fnp
End Function
Private Function pbTest() As Boolean
Print #piFichierDebug, "*************** coucou ***************"
Print #piFichierDebug, "*************** coucou ***************"
Print #piFichierDebug, "*************** coucou ***************"
Print #piFichierDebug, "*************** coucou ***************"
Print #piFichierDebug, "*************** coucou ***************"
pbTest = True
End Function