Imports System.Timers Imports IBM.WMQ Imports System.ServiceProcess Imports System.Runtime.Remoting Imports System.Runtime.Remoting.Channels Imports System.Xml Imports System.Data.SqlClient Imports System.IO Imports System.Reflection Imports bms Public Class EDKB04OP Inherits System.ServiceProcess.ServiceBase Dim WithEvents tmrQueuePolling As Timer = New Timer(2000) Dim myStopper As ErrorStopper #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() ' Dim ServicesToRun() As System.ServiceProcess.ServiceBase ' ServicesToRun = New System.ServiceProcess.ServiceBase() {New EDKB04OP} ' System.ServiceProcess.ServiceBase.Run(ServicesToRun) 'End Sub #End Region #Region "StartStop" Protected Overrides Sub OnStart(ByVal args() As String) Try Dim FileWatch As New FileSystemWatcher() 'init BMS #If CONFIG = "Release" Then Dim m_log1 As New bms.Logging(6, Common.Common.JobType.WatchJob) m_log = m_log1 #Else Dim m_log1 As New Globals.log m_log = m_log1 #End If '#If DEBUG Then ' Dim m_log1 As New Globals.log ' m_log = m_log1 '#Else 'Dim m_log1 As New bms.Logging(6, Common.Common.JobType.WatchJob) 'm_log = m_log1 '#End If m_log.Start() m_log.Log("EDKB04: Start", Common.Common.JournalEntryType.Information) 'Init Params Params.Loadparameters() 'Init File Watcher FileWatch.Path = Params.Watchdir FileWatch.IncludeSubdirectories = False FileWatch.Filter = "*.xml" AddHandler FileWatch.Created, New FileSystemEventHandler(AddressOf OnFileEvent) FileWatch.EnableRaisingEvents = True 'init DB-Connection Dim sconnection = New DB_Connection() 'init Timer If CInt(Params.TimerInterval) > 0 Then tmrQueuePolling.Start() Else tmrQueuePolling.Enabled = False End If 'Init Error Stopper Me.myStopper = New ErrorStopper Me.myStopper.init(Params.nb_errors, Params.nb_seconds) Catch ex As Exception WriteLog("BMS-Connection / XML: " + ex.Message, appPath + "Error.txt") m_log.Log(ex.Message, Common.Common.JournalEntryType.Error) Exit Sub End Try End Sub Protected Overrides Sub OnStop() ' Hier Code zum Ausführen erforderlicher Löschvorgänge zum Beenden des Dienstes einfügen. m_log.Log("EDKB04 Stop", Common.Common.JournalEntryType.Information) m_log.Ende() End Sub #End Region #Region "Log" Private Sub WriteLog(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() & " Text:" & stext) StrWr.Close() Catch ex As Exception End Try End Sub Private Function writeDebug(ByVal xmlstring As String) As Boolean Dim result As Boolean = True Try Dim writer As System.IO.StreamWriter Dim filetimestamp As String = Format(Now, "yyyyMMddHHmmssffff") writer = IO.File.AppendText(Params.DebugDir & filetimestamp & ".xml") writer.WriteLine(xmlstring) writer.Close() Catch ex As Exception m_log.Log("EDKB04: Error beim Abspeichern der Debug .xml Daten") result = False End Try Return result End Function #End Region #Region "Timer" Public Sub OnTimedEvent(ByVal source As Object, ByVal e As ElapsedEventArgs) Handles tmrQueuePolling.Elapsed ReadfromMQ() End Sub #End Region #Region "File Watcher" Private Sub OnFileEvent(ByVal source As Object, ByVal e As FileSystemEventArgs) Try Threading.Thread.Sleep(2000) Dim di As New IO.DirectoryInfo(Params.Watchdir) Dim diar1 As IO.FileInfo() = di.GetFiles("*.xml") Dim dra As IO.FileInfo Dim data As String Dim counter As Integer = 0 For Each dra In diar1 counter = counter + 1 Dim fil As New StreamReader(dra.FullName) data = fil.ReadToEnd() fil.Close() 'm_log.Log("EDKB04: read File OK", Common.Common.JournalEntryType.Information) Dim newending As String = ".err" Dim filetimestamp As String = Format(Now, "yyyyMMddHHmmssffff") Dim splitter() As String Dim splitstring = " 0 Then mqGetMsgOpts.WaitInterval = CInt(Params.TimerInterval) Else mqGetMsgOpts.WaitInterval = 15000 '* 15 second limit for waiting End If Catch ex As Exception mqGetMsgOpts.WaitInterval = 15000 '* 15 second limit for waiting End Try mqGetMsgOpts.Options = MQC.MQGMO_WAIT Try mqQueue.Get(mqMsg, mqGetMsgOpts) 'mqQueue. If (mqMsg.Format.CompareTo(MQC.MQFMT_STRING) = 0) Then strMsg = mqMsg.ReadString(mqMsg.MessageLength) strXMLContent = strMsg 'Me.Log("Message Content:" & strMsg) If Params.DebugMode Then Me.writeDebug(strMsg) End If 'm_log.Log("EDKB04: Message Length:" & Len(strMsg) & " Chars", Common.Common.JournalEntryType.Information) If XMLtoObj(strXMLContent) = True Then 'XMLtoObj(strXMLContent) Else result = False End If result = True Else If Me.myStopper.insert Then m_log.Log("EDKB04: Non-text message", Common.Common.JournalEntryType.Error) result = False End If Catch mqe As IBM.WMQ.MQException '* report reason, if any If (mqe.Reason = MQC.MQRC_NO_MSG_AVAILABLE) Then '* special report for normal end m_log.Log("EDKB04: no more messages", Common.Common.JournalEntryType.Information) isContinue = False Else '* general report for other reasons If Me.myStopper.insert Then m_log.Log("EDKB04: MQQueue::Get ended with {0}: " & mqe.Message, Common.Common.JournalEntryType.Error) '* treat truncated message as a failure for this sample 'If (mqe.Reason = MQC.MQRC_TRUNCATED_MSG_FAILED) Then isContinue = False 'End If End If result = False End Try If LCase(Params.LoopQueue) = "false" Then isContinue = False End If Loop Catch ex As Exception If Me.myStopper.insert Then m_log.Log("EDKB04: Error bei GET: " & ex.Message, Common.Common.JournalEntryType.Error) result = False Finally If CInt(Params.TimerInterval) > 0 Then tmrQueuePolling.Start() End If End Try Return result End Function Private Function XMLtoObj(ByVal strXMLContent As String) As Boolean Dim result As Boolean Try 'm_log.Log("EDKB04: Lese XML String in Objekt", Common.Common.JournalEntryType.Information) Dim xmlh As New xmlHandling(strXMLContent) result = xmlh.Result xmlh = Nothing 'm_log.Log("EDKB04: Lese XML String in Objekt ENDE", Common.Common.JournalEntryType.Information) Catch ex As Exception m_log.Log("EDKB04: Error bei XML->Obj: " & ex.Message, Common.Common.JournalEntryType.Error) result = False End Try Return result End Function #End Region End Class