Création de service NT avec VB5.

 

La base de cet OCX est un issue d'un article du MSDN Microsoft accompagné d'un source C++, j'ai dû passer un peu de temps à faire fonctionner correctement le code "As is" de Microsoft.

Cet article s'adresse donc aux spécialistes.

1 - Enregistrer l'OCX dans la base de registre.

2 - Un service doit être installé (nomService -install).

3 - Si l'installation est OK la suite des opérations se passera dans le gestionnaire de service du panneau de contrôle.

 

Télécharger l'OCX (14k)

Code Exemple VB5



Private Sub Form_Load()

On Error GoTo Err_Load
Dim strDisplayName As String
Dim bStarted As Boolean

strDisplayName = NTService1.DisplayName

StatusBar.Panels(1).Text = "Chargement..."

If Command = "-install" Then
'------------------------------------------------
' Autoriser le service à interagir avec le bureau
'------------------------------------------------
NTService1.Interactive = True
'------------------------------------------------
' Installer le service
'------------------------------------------------
If NTService1.Install Then
'------------------------------------------------
' Ecrire dans la base de registre
'------------------------------------------------
Call NTService1.SaveSetting("Parameters", "TimerInterval", "1000")
MsgBox strDisplayName & " installer avec succés"
Else
MsgBox strDisplayName & " installation à échouée"
End If
End
ElseIf Command = "-uninstall" Then
'------------------------------------------------
' Desinstaller le service
'------------------------------------------------
If NTService1.Uninstall Then
MsgBox strDisplayName & " desinstaller avec succés"
Else
MsgBox strDisplayName & " desinstallation à échoué"
End If
End
ElseIf Command = "-debug" Then
'------------------------------------------------
' Debbuguer le service
'------------------------------------------------
NTService1.Debug = True
ElseIf Command <> "" Then
MsgBox "argument incorrect"
End
End If
'------------------------------------------------
' Lire la base de registre
'------------------------------------------------
Timer.Interval = CInt(NTService1.GetSetting("Parameters", "TimerInterval", "2000"))

'------------------------------------------------
' Autoriser Pause/Continue. Doit être défini avant StartService
' ou dans les propriétés de NTService
'------------------------------------------------
NTService1.ControlsAccepted = svcCtrlPauseContinue
'--------------------------------------------------
' connecter le service a "Windows NT services controller"
'--------------------------------------------------
NTService1.StartService
Exit Sub
Err_Load:
'--------------------------------------------------
' Ecrire dans le journal d'événements
'--------------------------------------------------
Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
End Sub


Private Sub NTService1_Continue(Success As Boolean)
On Error GoTo Err_Continue
'
' Ajouter votre code ici
'
Timer.Enabled = True
StatusBar.Panels(1).Text = "Demarrer"
Success = True
Call NTService1.LogEvent(svcEventInformation, svcMessageInfo, "Service continued")
Exit Sub
Err_Continue:
'--------------------------------------------------
' Ecrire dans le journal d'événements
'--------------------------------------------------
Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
End Sub



Private Sub NTService1_Control(ByVal FireEvent As Long)
On Error GoTo Err_Control
'
' Ajouter votre code ici
'
StatusBar.SimpleText = NTService1.DisplayName & " Command reçu " & FireEvent
Exit Sub

Err_Control:
'--------------------------------------------------
' Ecrire dans le journal d'événements
'--------------------------------------------------
Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
End Sub

Private Sub NTService1_Pause(Success As Boolean)
On Error GoTo Err_Pause
'
' Ajouter votre code ici
'
Timer.Enabled = False
StatusBar.Panels(1).Text = "Suspendu"
Call NTService1.LogEvent(svcEventError, svcMessageError, "Service paused")
Success = True
Exit Sub
Err_Pause:
'--------------------------------------------------
' Ecrire dans le journal d'événements
'--------------------------------------------------
Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
End Sub


Private Sub NTService1_Start(Success As Boolean)
On Error GoTo Err_Start
'
' Ajouter votre code ici
'
StatusBar.Panels(1).Text = "Demarrer"
Success = True
Exit Sub
Err_Start:
'--------------------------------------------------
' Ecrire dans le journal d'événements
'--------------------------------------------------
Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
End Sub


Private Sub NTService1_Stop()
On Error GoTo Err_Stop
'
' Ajouter votre code ici
'
StatusBar.Panels(1).Text = "Arreter"
Unload Me
Exit Sub
Err_Stop:
'--------------------------------------------------
' Ecrire dans le journal d'événements
'--------------------------------------------------

Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
End Sub


Private Sub Timer_Timer()
On Error GoTo Err_Timer
'
' Ajouter votre code ici
'

StatusBar.Panels(2).Text = Format(Now(), "hh:mm:ss")
Exit Sub
Err_Timer:
'--------------------------------------------------
' Ecrire dans le journal d'événements
'--------------------------------------------------

Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
End Sub


FORM (feuille)


VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "comctl32.ocx"
Object = "{E7BC34A0-BA86-11CF-84B1-CBC2DA68BF6C}#1.0#0"; "Ntsvc.ocx"


Begin VB.Form ServiceMain

Caption = "Sample NT Service"
ClientHeight = 4140
ClientLeft = 1395
ClientTop = 1620
ClientWidth = 6690
Icon = (None)
LinkTopic = "Form1"
PaletteMode = 1 'UseZOrder
ScaleHeight = 4140
ScaleWidth = 6690

Begin NTService.NTService NTService1

Left = 240
Top = 240
_Version = 65536
_ExtentX = 741
_ExtentY = 741
_StockProps = 0
ServiceName = "Simple"
StartMode = 3
End

Begin VB.Timer Timer

Left = 960
Top = 360
End

Begin ComctlLib.StatusBar StatusBar

Align = 2 'Align Bottom
Height = 300
Left = 0
TabIndex = 0
Top = 3840
Width = 6690
_ExtentX = 11800
_ExtentY = 529
SimpleText = ""
_Version = 327682

End