Imports System.ServiceProcess Imports System.Threading Imports System.IO Imports System.Reflection Imports System.IO.File Imports System.Data Imports System.Data.SqlClient Imports System.Data.SqlTypes Public Class Service1 Inherits System.ServiceProcess.ServiceBase #Region " Vom Component Designer generierter Code " Public Sub New() MyBase.New() ' Dieser Aufruf wird vom Komponenten-Designer benötigt. InitializeComponent() ' Fügen Sie Initialisierungscode hinter dem InitializeComponent()-Aufruf ein End Sub 'UserService überschreibt den Löschvorgang zum Bereinigen der Komponentenliste. Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean) If disposing Then If Not (components Is Nothing) Then components.Dispose() End If End If MyBase.Dispose(disposing) End Sub ' Der Haupteinstiegspunkt für den Vorgang _ Shared Sub Main() '#If DEBUG Then ' Dim service As New Service1 ' service.StartService() ' System.Threading.Thread.Sleep(System.Threading.Timeout.Infinite) '#Else ' Dim ServicesToRun() As System.ServiceProcess.ServiceBase ' ServicesToRun = New System.ServiceProcess.ServiceBase() {New Service1} ' System.ServiceProcess.ServiceBase.Run(ServicesToRun) '#End If Dim ServicesToRun() As System.ServiceProcess.ServiceBase ServicesToRun = New System.ServiceProcess.ServiceBase() {New Service1} System.ServiceProcess.ServiceBase.Run(ServicesToRun) End Sub ' Für Komponenten-Designer erforderlich Private components As System.ComponentModel.IContainer ' HINWEIS: Die folgende Prozedur wird vom Komponenten-Designer benötigt. ' Sie kann mit dem Komponenten-Designer modifiziert werden. Verwenden Sie nicht ' den Code-Editor zur Bearbeitung. Friend WithEvents chktimer As System.Timers.Timer Private Sub InitializeComponent() Me.chktimer = New System.Timers.Timer CType(Me.chktimer, System.ComponentModel.ISupportInitialize).BeginInit() ' 'chktimer ' Me.chktimer.Enabled = True ' 'Service1 ' Me.ServiceName = "EDKB01ZV" CType(Me.chktimer, System.ComponentModel.ISupportInitialize).EndInit() End Sub #End Region #Region "Deklarationen" Dim FileWatch As New FileSystemWatcher() Public m_Log As bms.Logging Public Enum ENUM_InfoTyp Typ_Information = 1 Typ_Error = 3 Typ_Warning = 2 End Enum Public Enum ENUM_LogTyp Eventlog = 1 Journal = 2 Beide = 3 End Enum Public Enum ENUM_LogStatus _New = 1 _Close = 2 _Restart = 3 End Enum #End Region Protected Overrides Sub OnStart(ByVal args() As String) Dim db As New EDOKA.DB_Connection() 'Filewatcher initialisieren Thread.Sleep(3000) Try LogInstanz(ENUM_LogStatus._New) Catch ex As Exception WirteLog("BMS-Connection / XML: " + ex.Message, ApplicationPath() + "Error.txt") Exit Sub End Try Params.Loadparameters() PrintLog("EDKB01ZV gestartet", ENUM_LogTyp.Beide, ENUM_InfoTyp.Typ_Information) Me.chktimer.Interval = Params.TimerIntervall Me.chktimer.Enabled = True PrintLog("Timer Initialisiert", ENUM_LogTyp.Beide, ENUM_InfoTyp.Typ_Information) Try FileWatch.Path = Params.WatchDirectory FileWatch.IncludeSubdirectories = False FileWatch.Filter = "zv*.txt" AddHandler FileWatch.Created, New FileSystemEventHandler(AddressOf OnFileEvent) Me.FileWatch.EnableRaisingEvents = True PrintLog("Überwachung gestartet...", ENUM_LogTyp.Beide, ENUM_InfoTyp.Typ_Information) Catch ex As Exception PrintLog("Fehler bei der Initialisierung des Filewacherobjekts auf " + Params.WatchDirectory, ENUM_LogTyp.Beide, ENUM_InfoTyp.Typ_Error) End Try End Sub Private Sub WirteLog(ByVal stext As String, ByVal sPfad As String) Try Dim FiStr As FileStream = New FileStream(sPfad, FileMode.Append) Dim StrWr As StreamWriter = New StreamWriter(FiStr) StrWr.WriteLine("Fehler: " + Now()) StrWr.WriteLine("Fehlertext:" + stext) StrWr.Close() Catch ex As Exception End Try End Sub Public Function ApplicationPath() As String 'Return Path.GetDirectoryName([Assembly].GetExecutingAssembly().Location) Return Path.GetDirectoryName([Assembly].GetEntryAssembly().Location) + "\" End Function Private Sub LogInstanz(ByVal Typ As ENUM_LogStatus) Select Case Typ Case ENUM_LogStatus._New m_Log = New bms.Logging(CInt(2), Common.Common.JobType.WatchJob) m_Log.Start() Case ENUM_LogStatus._Close m_Log.Ende() m_Log = Nothing Case ENUM_LogStatus._Restart m_Log.Ende() m_Log = Nothing m_Log = New bms.Logging(CInt(2), Common.Common.JobType.WatchJob) m_Log.Start() PrintLog("Überwachung gestartet...", ENUM_LogTyp.Beide, ENUM_InfoTyp.Typ_Information) End Select End Sub 'Private Sub StartService() ' Dim db As New EDOKA.DB_Connection ' 'Filewatcher initialisieren ' m_Log = New bms.Logging(CInt(2), Common.Common.JobType.StartJob) ' m_Log.Start() ' Params.Loadparameters() ' PrintLog("EDKB01ZV gestartet", ENUM_LogTyp.Beide, ENUM_InfoTyp.Typ_Information) ' Me.chktimer.Interval = Params.TimerIntervall ' Me.chktimer.Enabled = True ' PrintLog("Timer Initialisiert", ENUM_LogTyp.Beide, ENUM_InfoTyp.Typ_Information) ' Try ' FileWatch.Path = Params.WatchDirectory ' FileWatch.IncludeSubdirectories = False ' FileWatch.Filter = "zv*.txt" ' AddHandler FileWatch.Created, New FileSystemEventHandler(AddressOf OnFileEvent) ' Me.FileWatch.EnableRaisingEvents = True ' PrintLog("Überwachung gestartet...", ENUM_LogTyp.Beide, ENUM_InfoTyp.Typ_Information) ' Catch ex As Exception ' PrintLog("Fehler bei der Initialisierung des Filewacherobjekts auf " + Params.WatchDirectory, ENUM_LogTyp.Beide, ENUM_InfoTyp.Typ_Error) ' End Try 'End Sub Private Sub OnFileEvent(ByVal source As Object, ByVal e As FileSystemEventArgs) Try Me.chktimer.Enabled = False PrintLog("Datei zvdaten.txt wird angeliefert - " + LTrim(Str(Params.Wait_Before_Start_EDKB01 / 60 / 1000)) + " Minuten warten", ENUM_LogTyp.Beide, ENUM_InfoTyp.Typ_Information) Thread.Sleep(Params.Wait_Before_Start_EDKB01) Dim di As New IO.DirectoryInfo(Params.WatchDirectory) Dim diar1 As IO.FileInfo() = di.GetFiles("zvi*.txt") Dim diar2 As IO.FileInfo() = di.GetFiles("zvc*.txt") Dim dra As IO.FileInfo 'zvindex.txt File einlesen For Each dra In diar1 File.Copy(e.FullPath, Params.SaveDir + Format(Now, "yyyyMMddHHmmss") + "_" + e.Name) PrintLog("Datei " + e.FullPath + " gesichert", ENUM_LogTyp.Beide, ENUM_InfoTyp.Typ_Information) If e.FullPath = "D:\EDOKA\EDKB01\zvIndex.txt" Then Dim i As Integer i = Shell(Globals.ApplicationPath + Params.ParamsEDKB01, AppWinStyle.NormalFocus, True) File.Copy(Params.WatchDirectory + "HostIndex.ok", Params.SaveDir + Format(Now, "yyyyMMddHHmmss") + "_HostIndex.ok") If Now.Hour > 8 Then File.Delete(Params.WatchDirectory + "HostIndex.ok") PrintLog("Datei " + Params.WatchDirectory + "HostIndex.ok gelöscht", ENUM_LogTyp.Beide, ENUM_InfoTyp.Typ_Information) End If Sendmail(Params.MailAdresseOK, 0) LogInstanz(ENUM_LogStatus._Restart) End If If e.FullPath = "D:\EDOKA\EDKB01\zvcheckIndex.txt" Then File.Delete(Params.WatchDirectory + "zvcheckIndex.txt") End If Me.chktimer.Enabled = True Next Catch ex As Exception PrintLog("Fehler: " + ex.Message, ENUM_LogTyp.Beide, ENUM_InfoTyp.Typ_Error) End Try End Sub Protected Overrides Sub OnStop() ' Hier Code zum Ausführen notwendiger Löschvorgänge zum Anhalten des Dienstes einfügen. Me.FileWatch.EnableRaisingEvents = False Me.chktimer.Enabled = False PrintLog("Service gestoppt", ENUM_LogTyp.Beide, ENUM_InfoTyp.Typ_Information) LogInstanz(ENUM_LogStatus._Close) End Sub #Region "Utils" 'Dim EVLog As New EventLog("EDKB01ZV") 'Public Sub PrintLog(ByVal message As String, Optional ByVal eventmessage As EventLogEntryType = EventLogEntryType.Information) ' Try ' If Not EVLog.SourceExists("EDKB01ZV") Then ' EVLog.CreateEventSource("EDKB01ZV", "EDKB01ZV") ' End If ' EVLog.Source = "EDKB01ZV" ' EVLog.WriteEntry(EVLog.Source, message, eventmessage) ' Catch ex As Exception ' End Try 'End Sub Public Sub PrintLog(ByVal message As String, ByVal sTyp As ENUM_LogTyp, ByVal eventmessage As ENUM_InfoTyp) If sTyp = ENUM_LogTyp.Journal Or sTyp = ENUM_LogTyp.Beide Then Try m_Log.Log(message, eventmessage) Catch ex As Exception End Try End If If sTyp = ENUM_LogTyp.Eventlog Or sTyp = ENUM_LogTyp.Beide Then Dim iError As EventLogEntryType Select Case eventmessage Case ENUM_InfoTyp.Typ_Warning iError = EventLogEntryType.Warning Case ENUM_InfoTyp.Typ_Error iError = EventLogEntryType.Error Case Else iError = EventLogEntryType.Information End Select Try Dim eventl As New EventLog If Diagnostics.EventLog.SourceExists("EDKB01ZV") = False Then Diagnostics.EventLog.CreateEventSource("EDKB01ZV", "EDKB01ZV") End If eventl.BeginInit() Diagnostics.EventLog.WriteEntry("EDKB01ZV", message, iError) eventl.EndInit() Catch ex As Exception End Try End If End Sub #End Region Private Sub chktimer_Elapsed(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Handles chktimer.Elapsed If e.SignalTime.Hour > 9 And e.SignalTime.Hour < 19 Then CheckErrorDoks() m_Log.Log("Innerhalb der letzten " + LTrim(Str(Params.TimerIntervall / 60 / 1000)) + " Minuten wurden keine ZV-Daten angeliefert / " + Format(Now, "yyyyMMddHHmmss"), Common.Common.JournalEntryType.Error) LogInstanz(ENUM_LogStatus._Restart) End If End Sub Private Sub CheckErrorDoks() Try Dim di As New IO.DirectoryInfo(Params.WatchDirectory) Dim diar1 As IO.FileInfo() = di.GetFiles("zv*.txt") Dim dra As IO.FileInfo For Each dra In diar1 File.Move(Params.WatchDirectory + dra.Name, Params.SaveDirError + Format(Now, "yyyyMMddHHmmss") + "_" + dra.Name) PrintLog("Datei " + Params.WatchDirectory + dra.Name + " gesichert", ENUM_LogTyp.Beide, ENUM_InfoTyp.Typ_Error) Next Catch ex As Exception End Try End Sub Public Function Sendmail(ByVal email As String, ByVal msg As Integer) As Boolean Dim m_Common As New Common.Common Dim meldung As String = "" Dim betreff As String = "" Select Case msg Case 0 betreff = "EDKB01ZV - Return 0: EDKB01ZV Erfolgreich beendet / " + Format(Now, "yyyyMMddHHmmss") meldung = "EDKB01ZV - Return 0: EDKB01ZV Erfolgreich beendet." End Select Try m_Common.SendMail(email, betreff, meldung) Sendmail = True Catch ex As Exception Sendmail = False PrintLog("Fehler: " + ex.Message, ENUM_LogTyp.Beide, ENUM_InfoTyp.Typ_Error) End Try End Function End Class