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 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() Dim ServicesToRun() As System.ServiceProcess.ServiceBase ' Innerhalb desselben Prozesses können mehrere NT-Dienste ausgeführt werden. Um einen ' weiteren Dienst zum Prozess hinzuzufügen, änderen Sie die folgende Zeile, ' um ein zweites Dienstprojekt zu erstellen. Z.B., ' ' ServicesToRun = New System.ServiceProcess.ServiceBase () {New Service1, New MySecondUserService} ' 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. Private Sub InitializeComponent() components = New System.ComponentModel.Container() Me.ServiceName = "Service1" End Sub #End Region Dim WithEvents fwinput As New FileSystemWatcher Protected Overrides Sub OnStart(ByVal args() As String) PrintLog("Start EDKB07") 'BUD - 12.10.2006 - BMS eingebaut Job 9 Try Dim m_log1 As New bms.Logging(9, Common.Common.JobType.WatchJob) m_log = m_log1 m_log.Start() Catch ex As Exception WirteLog("BMS-Connection / XML: " + ex.Message, ApplicationPath() + "Error.txt") Exit Sub End Try Dim fwinput As New FileSystemWatcher Try PrintLog("1") 'Definition der Remotingklasse aus dem Applikationskonfigurationsfile lesen PrintLog(AppDomain.CurrentDomain.SetupInformation.ConfigurationFile) RemotingConfiguration.Configure(AppDomain.CurrentDomain.SetupInformation.ConfigurationFile,False) PrintLog("2") 'XML-Konfigurationsfile einlesen und damit Variabeln der Globals-Klasse füllen Dim xmldoc As New XmlDocument Globals.PrintLog("Applpath:" & Me.ApplicationPath) xmldoc.Load(Me.ApplicationPath & "EDKB07.XML") Globals.sConnectionString = xmldoc.SelectSingleNode("/Configuration/SQLConnectionString").InnerText Globals.conn_edoka.sConnectionString = Globals.sConnectionString Globals.PrintLog("EDOKA-Connection::" & Globals.sConnectionString) Globals.conn_journale.sConnectionString = xmldoc.SelectSingleNode("/Configuration/SQLConnectionStringJournale").InnerText Globals.sConnectionString_journale = xmldoc.SelectSingleNode("/Configuration/SQLConnectionStringJournale").InnerText Globals.PrintLog("Journale-Connection::" & Globals.sConnectionString_journale) Globals.DruckjobParameter = xmldoc.SelectSingleNode("/Configuration/bldruckjobParam").InnerText 'Neuer Avaloq Parameter Globals.DruckjobParameterAVQ = xmldoc.SelectSingleNode("/Configuration/bldruckjobParamXOMA").InnerText Globals.ColdOutputFolder = xmldoc.SelectSingleNode("/Configuration/ColdOutputFolder").InnerText Globals.Deckblatt = xmldoc.SelectSingleNode("/Configuration/BLDruckDeckblatt").InnerText Globals.Schlussblatt = xmldoc.SelectSingleNode("/Configuration/BLDruckSchlussblatt").InnerText Globals.TempPath = xmldoc.SelectSingleNode("/Configuration/TempFilePath").InnerText Globals.OutputFolder = xmldoc.SelectSingleNode("/Configuration/EDKB07OutputFolder").InnerText Globals.UseTestMode = xmldoc.SelectSingleNode("/Configuration/UseTestMode").InnerText Globals.TestParamFilePath = xmldoc.SelectSingleNode("/Configuration/TestParamFilePath").InnerText Globals.ParamFileOutputPath = xmldoc.SelectSingleNode("/Configuration/ParamFileOutputPath").InnerText Globals.CMDFilePath = xmldoc.SelectSingleNode("/Configuration/CMDFilePath").InnerText Globals.CMDFile1Content = xmldoc.SelectSingleNode("/Configuration/CMDFile1Content").InnerText Globals.CMDFile2Content = xmldoc.SelectSingleNode("/Configuration/CMDFile2Content").InnerText Globals.PSPrinter = xmldoc.SelectSingleNode("/Configuration/PSPrinter").InnerText Globals.Vorlagenverzeichnis = xmldoc.SelectSingleNode("/Configuration/Vorlagenverzeichnis").InnerText Globals.Workverzeichnis = xmldoc.SelectSingleNode("/Configuration/Workverzeichnis").InnerText Globals.psdir = xmldoc.SelectSingleNode("/Configuration/PSDir").InnerText Globals.PDFdir = xmldoc.SelectSingleNode("/Configuration/PDFDir").InnerText Globals.PrintLog("Vorlagenverzeichnis:" + Vorlagenverzeichnis, EventLogEntryType.Information) Globals.PrintLog("Workverzeichnis:" + Workverzeichnis, EventLogEntryType.Information) Globals.PrintLog("PSDir:" + psdir, EventLogEntryType.Information) Globals.PrintLog("PDFDir:" + PDFdir, EventLogEntryType.Information) Globals.PrintLog("PSPrinter:" + PSPrinter, EventLogEntryType.Information) Globals.DokPerPackage = xmldoc.SelectSingleNode("/Configuration/DokPerPackage").InnerText 'File-Watcher konfigurieren, dass er nur auf .ret-Files reagiert 'File-Watcher konfigurieren, dass er nur auf .ret-Files reagiert Globals.ProcessToKill = xmldoc.SelectSingleNode("/Configuration/ProcessToKill").InnerText Try Globals.ProcessIdleTime = CInt(xmldoc.SelectSingleNode("/Configuration/ProcessIdleTime").InnerText) Catch ex As Exception Globals.ProcessIdleTime = 525600 ' entspricht einem Jahr End Try Globals.OwnName = xmldoc.SelectSingleNode("/Configuration/OwnName").InnerText Globals.OtherBatch1 = xmldoc.SelectSingleNode("/Configuration/OtherBatch1").InnerText Globals.OtherBatch2 = xmldoc.SelectSingleNode("/Configuration/OtherBatch2").InnerText Globals.OtherBatch3 = xmldoc.SelectSingleNode("/Configuration/OtherBatch3").InnerText Globals.NameDistiller = xmldoc.SelectSingleNode("/Configuration/NameDistiller").InnerText Globals.PathDistiller = xmldoc.SelectSingleNode("/Configuration/PathDistiller").InnerText Globals.OpenModeDistiller = xmldoc.SelectSingleNode("/Configuration/OpenModeDistiller").InnerText Globals.PrintLog("Vor SHU", EventLogEntryType.Information) 'SHU 20120104 Try Globals.Beilage_1 = xmldoc.SelectSingleNode("/Configuration/Beilage_1").InnerText Globals.PrintLog("Beilage 1 " + Globals.Beilage_1, EventLogEntryType.Information) Globals.Beilage_2 = xmldoc.SelectSingleNode("/Configuration/Beilage_2").InnerText Globals.PrintLog("Beilage 1 " + Globals.Beilage_2, EventLogEntryType.Information) Globals.Beilage_3 = xmldoc.SelectSingleNode("/Configuration/Beilage_3").InnerText Globals.PrintLog("Beilage 3 " + Globals.Beilage_3, EventLogEntryType.Information) Globals.Beilage_1_ab = xmldoc.SelectSingleNode("/Configuration/Beilage_1_AbDatum").InnerText Globals.PrintLog("Beilage 1 ab " + Globals.Beilage_1_ab, EventLogEntryType.Information) Globals.Beilage_2_ab = xmldoc.SelectSingleNode("/Configuration/Beilage_2_AbDatum").InnerText Globals.PrintLog("Beilage 2 ab " + Globals.Beilage_2_ab, EventLogEntryType.Information) Globals.Beilage_3_ab = xmldoc.SelectSingleNode("/Configuration/Beilage_3_AbDatum").InnerText Globals.PrintLog("Beilage 3 ab " + Globals.Beilage_3_ab, EventLogEntryType.Information) Catch ex As Exception Globals.PrintLog(ex.Message, EventLogEntryType.Information) End Try Me.fwinput.Path = Globals.ColdOutputFolder 'Me.fwinput.Filter = "*.ret" Me.fwinput.EnableRaisingEvents = True 'Log-Eintrag beginnen beim Start der Applikation Dim log As New clsLog Globals.PrintLog("Vor Start Log:", EventLogEntryType.Information) log.Startlog(1) log.InsertJournale("EDKB07: Start EDKB07 " & CType(Now, String), clsLog.Enum_InfoTyp.Keine) 'Cold Mehrfachdruck Initialisierung / BUD / 10.01.2006 Init_ColdMehrfachdruck() log = Nothing Catch ex As Exception PrintLog(ex.Message, EventLogEntryType.Error) Dim log As New clsLog log.Startlog(1) log.InsertJournale("EDKB07: Fehler beim Starten von EDKB07 " & CType(Now, String) & " Error: " & ex.Message, clsLog.Enum_InfoTyp.Fehler) log = Nothing End Try End Sub Private Sub Init_ColdMehrfachdruck() 'Initialisiert den ColdMehrfachdruck, d.h. liest da Configfile 'BUD / 10.01.2006 Try Dim xmlColdMehrfachdruck As New XmlDocument xmlColdMehrfachdruck.Load(Me.ApplicationPath & "EDKB07_ColdMehrfach.XML") Global_md_ColdMDOutputFolder = xmlColdMehrfachdruck.SelectSingleNode("/Configuration/ColdMDOutputFolder").InnerText() Global_md_TempFilePath = xmlColdMehrfachdruck.SelectSingleNode("/Configuration/TempFilePath").InnerText() Global_md_EDKB07_MDOutputFolder = xmlColdMehrfachdruck.SelectSingleNode("/Configuration/EDKB07_MDOutputFolder").InnerText() Global_md_ParamFileOutputPath = xmlColdMehrfachdruck.SelectSingleNode("/Configuration/ParamFileOutputPath").InnerText() Global_md_CMDFilePath = xmlColdMehrfachdruck.SelectSingleNode("/Configuration/CMDFilePath").InnerText() Global_md_CMDFile1Content = xmlColdMehrfachdruck.SelectSingleNode("/Configuration/CMDFile1Content").InnerText() Global_md_CMDFile2Content = xmlColdMehrfachdruck.SelectSingleNode("/Configuration/CMDFile2Content").InnerText() Global_md_ParamCfgAvaloq = xmlColdMehrfachdruck.SelectSingleNode("/Configuration/ParamCfgAVALOQ").InnerText() Global_md_ParamCfgEdoka = xmlColdMehrfachdruck.SelectSingleNode("/Configuration/ParamCfgEdoka").InnerText() Global_md_ParamCfgHost = xmlColdMehrfachdruck.SelectSingleNode("/Configuration/ParamCfgHost").InnerText() Global_md_ParamCfgZv = xmlColdMehrfachdruck.SelectSingleNode("/Configuration/ParamCfgZv").InnerText() Global_md_MaxWaitTime = xmlColdMehrfachdruck.SelectSingleNode("/Configuration/MaxWaitTime").InnerText() Global_md_UseTestMode = xmlColdMehrfachdruck.SelectSingleNode("/Configuration/UseTestMode").InnerText() Catch ex As Exception m_log.Log("Service1:Init_ColdMehrfachdruck:" + ex.Message + ex.StackTrace, Common.Common.JournalEntryType.Warning) PrintLog(ex.Message, EventLogEntryType.Error) Dim log As New clsLog log.Startlog(1) log.InsertJournale("EDKB07: Cold Mehrfachdruck Initialisieren fehlgeschlagen. " & CType(Now, String) & " Error: " & ex.Message, clsLog.Enum_InfoTyp.Fehler) log = Nothing Global_md_Error = 1 End Try End Sub Protected Overrides Sub OnStop() Try Dim log As New clsLog log.InsertJournale("EDKB07: Stop EDKB07 " & CType(Now, String), clsLog.Enum_InfoTyp.Keine) 'BUD - 12.10.2006 - BMS eingefügt m_log.Ende() Catch ex As Exception WirteLog("BMS-Connection / XML: " + ex.Message, ApplicationPath() + "Error.txt") Exit Sub End Try End Sub Private Sub WirteLog(ByVal stext As String, ByVal sPfad As String) 'BUD - 12.10.2006 - BMS eingefügt 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 Private Sub fwInput_Created(ByVal sender As Object, ByVal e As System.IO.FileSystemEventArgs) Handles fwinput.Created System.Threading.Thread.Sleep(5000) 'Wenn ein .ret-File erstellt wurde Prozedur CheckForRetFiles aufrufen Me.CheckForRetFiles() End Sub Public Sub CheckForRetFiles() Dim inputFile As String Dim inputFileFullPath As String Dim fi As FileInfo Dim dir As New DirectoryInfo(fwinput.Path) 'Alle Files im überwachten Verzeichnis überprüfen Threading.Thread.Sleep(1000) For Each fi In dir.GetFiles If fi.Extension = ".ret" Then 'Wenn ein .ret-File gefunden wird Prozedur ProcessColdOutput aufrufen Dim s As String If File.Exists(fi.FullName) Then s = fi.FullName Try Rename(s, s + "_done") Catch ex As Exception m_log.Log("Service1:CheckForRetFiles:" + ex.Message + ex.StackTrace, Common.Common.JournalEntryType.Warning) End Try inputFile = fi.Name + "_done" inputFileFullPath = fi.FullName + "_done" ProcessColdOutput(inputFile, inputFileFullPath) 'ModPrintjob.Print_Docs(7703, 0) End If End If 'Erweiterung um den "FAILED" Fall abzufangen If fi.Extension = ".FAILED" Then 'Wenn ein .FAILED-File gefunden wird Prozedur ProcessColdOutputNOK aufrufen Dim s As String If File.Exists(fi.FullName) Then s = fi.FullName Try Rename(s, s + "_done") Catch ex As Exception m_log.Log("Service1:CheckForFailedFiles:" + ex.Message + ex.StackTrace, Common.Common.JournalEntryType.Warning) End Try inputFile = fi.Name + "_done" inputFileFullPath = fi.FullName + "_done" ProcessColdOutputNOK(inputFile, inputFileFullPath) End If End If Next End Sub Public Sub ProcessColdOutput(ByVal fname As String, ByVal fullpath As String) Dim log As New clsLog Dim SqlConn As New SqlConnection SqlConn.ConnectionString = Globals.sConnectionString Dim SqlCmd As New SqlCommand Dim TGNr, Timestmp, partno As String Dim erstelltam As String TGNr = Left(fname, fname.Length - (16 + 9)) ' TGNr = Mid(fname, 1, 13) 'TG-Nummer aus dem Dateinamen extrahieren Timestmp = Mid(fname, Len(TGNr) + 3, fname.Length - (Len(TGNr) + 11)) 'Timestamp aus dem Dateinamen extrahieren partno = Mid(fname, Len(TGNr) + 1, 2) 'TGNr = Mid(fname, 1, 6) 'TG-Nummer aus dem Dateinamen extrahieren 'Timestmp = Mid(fname, 7, 14) 'Timestamp aus dem Dateinamen extrahieren 'Den Timestamp formatieren, dass dieser in einer DB-Abfrage verwendet werden kann 'erstelltam = Mid(Timestmp, 1, 4) & "-" & Mid(Timestmp, 5, 2) & "-" & Mid(Timestmp, 7, 2) & " " & Mid(Timestmp, 9, 2) & ":" & Mid(Timestmp, 11, 2) & ":" & Mid(Timestmp, 13, 2) erstelltam = Timestmp '.ret-File öffnen und lesen Dim oReader As StreamReader oReader = New StreamReader(fullpath) Dim s As String s = oReader.ReadLine If s <> "" Then 'Rückmeldung von Cold, Aufbereitung OK oReader.Close() log.InsertJournale("EDKB07: Rückmeldung von Cold, Aufbereitung OK " & CType(Now, String) & " TGNr: " & TGNr & " Erstelltam: " & Timestmp, clsLog.Enum_InfoTyp.Keine) Dim PartnerKurzname As String = "" Dim AnzahlDokumente, PartnerNr As Integer Dim DR As SqlDataReader 'Angaben zum Druckjob aus der DB lesen SqlCmd.CommandText = "SP_EDEX_BL_GET_DRUCK_PDFParameter" SqlCmd.CommandType = CommandType.StoredProcedure SqlCmd.Parameters.AddWithValue("@Userid", TGNr) SqlCmd.Parameters.AddWithValue("@filetimestamp", erstelltam) SqlCmd.Connection = SqlConn SqlConn.Open() DR = SqlCmd.ExecuteReader() While DR.Read AnzahlDokumente = DR.Item("anzahl_dokumente") PartnerNr = DR.Item("nrpar00") PartnerKurzname = DR.Item("BKPAR00") End While SqlConn.Close() SqlCmd.Parameters.Clear() Dim verarbeitung As New EDKB07WS.Verarbeitung oReader.Close() 'Funktion zum hinzufügen der Deckblätter und der Zusammenfassung aufrufen If verarbeitung.AddPageToPDF(TGNr, Timestmp, AnzahlDokumente, PartnerNr, PartnerKurzname, partno) Then Try File.Delete(fullpath) '.ret-File löschen Catch ex As Exception m_log.Log("Service1:CheckForRetFiles:" + ex.Message + ex.StackTrace, Common.Common.JournalEntryType.Warning) End Try 'Status auf 'aufbereitet' (2) ändern SqlCmd.CommandText = "SP_EDEX_BL_UPDATE_DRUCK_Status" SqlCmd.CommandType = CommandType.StoredProcedure SqlCmd.Parameters.AddWithValue("@Status", 2) SqlCmd.Parameters.AddWithValue("@Userid", TGNr) SqlCmd.Parameters.AddWithValue("@erstelltam", erstelltam) SqlCmd.Parameters.AddWithValue("@part", Val(partno)) SqlCmd.Connection = SqlConn SqlConn.Open() SqlCmd.ExecuteNonQuery() SqlConn.Close() SqlCmd.Parameters.Clear() Else 'Fehler beim ergänzen des PDF-Files oder beim speichern in die Datenbank 'Status auf 'abvereckt' (3) ändern SqlCmd.CommandText = "SP_EDEX_BL_UPDATE_DRUCK_Status" SqlCmd.CommandType = CommandType.StoredProcedure SqlCmd.Parameters.AddWithValue("@Status", 3) SqlCmd.Parameters.AddWithValue("@Userid", TGNr) SqlCmd.Parameters.AddWithValue("@erstelltam", erstelltam) SqlCmd.Parameters.AddWithValue("@part", Val(partno)) SqlCmd.Connection = SqlConn SqlConn.Open() SqlCmd.ExecuteNonQuery() SqlConn.Close() SqlCmd.Parameters.Clear() End If Else 'Rückmeldung von Cold, Aufbereitung fehlerhaft log.InsertJournale("EDKB07_BL: Fehler von Cold " & CType(Now, String) & " TGNr: " & TGNr & " Erstelltam: " & Timestmp, clsLog.Enum_InfoTyp.Keine) 'Status auf 'abvereckt' (3) ändern SqlCmd.CommandText = "SP_EDEX_BL_UPDATE_DRUCK_Status" SqlCmd.CommandType = CommandType.StoredProcedure SqlCmd.Parameters.AddWithValue("@Status", 3) SqlCmd.Parameters.AddWithValue("@Userid", TGNr) SqlCmd.Parameters.AddWithValue("@erstelltam", erstelltam) SqlCmd.Connection = SqlConn SqlConn.Open() SqlCmd.ExecuteNonQuery() SqlConn.Close() SqlCmd.Parameters.Clear() End If 'Überprüfung auf .ret-Files nochmals aufrufen, da in der Zwischenzeit eine weiter Datei 'hätte ankommen könne, auf die der Filewatcher nicht reagiert hat Me.CheckForRetFiles() End Sub Public Sub ProcessColdOutputNOK(ByVal fname As String, ByVal fullpath As String) Dim log As New clsLog Dim SqlConn As New SqlConnection SqlConn.ConnectionString = Globals.sConnectionString Dim SqlCmd As New SqlCommand Dim TGNr, Timestmp, partno As String Dim erstelltam As String 'TGI62430020080918174819.FAILED_done 'TGI62430020080918174819.RET TGNr = Left(fname, fname.Length - (16 + 12)) 'TG-Nummer aus dem Dateinamen extrahieren Timestmp = Mid(fname, Len(TGNr) + 3, fname.Length - (Len(TGNr) + 14)) 'Timestamp aus dem Dateinamen extrahieren partno = Mid(fname, Len(TGNr) + 1, 2) erstelltam = Timestmp 'Rückmeldung von Cold, Aufbereitung fehlerhaft 'log.InsertJournale("EDKB07_BL: Fehler von Cold " & CType(Now, String) & " TGNr: " & TGNr & " Erstelltam: " & Timestmp, clsLog.Enum_InfoTyp.Keine) SqlCmd.CommandText = "SP_EDEX_BL_UPDATE_DRUCK_Status" SqlCmd.CommandType = CommandType.StoredProcedure SqlCmd.Parameters.AddWithValue("@Status", 3) SqlCmd.Parameters.AddWithValue("@Userid", TGNr) SqlCmd.Parameters.AddWithValue("@erstelltam", erstelltam) SqlCmd.Parameters.AddWithValue("@part", Val(partno)) SqlCmd.Connection = SqlConn SqlConn.Open() SqlCmd.ExecuteNonQuery() SqlConn.Close() SqlCmd.Parameters.Clear() 'Überprüfung auf Files nochmals aufrufen, da in der Zwischenzeit eine weiter Datei 'hätte ankommen könne, auf die der Filewatcher nicht reagiert hat Me.CheckForRetFiles() End Sub Public Function ApplicationPath() As String Return Path.GetDirectoryName([Assembly].GetEntryAssembly().Location) + "\" End Function End Class