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 Public Class EDKB04 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 EDKB04} System.ServiceProcess.ServiceBase.Run(ServicesToRun) End Sub #End Region Protected Overrides Sub OnStart(ByVal args() As String) Try Dim FileWatch As New FileSystemWatcher() 'init BMS Dim m_log1 As New bms.Logging(6, Common.Common.JobType.WatchJob) m_log = m_log1 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 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 #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 For Each dra In diar1 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") If XMLtoObj(data) = True Then If DBImport() = True Then newending = ".xml" Else newending = ".err" End If End If If Params.DebugMode Then 'moven File.Move(dra.FullName, Params.DebugDir & filetimestamp & newending) Else 'deleten File.Delete(dra.FullName) End If Next Catch ex As Exception m_log.Log("EDKB04: FileWatcher Error: " & ex.Message, Common.Common.JournalEntryType.Error) End Try End Sub #End Region Private Function DBImport() As Boolean '---------------Import in DB-------------- Dim result As Boolean 'm_log.Log("EDKB04: DB Abgleich START", Common.Common.JournalEntryType.Information) result = DBHandling.Init(XMLHandling.Stamm1) 'Transformation starten If result Then result = Stamm1.Transform End If If result And XMLHandling.Stamm1.HasPartnerNat Then result = DBHandling.partnerNat() End If If result And XMLHandling.Stamm1.HasPartnerJur Then result = DBHandling.partnerJur() End If If result And XMLHandling.Stamm1.HasHauptadresse Then result = DBHandling.partnerHauptadresse() End If If result And XMLHandling.Stamm1.HasVersandadresse Then result = DBHandling.partnerVersandadresse() End If If result And XMLHandling.Stamm1.HasMitarbeiter Then result = DBHandling.Mitarbeiter() End If If result And XMLHandling.Stamm1.HasVV Then result = DBHandling.VV() End If If result Then m_log.Log("EDKB04: DB Abgleich ENDE", Common.Common.JournalEntryType.Information) Else If Me.myStopper.insert Then m_log.Log("EDKB04: DB Abgleich ERROR", Common.Common.JournalEntryType.Error) End If 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) result = XMLHandling.Load(strXMLContent) '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 Private Function ReadfromMQ() As Boolean Dim mqQMgr As MQQueueManager '* MQQueueManager instance Dim mqQueue As MQQueue = Nothing '* MQQueue instance Dim queueName As String '* Name of queue to use Dim strMsg As String Dim result As Boolean tmrQueuePolling.Stop() 'm_log.Log("EDKB04: Start MQ Verbindungsaufbau", Common.Common.JournalEntryType.Information) queueName = Params.MQQueueName Try MQEnvironment.Hostname = Params.MQHostname 'Bsp: "vb0049d" MQEnvironment.Port = Params.MQPort 'Bsp: 1416 MQEnvironment.Channel = Params.MQChannel 'Bsp: "TGKB.D16.EDOKA.CL" Try mqQMgr = New MQQueueManager() mqQueue = mqQMgr.AccessQueue(queueName, MQC.MQOO_INPUT_AS_Q_DEF + MQC.MQOO_FAIL_IF_QUIESCING) '* open queue for input but not if MQM stopping Catch ex As Exception m_log.Log("EDKB04: MQ Error: " & ex.Message, Common.Common.JournalEntryType.Error) End Try Catch mqe As IBM.WMQ.MQException m_log.Log("EDKB04: Error: " & mqe.Message, Common.Common.JournalEntryType.Error) m_log.Log("EDKB04: Errorcode: " & mqe.CompletionCode, Common.Common.JournalEntryType.Error) m_log.Log("EDKB04: Reasoncode: " & mqe.ReasonCode, Common.Common.JournalEntryType.Error) End Try Try Dim isContinue As Boolean = True Dim strXMLContent As String Do While (isContinue = True) Dim mqMsg As MQMessage '* MQMessage instance Dim mqGetMsgOpts As MQGetMessageOptions '* MQGetMessageOptions instance mqMsg = New MQMessage() mqGetMsgOpts = New MQGetMessageOptions() Try If CInt(Params.TimerInterval) > 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 DBImport() 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 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 Class