Service NT

cs_poleau Messages postés 12 Date d'inscription mardi 15 janvier 2002 Statut Membre Dernière intervention 3 juin 2003 - 19 janv. 2002 à 18:04
cs_Marc88 Messages postés 2 Date d'inscription mercredi 11 décembre 2002 Statut Membre Dernière intervention 12 décembre 2002 - 12 déc. 2002 à 11:29
Je cherche à éxecuter un prog VB en tant que service sous NT4. L'installation du service se passe sans problème grâce aux nombreuses sources de ce site. Mais je n'arrive pas à démarrer le service...

Les prog VB doivent-il avoir une configuration particulière pour pouvoir s'éxécuter comme service ?

7 réponses

cs_asd Messages postés 32 Date d'inscription mercredi 9 janvier 2002 Statut Membre Dernière intervention 5 novembre 2003
22 janv. 2002 à 17:32
Fais attention à ce qu'il n'y ait pas de passage de commande du type app.path dans ton source par exemple. Si tu utilises çà pour ouvrir une base de données, il faut que tous les chemins soient en dur, que tu définisses le chemin complet, puisqu'en tant que service ces fonctions ne sont plus viables...

Voici du code fourni par crosoft pour les services en VB. Attarde-toi sur la proc main.

'=================================
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_PAUSE_CONTINUE 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

Type MAJ
id As Long
URL As String
INFO As Long
ALTA As Long
Hotbot As Long
End Type
Type Site
Nom As String
Docum As String
Param As String
Debut As String
fin As String
End Type

' Indiquez ici le nom du service, c'est lui qui apparait dans la boite de dialogue des services
Private Const SERVICE_NAME As String = "SPECIFIQUE"

Private hServiceStatus As Long
Private ServiceStatus As SERVICE_STATUS

' Installation du service
' MyService.exe install
' Désinstallation du service
' MyService.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

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
'Démarre le service
ServiceTableEntry.lpServiceName = SERVICE_NAME
ServiceTableEntry.lpServiceProc = FncPtr(AddressOf ServiceMain)
B = StartServiceCtrlDispatcher(ServiceTableEntry)
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
' Configuration Initiale
ServiceStatus.dwServiceType = SERVICE_WIN32_OWN_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

hServiceStatus = RegisterServiceCtrlHandler(SERVICE_NAME, _
AddressOf Handler)
ServiceStatus.dwCurrentState = SERVICE_START_PENDING
B = SetServiceStatus(hServiceStatus, ServiceStatus)

ServiceStatus.dwCurrentState = SERVICE_RUNNING
B = SetServiceStatus(hServiceStatus, ServiceStatus)

' Ici votre programme, ou l'appelle de votre fonction

'B = Mafonction(MesVariables)

'' 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
'=================================

A++
asd
0
cs_poleau Messages postés 12 Date d'inscription mardi 15 janvier 2002 Statut Membre Dernière intervention 3 juin 2003
23 janv. 2002 à 19:44
Je te remercie, mais ça fait déja lontemps que j'avais remarqué que ce code ne fonctionnait pas.
Entre temps, j'ai trouvé la solution : il faut en fait utiliser ntsrv.ocx (qui est fourni avec VB: Microsoft NT service control) et il faut l'enregistrer dans NT :

regsvr32 %SystemRoot%\system32\ntsrv.ocx
et là ça fonctionne !

@+
0
cs_asd Messages postés 32 Date d'inscription mercredi 9 janvier 2002 Statut Membre Dernière intervention 5 novembre 2003
24 janv. 2002 à 08:20
merci pour l'info
0
cs_era Messages postés 77 Date d'inscription lundi 6 mai 2002 Statut Membre Dernière intervention 4 mai 2011
22 mai 2002 à 16:25
Il est ou moi sous 2000 je l ai pas cette ocx %-6
Y a pas que $crosoft dans la vie......
Ebouda ^-[( ° ° )]-^
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
cs_era Messages postés 77 Date d'inscription lundi 6 mai 2002 Statut Membre Dernière intervention 4 mai 2011
23 mai 2002 à 17:54
Ceci est un test
<script>
alert("Bonjour");
</script>
Y a pas que $crosoft dans la vie......
Ebouda ^-[( ° ° )]-^
0
cs_Marc88 Messages postés 2 Date d'inscription mercredi 11 décembre 2002 Statut Membre Dernière intervention 12 décembre 2002
11 déc. 2002 à 19:03
Marco88
Je viens de passer l'après midi à éssayer de faire fonctionner ce source.
Je vois que tu dit qu'il faut ntsvc ocx, je ne le trouve null part, cd-rom, net , etc.
Peut tu me le faire parvenir ?
par avance merci.[url]mailto:contact@asubstra.fr
0
cs_Marc88 Messages postés 2 Date d'inscription mercredi 11 décembre 2002 Statut Membre Dernière intervention 12 décembre 2002
12 déc. 2002 à 11:29
Marco88
0
Rejoignez-nous