edkb04/EDKB04OP/EDKB04OP.vb

''---------------------------------------------------------------------------------------------------------------------
'' Copyright TKB - all rights reserved
'' Erstellt am   : Unbekannt
'' Erstellt durch: Stefan Hutter, TKB
'' Fachbereich   : TEC
'' Beschreibung  : 
''
'' History       :
''--------------------------------------------------------------------------------------------------------------------
'' Datum       Name, Firma               Beschreibung
''--------------------------------------------------------------------------------------------------------------------
'' 22.05.2017  Tobias Verstappen, TKB    Programm so ergänzt, dass neue XML Files erkannt werden und in die EDOKA 
''                                       Datenbank gespeichert werden.
''--------------------------------------------------------------------------------------------------------------------
Imports System.Timers
Imports IBM.WMQ
Imports IBM
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
Imports System.Text.RegularExpressions
Imports IBM.WMQ.Nmqi


Public Class EDKB04OP
    Inherits System.ServiceProcess.ServiceBase
    Dim WithEvents tmrQueuePolling As Timer = New Timer(2000)
    Dim myStopper As ErrorStopper
    Dim fileWatch As New FileSystemWatcher()


#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
    '<MTAThread()> _
    '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
            'init BMS
#If CONFIG = "Release" Then
            Dim m_log1 As New bms.Logging(6, Common.Common.JobType.WatchJob)
            m_logOld = m_log1
#Else
            Dim m_log1 As New Globals.log
            m_logOld = 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

            Dim m_logAdapter As New Globals.LogAdapter
            m_log = m_logAdapter

            m_log.start()
            m_log.log("EDKB04: Start", Common.Common.JournalEntryType.Information)

            'Init Params
            Params.Loadparameters()
            m_log.log("EDKB04: Params.WaitForBrake= " & Params.WaitForBrake, Common.Common.JournalEntryType.Information)

            '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
            tmrQueuePolling.AutoReset = False
            If CInt(Params.TimerInterval) > 0 Then
                tmrQueuePolling.Start()
                m_log.log("EDKB04: tmrQueuePolling.Started")
            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, Optional ByVal filenameSuffix As String = "", Optional ByVal filenameBase As String = "") As String
        Dim result As Boolean = True
        Dim filename As String = ""
        Try
            Dim writer As System.IO.StreamWriter
            Dim filetimestamp As String = GetFormatNow()
            If filenameBase <> "" Then
                filetimestamp = filenameBase
            End If
            filename = Params.DebugDir & filetimestamp & filenameSuffix & ".xml"
            writer = IO.File.AppendText(filename)
            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 filename
    End Function

    Private Sub renameFromXmlToErr(ByVal filename As String)
        Try
            If filename.EndsWith(".xml") Then
                filename = filename.Substring(0, filename.Length - 4)
                File.Move(filename & ".xml", filename & ".err")
            End If
        Catch ex As Exception
            m_log.log("EDKB04: Error in renameFromXmlToErr()")
        End Try
    End Sub

#End Region

#Region "Timer"
    Public Sub OnTimedEvent(ByVal source As Object, ByVal e As ElapsedEventArgs) Handles tmrQueuePolling.Elapsed
        Try
            'm_log.log("EDKB04: OnTimedEvent called", Common.Common.JournalEntryType.Information)

            ReadfromMQ()
        Catch ex As Exception

            m_log.log("EDKB04: Exception catched in OnTimedEvent()")
        Finally

            tmrQueuePolling.Start()
            m_log.log("EDKB04: tmrQueuePolling.Started")
        End Try
    End Sub
#End Region

    Public Function IsKreditantragWizardMessage(Message As String) As Boolean
        Dim ret As Boolean
        ret = False
        Dim regex As Regex = New Regex("DokumentTypNr")
        Dim match As Match = regex.Match(Message)
        If match.Success Then
            ret = True
        End If
        Return ret
    End Function

    Private Function GetXmlFromDoc(XmlDoc As XmlDocument) As String
        Dim ret As String
        Using stringWriter = New StringWriter()
            Using xmlTextWriter = New System.Xml.XmlTextWriter(stringWriter)
                xmlTextWriter.Formatting = Formatting.Indented
                XmlDoc.WriteTo(xmlTextWriter)
                xmlTextWriter.Flush()
                ret = stringWriter.GetStringBuilder().ToString()
            End Using
        End Using
        Return ret
    End Function


    ''' <summary>
    ''' Fügt die TGNummer des Erstellers und die XML-Datei in die Datenbank (edk_data) ein.
    ''' </summary>
    ''' <param name="Message"></param>
    ''' <remarks></remarks>
    Sub InsertMessageIntoTableEdkData(Message As String)
        Dim sql As String
        Dim doc As New XmlDocument
        Dim node As XmlNode

        doc.LoadXml(Message)
        node = doc.SelectSingleNode("/action/actionId")
        'node.InnerText = "3"

        Message = Message.Replace("<actionId>" + node.InnerText + "</actionId>", "<actionId>3</actionId>") + vbCrLf

        'Message = doc.OuterXml
        'Message = GetXmlFromDoc(doc)
        'Holt die TGNummer des Erstellers aus dem XML
        Dim TGNummer As String = XmlHelper.GetItemValueByTagName(doc, "creatorTg")
        TGNummer = TGNummer.ToLower

        Using adapter As SqlDataAdapter = New SqlDataAdapter
            Using connection As SqlConnection = New SqlConnection(Globals.sConnectionString_edoka)

                sql = "insert into edk_data (TGNummer, Status, xmldata) values(@tgNummer, 0, @data)"
                Try
                    connection.Open()
                    Using insertCommand As SqlCommand = New SqlCommand(sql, connection)
                        adapter.InsertCommand = insertCommand
                        Dim dataBytes As Byte()
                        dataBytes = System.Text.Encoding.GetEncoding("iso-8859-1").GetBytes(Message)
                        adapter.InsertCommand.Parameters.AddWithValue("@data", dataBytes)
                        adapter.InsertCommand.Parameters.AddWithValue("@tgNummer", TGNummer)
                        adapter.InsertCommand.ExecuteNonQuery()
                    End Using
                Catch ex As Exception
                    m_log.log("EDKB04: InsertMessageIntoTableXmlData Error: " & ex.ToString())
                End Try
            End Using
        End Using
    End Sub

#Region "File Watcher"
    Private Sub OnFileEvent(ByVal source As Object, ByVal e As FileSystemEventArgs)
        Globals.archiveFilename = ""
        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()
                HandleXmlContent(data, dra.Name)
                File.Delete(dra.FullName)
            Next
        Catch ex As Exception
            m_log.log("EDKB04: FileWatcher Error: " & ex.Message, Common.Common.JournalEntryType.Error)
        End Try
    End Sub
#End Region

#Region "MQ"

    Private lastFormatNow As String = Format(Now, "yyyyMMddHHmmssffff")
    Private Function GetFormatNow() As String
        Dim thisFormatNow = Format(Now, "yyyyMMddHHmmssffff")
        While thisFormatNow = lastFormatNow
            Threading.Thread.Sleep(5)
            thisFormatNow = Format(Now, "yyyyMMddHHmmssffff")
        End While
        lastFormatNow = thisFormatNow
        Return thisFormatNow
    End Function

    Private Function GetFilenameIndex(ByVal indexCounter As Integer)

    End Function

    Private Sub HandleXmlContent(ByVal strXMLContent As String, Optional ByVal givenFilename As String = "")
        Dim filename1 As String = ""
        Dim filename2 As String = ""
        'Me.Log("Message Content:" & strMsg)
        If Params.DebugMode Then
            If givenFilename <> "" Then
                If givenFilename.ToLower().EndsWith(".xml") Then
                    givenFilename = givenFilename.Substring(0, givenFilename.Length - 4)
                End If
                filename1 = givenFilename & "_" & GetFormatNow()
            Else
                filename1 = GetFormatNow()
            End If
        End If
        Globals.archiveFilename = filename1
        'm_log.Log("EDKB04: filename1 = " & filename1)
        'm_log.Log("EDKB04: Message Length:" & Len(strMsg) & " Chars", Common.Common.JournalEntryType.Information)

        Dim splitter() As String
        Dim splitstring = "<?xml version="
        splitter = Split(strXMLContent, splitstring,, CompareMethod.Text)

        ' look ahead: wieviele Xmls sind wirklich im strXMLContent
        Dim numberOfXmls As Integer = 0
        For i As Integer = 0 To splitter.Length - 1
            Dim xml As String = splitter(i)
            If xml.Trim() <> "" Then
                numberOfXmls = numberOfXmls + 1
            End If
        Next

        Dim filenameIndex As Integer = 1
        If numberOfXmls > 1 Then
            If Params.WriteUnsplittedFile > 0 Then
                Me.writeDebug(strXMLContent, "unsplitted", filename1)
            End If
        Else
            'kein Filename Index, wenn nur ein Xml da ist
            filenameIndex = 0
        End If

        For i As Integer = 0 To splitter.Length - 1
            Dim xml As String = splitter(i)
            If xml.Trim() <> "" Then

                xml = splitstring + splitter(i)
                If Params.DebugMode Then
                    Dim filenameIndexText As String = ""
                    If filenameIndex > 0 Then
                        filenameIndexText = String.Format("split{0,5:D5}", filenameIndex)
                    End If
                    filename2 = Me.writeDebug(xml, filenameIndexText, filename1)
                    'm_log.Log("EDKB04: filename2 = " & filename2)
                    filenameIndex = filenameIndex + 1
                End If
                If Not XMLtoObj(xml) Then
                    If Params.DebugMode Then
                        Me.renameFromXmlToErr(filename2)
                    End If
                End If

                If Params.WaitForBrake > 0 Then
                    Dim currentDate1 As DateTime = DateTime.Now
                    Threading.Thread.Sleep(Params.WaitForBrake)
                    Dim currentDate2 As DateTime = DateTime.Now
                    Dim elapsedTicks As Long = currentDate2.Ticks - currentDate1.Ticks
                    Dim elapsedSpan As TimeSpan = New TimeSpan(elapsedTicks)
                    m_log.log(String.Format("EDKB04: elapsedTicks = {0}", elapsedTicks))
                End If
            End If
        Next
    End Sub


    Private Function ReadfromMQ() As Boolean
        Globals.archiveFilename = ""
        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)
                Globals.archiveFilename = ""
                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)
                        strMsg = strMsg
                        strXMLContent = strMsg
                        HandleXmlContent(strXMLContent)
                        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
        If (IsKreditantragWizardMessage(strXMLContent)) Then
            InsertMessageIntoTableEdkData(strXMLContent)
            result = True
        Else
            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
        End If
        Return result
    End Function
#End Region




End Class