 |
Publicité 
|
Bien que déconseillé par Microsoft, la réalisation de services NT est possible avec Visual Basic.
En effet Visual Basic ne gérant pas correctement le "Call Back" (VB appelle Windows, qui rappelle une fonction du programme VB) certains services créés avec Visual Basic risquent de posés des problèmes.
Cependant, Visual Basic vous permettra de réaliser facilement des services, vous permettant de créer des programmes qui s'exécuteront avant le démarrage de la session utilisateur Windows. (pour des programmes de protection par exemple)
Le source:
' 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
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
End Select
' envoi l'état actuel
B = SetServiceStatus(hServiceStatus, ServiceStatus)
End Sub
Function FncPtr(ByVal fnp As Long) As Long
FncPtr = fnp
End Function
N'oubliez pas les déclarations :
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 = "Mon Service NT"
Private hServiceStatus As Long
Private ServiceStatus As SERVICE_STATUS
Télécharger le source.
|
