VB-Programm als Dienst starten

Visual Basic-Anwendungen sind aufgrund der Architektur nicht in der Lage als Windows-Dienste eingesetzt zu werden. Man kann sich jedoch helfen, indem man eine von einem Microsoft Consultant entwickelte aber nicht von Microsoft offiziell unterstützte Komponente einsetzt, die auch auf den neuesten Windows-Plattformen läuft: das "Microsoft NT Service Control".

Die NTSVC.OXC wird über die Komponentenliste in ein Projekt eingebunden und muss leider auf einer Form platziert werden, d.h. man kann keine Formular-lose Anwendung schreiben, was aber nicht viel ausmacht, denn je nachdem in welchem Modus man den Dienst laufen hat, wird sie schlicht nicht eingeblendet. Man kann die Form jedoch auch gut als Statusfenster verwenden.

Das Control bietet neben den Dienst-Ereignissen START, STOP, CONTINUE und PAUSE, mit denen man die Steuerung des Service Control Managers verarbeiten kann, folgende elementaren Eigenschaften:

• DisplayName = angezeigter Name des Dienstes im Service Control Manager und im EventLog
• ServiceName = Name des Dienstes ohne Leerzeichen
• ControlsAccepted = welche Dienst-Steuerungen werden akzeptiert
• StartMode = wie verhält sich der Dienst beim Start von Windows (automatisch starten, manuell starten, deaktiviert)
• Interactive = kann der Dienst mit dem Benutzer interagieren
• Debug = Möglichkeit während den Dienst in der Entwicklungsumgebung zu testen
• Account = Name des Kontos in dessen Kontext der Dienst läuft
• Password = Passwort des o.g. Kontos

Die letzten beiden Eigenschaften sollte jedoch nicht unbedingt mit in das Programm kompiliert werden, da sich diese Werte ändern können. Weiterhin gibt es die Möglichkeit Abhängigkeiten zu anderen Komponenten zu definieren. Näheres dazu in der Hilfedatei zur Komponente.

Zur Installation und Steuerung des Dienstes dienen insgesamt vier Methoden:

• Install = Installiert den Dienst auf dem Computer
• Uninstall = Deinstalliert den Dienst
• StartService = startet den Dienst
• StopService = beendet den Dienst

Zudem ist die Komponente von Microsoft befähigt worden, direkt Einträge im Event-Log vorzunehmen. Hierzu steht die Methode "LogEvent" zur Verfügung.

In diesem Test-Programm soll es nun darum gehen, dass der Dienst in einem festgelegten Intervall zunächst einmal nur einen bestimmten Text in ein Statusfeld schreibt. In der Praxis würde er zum Beispiel in einem Verzeichnis nach einer bestimmten Datei suchen und ein Programm anstoßen, welches diese Datei verarbeitet.

In einer Form werden zunächst die notwendigen Label-Steuerelemente, ein Timer und eine Instanz der NTSVC-Komponente abgelegt.

Um die Installation bzw. Steuerung des Dienstes zu bewerkstelligen werden mehrere Aufrufparameter festgelegt, die beim Start des Dienstes, d.h. beim Laden des Formulars ausgewertet werden. Zudem werden dort auch die Eigenschaften des Dienstes festgelegt:

Private Sub Form_Load()

   Dim strCommand As String
   Dim pbolIsIDE As Boolean

   On Error GoTo error_handler

   'Prüfen, ob die Ausführung in der IDE stattfindet
   pbolIsIDE = IsInIDE

   'Diensteigenschaften setzen
   Me.NTService1.DisplayName = "Visual Basic Test-Dienst"
   Me.NTService1.ServiceName = "VBTestDienst"
   Me.NTService1.StartMode = svcStartManual
   Me.NTService1.ControlsAccepted = svcCtrlPauseContinue Or svcCtrlShutdown
   Me.NTService1.Interactive = True
   Me.NTService1.Debug = pbolIsIDE

   'Auslesen des Commands
   strCommand = UCase$(Command)

   Select Case strCommand

      'Start des Dienstes (ohne Parameter)
      Case ""
         If pbolIsIDE = False Then
            Me.NTService1.StartService
         Else
            Call DoStart
         End If

         Me.lblStatus.Caption = "Service gestartet..."
         Me.lblNextRun.Caption = pcintInterval & " Sekunden"

      'Installation des Dienstes
      Case "-I", "/I"
         If Me.NTService1.Install Then
            MsgBox Me.NTService1.DisplayName & _
              " erfolgreich installiert. Bitte konfigurieren Sie den " & _
              "Dienst über den SCM (Service Control Manager)", vbInformation
         Else
            MsgBox Me.NTService1.DisplayName & _
              " konnte NICHT erfolgreich installiert werden!", vbExclamation
         End If
         End

      'Deinstallation des Dienstes
         Case "-U", "/U"
            If Me.NTService1.Uninstall Then
              MsgBox Me.NTService1.DisplayName & _
                 " erfolgreich deinstalliert", vbInformation
            Else
              MsgBox Me.NTService1.DisplayName & _
                 " konnte NICHT erfolgreich deinstalliert werden!", vbExclamation
            End If
            End

         'Anzeige der Hilfe
         Case "-?", "/?", "-H", "/H"
            MsgBox Me.NTService1.DisplayName & _
               " v" & App.Major & "." & App.Minor & _
               " Build " & App.Revision & vbCrLf & vbCrLf & _
               "Parameter:" & vbCrLf & vbCrLf & _
               "-i (installieren)" & vbCrLf & "-u (deinstallieren)", vbInformation
            End

         'Alle weiteren Parameter...
         Case Else
            MsgBox "Dieser Parameter: " & Command & " ist unbekannt!" & _
               vbCrLf & vbCrLf & "Parameter:" & _
               vbCrLf & vbCrLf & "-i (installieren)" & _
               vbCrLf & "-u (deinstallieren)", vbExclamation
            End

      End Select

   Exit Sub

error_handler:
   Me.NTService1.LogEvent svcEventError, svcMessageError, Err.Description
   End

End Sub

Die Prüfung, ob die Ausführung in der IDE stattfindet, übernimmt die Funktion IsInIDE, die ich im Artikel kleine Helferlein beschrieben habe. Die Funktion DoStart, die beim Start des Dienstes aufgerufen wurde, tut nichts weiter als den Timer zu initialisieren:

Private Function DoStart() As Boolean

   On Error GoTo error_handler

   Me.Timer1.Interval = 1000
   Me.Timer1.Enabled = True

   DoStart = True

error_handler:

End Function

Als nächstes müssen die Dienst-Ereignisse abgefangen werden, wobei beim STOP-Ereignis lediglich eine globale Variable belegt wird und das Beenden des Dienstes die Timer-Prozedur übernimmt:

Private Sub NTService1_Start(Success As Boolean)
   Success = DoStart
End Sub

Private Sub NTService1_Continue(Success As Boolean)
   Success = DoStart
End Sub

Private Sub NTService1_Pause(Success As Boolean)
   Me.Timer1.Enabled = False
   Success = True
End Sub

Private Sub NTService1_Stop()
   pbolDoUnload = True
End Sub

Um die Ausführung des eigentlichen Tasks nur alle X Sekunden zu ermöglichen, wird in der Prozedur Timer eine statische Variable hochgezählt und erst dann die Ausführung der eigentlichen Aktion gestartet, wenn der definierte Intervall erreicht worden ist:

Private Sub Timer1_Timer()

   Static i As Integer

   On Error GoTo error_handler

   'Anforderung zum Beenden ist eingetreten
   If pbolDoUnload = True Then
      Me.Timer1.Enabled = False
      Unload Me
      Exit Sub
   End If

   'Ist die Zeit für den nächsten Lauf erreicht?
   If i = pcintInterval Then
      'Zähler zurücksetzen
      i = 0
      'Ausführung starten
      Me.lblStatus.Caption = "Ausführung: " & Now()
   End If

timer_exit:
   i = i + 1

   'Anzeige aktualisieren
   If Me.Visible = True Then
      Me.lblNextRun.Caption = pcintInterval - i & " Sekunden"
   End If

error_handler:
   Me.NTService1.LogEvent svcEventError, svcMessageError, Err.Description

End Sub

Downloads