Initial commit
This commit is contained in:
319
edkb04op/EDKB04OP/EDKB04OP.vb
Normal file
319
edkb04op/EDKB04OP/EDKB04OP.vb
Normal file
@@ -0,0 +1,319 @@
|
||||
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
|
||||
'<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
|
||||
|
||||
|
||||
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 = "<?xml version="
|
||||
splitter = Split(data, splitstring)
|
||||
For i As Integer = 1 To splitter.Length - 1
|
||||
If XMLtoObj(splitstring + splitter(i)) = True Then
|
||||
'If XMLtoObj(data) = True Then
|
||||
newending = ".xml"
|
||||
Else
|
||||
newending = ".err"
|
||||
End If
|
||||
Next
|
||||
|
||||
If Params.DebugMode Then
|
||||
'moven
|
||||
File.Move(dra.FullName, Params.DebugDir & filetimestamp + "_" + dra.Name & 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
|
||||
|
||||
#Region "MQ"
|
||||
|
||||
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
|
||||
'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
|
||||
Reference in New Issue
Block a user