cs_zephyrin
Messages postés47Date d'inscriptionmercredi 29 mai 2002StatutMembreDernière intervention17 août 2006
-
27 févr. 2004 à 09:40
true_picpic
Messages postés34Date d'inscriptionmercredi 26 novembre 2003StatutMembreDernière intervention24 août 2004
-
23 sept. 2004 à 20:02
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.
"
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
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
' 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