Imports System.ServiceProcess Imports System.Threading Imports System.IO Imports System.Collections.Generic Imports Syncfusion.Pdf Imports Syncfusion.Pdf.Parsing Imports Syncfusion.Pdf.Graphics Imports Syncfusion.Pdf.Grid Imports System.Drawing Imports Newtonsoft Imports Microsoft.Office.Interop Imports System.Text Imports System.Net Imports Newtonsoft.Json Module Module1 Private StopThread As Boolean = False Dim WithEvents BCK_Timer As New Timers.Timer() Dim WithEvents Dokument_Timer As New Timers.Timer Dim Watch_Directory As String Dim FileWatch As New FileSystemWatcher() Dim EventStopped As Boolean = False Dim db As New clsdb Dim Base64_File As String Dim JsonString As String Dim mimetype As String Dim OutputFile As String Dim SendError As String = "" Dim sendToOnBase As Boolean = False Dim debug As Boolean = False Dim w As New Microsoft.Office.Interop.Word.Application Dim x As New Microsoft.Office.Interop.Excel.Application Dim dbupdate As Boolean = False Dim Parameters As New clsParams Dim arg_verarbeitungstyp As String = "" Dim arg_dokumentid As String Dim arg_debugfilename As String = "" Sub Main() Try 'Parameters 'STD: Standard-Datei (PDF; Office) 'BCK: Barcodekleber Dim args As String() = Environment.GetCommandLineArgs() For i As Integer = 1 To args.Length - 1 Select Case Left(UCase(args(i)), 2) Case "-T" arg_verarbeitungstyp = Right(args(i), 1) Case "-O" arg_dokumentid = Right(args(i), 22) Case "-D" debug = True Case "-S" sendToOnBase = True Case "-U" dbupdate = True Case "-F" arg_debugfilename = Right(args(i), Len(args(i)) - 2) Case Else Console.WriteLine("Verwendung EDOKA_IL_Manuell") Console.WriteLine("EDOKA_IL_Manuell.exe ") Console.WriteLine("-T[1;2] 1=BCK, 2=Standard-Dokument") Console.WriteLine("-O[EDOKA-DokumentID]") Console.WriteLine("-D Debug-Modus einschalten Standard=false") Console.WriteLine("-S Daten an OnBase senden Standard=false") Console.WriteLine("-U EDOKA-Update durchführen Standard=fasle") Console.WriteLine("_F[Dateiname] Debug-Datei Standard=Keine") Console.ReadLine() Exit Sub End Select Next PDebug("Verarbeitungstyp: " + arg_verarbeitungstyp) PDebug("Dokumentid: " + arg_dokumentid) PDebug("Debug: " + debug.ToString) PDebug("Debug-Filename :" + arg_debugfilename.ToString) PDebug("Send to OnBase: " + sendToOnBase.ToString) PDebug("EDOKA-Update: " + dbupdate.ToString) PDebug("Start Parameter aus .config lesen") Parameters.get_params() db.Connectionstring = Parameters.Connectionstring_EDOKA PDebug("DB-Connectionstring :" + db.Connectionstring) PDebug("Entry-Point IL: " + Parameters.EntryPoint_IL) Syncfusion.Licensing.SyncfusionLicenseProvider.RegisterLicense("OTU3NTQ3QDMyMzAyZTM0MmUzMFhyMnhJK1JNSCtETllyc1k5d0lyYzBBR1NQK2JDQlhpamFLdTN4UjNnenc9 ") 'If args(4) = "DEBUG" Then debug = True 'If args(5) = "UPDATE" Then dbupdate = True 'If args(3) = "SEND" Then sendToOnBase = True If arg_verarbeitungstyp = 1 Then bck_verarbeiten(arg_dokumentid) If arg_verarbeitungstyp = 2 Then std_verarbeiten(arg_dokumentid) w.Quit(SaveChanges:=False) x.ActiveWorkbook.Close(SaveChanges:=False) x.Quit() w.Quit() x = Nothing w = Nothing Catch ex As Exception End Try End Sub Public Sub PDebug(ByVal istring As String) istring = Now.ToString("dd.mm.yyyy hh.MM.ss") + " - " + istring If debug = True Then Console.WriteLine(istring) If arg_debugfilename <> "" Then Try FileOpen(1, arg_debugfilename, OpenMode.Append) WriteLine(1, istring) FileClose(1) Catch End Try End If End If End Sub Public Sub bck_verarbeiten(ByVal dokumentid As String) PDebug("BCK verarbeiten") Dim dt As New DataTable dt = db.Get_Pendente_BCK(dokumentid) For Each r As DataRow In dt.Rows OutputFile = Parameters.TempDir + "\" + r("dokumentid") + ".pdf" PDebug("Generiertes PDF: " + OutputFile) If Create_BCK_Dummy(r("dokumentid"), r("barcodenr")) Then PDebug("Base-64 Convert") Base64_File = ConvertFileToBase64(OutputFile) JsonString = "" PDebug("Create OnBase-Daten") Create_OnBase_Datastream(r("dokumentid")) PDebug(JsonString) If JsonString <> "" Then If Transfer_Onbase(r("dokumentid")) = True Then Dim stnr As Integer If Parameters.Demo = "0" Then If dbupdate = True Then PDebug("Update EDOKA-Datenbank") stnr = update_status(r("dokumentid")) db.update_dokument(stnr, r("dokumentid")) End If End If End If End If End If Next PDebug("BCK verarbeiten ende") End Sub Public Sub std_verarbeiten(ByVal dokumentid As String) PDebug("Standard verarbeiten") Dim dt As New DataTable dt = db.Get_Archivdokumente(dokumentid) For Each r As DataRow In dt.Rows Dim ofile As String ofile = Convert_Doc(r("dokumentid")) If ofile <> "" Then PDebug("Base-64 Convert") Base64_File = ConvertFileToBase64(ofile) JsonString = "" PDebug("Create OnBase-Daten") Create_OnBase_Datastream(r("dokumentid")) If JsonString <> "" Then PDebug(JsonString) If Transfer_Onbase(r("dokumentid")) = True Then Dim stnr As Integer If Parameters.Demo = 0 Then If dbupdate = True Then PDebug("Update EDOKA-Datenbank") stnr = update_status(r("dokumentid")) db.update_dokument(stnr, r("dokumentid")) End If End If End If End If End If Next PDebug("Standard verarbeiten ende") End Sub Public Function Create_BCK_Dummy(ByVal Dokumentid As String, ByVal barcodenr As String) As Boolean Try Dim document As New PdfDocument() Dim page As PdfPage = document.Pages.Add() Dim graphics As PdfGraphics = page.Graphics Dim font As PdfFont = New PdfStandardFont(PdfFontFamily.Helvetica, 20) graphics.DrawString("EDOKA-Barcode-Dokument - noch nicht eingescannt", font, PdfBrushes.Black, New PointF(0, 0)) graphics.DrawString("Dokument-ID: " + Dokumentid, font, PdfBrushes.Black, New PointF(0, 50)) graphics.DrawString("Barcode-Kleber: " + barcodenr, font, PdfBrushes.Black, New PointF(0, 75)) document.Save(Parameters.TempDir + "\" + Dokumentid + ".pdf") document.Close(True) PDebug("Dummy-PDF erfolgreich erstellt: " + Parameters.TempDir + "\" + Dokumentid + ".pdf") Return True Catch PDebug("Dummy-PDF konnte nicht erstellt werden") Return False End Try End Function Public Function update_status(ByVal dokumentid As String) As Integer PDebug("Update EDOKA-Status") Dim da As New DataTable da = db.Get_Status(dokumentid) For i As Integer = 0 To da.Rows.Count - 1 If da.Rows(i).Item("status_bezeichnungnr") = 3 Then For i1 As Integer = 0 To da.Rows.Count - 1 If da.Rows(i1).Item("status_bezeichnungnr") = 4 Or da.Rows(i1).Item("status_bezeichnungnr") = 5 Then db.insert_history_status(da.Rows(i1).Item("dokument_statusnr"), dokumentid) Return da.Rows(i1).Item("dokument_statusnr") End If Next End If If da.Rows(i).Item("status_bezeichnungnr") = 11 Then For i1 As Integer = 0 To da.Rows.Count - 1 If da.Rows(i1).Item("status_bezeichnungnr") = 6 Then db.insert_history_status(da.Rows(i1).Item("dokument_statusnr"), dokumentid) Return da.Rows(i1).Item("dokument_statusnr") End If Next End If Next End Function Private Sub Create_OnBase_Datastream(ByVal dokumentid As String) Dim ds As New DataSet ds = db.Get_OnBase_Datastream(dokumentid) Dim od As New OnBaseDokument od.dokumentTyp = ds.Tables(0).Rows(0).Item("Dokumenttyp") od.bpNummer = ds.Tables(0).Rows(0).Item("BPNummer") od.personNummer = ds.Tables(0).Rows(0).Item("PersonNummer") od.dokumentDatei = Base64_File od.dokumentDatum = ds.Tables(0).Rows(0).Item("Dokumentdatum") od.dateiTyp = "PDF" Dim Attribute As New List(Of attribute) For Each rw As DataRow In ds.Tables(1).Rows Dim p As New attribute With { .fieldname = rw("fieldname"), .fieldvalue = rw("fieldvalue") } Attribute.Add(p) Next od.attributes = Attribute JsonString = "" JsonString = Newtonsoft.Json.JsonConvert.SerializeObject(od, Newtonsoft.Json.Formatting.Indented) End Sub Public Function ConvertFileToBase64(ByVal fileName As String) As String Dim ReturnValue As String = "" If My.Computer.FileSystem.FileExists(fileName) Then Using BinaryFile As FileStream = New FileStream(fileName, FileMode.Open) Dim BinRead As BinaryReader = New BinaryReader(BinaryFile) Dim BinBytes As Byte() = BinRead.ReadBytes(CInt(BinaryFile.Length)) ReturnValue = Convert.ToBase64String(BinBytes) BinaryFile.Close() End Using End If Return ReturnValue End Function Public Function Transfer_Onbase(ByVal dokumentid As String) As Boolean Try PDebug("Transfer OnBase") If sendToOnBase = True Then PDebug("OnBase") Dim myUri As New Uri(Parameters.EntryPoint_IL) Dim data = Encoding.UTF8.GetBytes(JsonString) Dim response As String response = SendRequest_A(myUri, data, "application/json", "POST") PDebug("IL-Response") PDebug(response) Dim db As New clsdb PDebug("JSON-Datei: " + Parameters.TempDir & "\" + dokumentid + ".json") File.WriteAllText(Parameters.TempDir & "\" + dokumentid + ".json", JsonString) db.Update_EDOKA_IL_Status(dokumentid, "DEMO:" + dokumentid, "0") PDebug("Status in EDOKA-Journal nachführen") db.Update_EDOKA_IL_Status(dokumentid, response, SendError) If SendError = "1" Then Return False Else Return True Else PDebug("Kein OnBase-Transfer") PDebug("JSON-Datei: " + Parameters.TempDir & "\" + dokumentid + ".json") File.WriteAllText(Parameters.TempDir & "\" + dokumentid + ".json", JsonString) db.Update_EDOKA_IL_Status(dokumentid, "DEMO:" + dokumentid, "0") End If PDebug("Ende Transfer OnBase") Catch Return False End Try End Function Private Function SendRequest_A(uri As Uri, jsonDataBytes As Byte(), contentType As String, method As String) As String Dim response As String Dim request As WebRequest request = WebRequest.Create(uri) request.ContentLength = jsonDataBytes.Length request.ContentType = contentType request.Method = method Try Using requestStream As Stream = request.GetRequestStream requestStream.Write(jsonDataBytes, 0, jsonDataBytes.Length) requestStream.Close() Using responseStream As Stream = request.GetResponse.GetResponseStream Using reader As New StreamReader(responseStream) response = reader.ReadToEnd() End Using End Using End Using SendError = "0" Return response Catch ex As Exception SendError = "1" Return ex.Message End Try End Function '''Initialisierung des Filewacher-Objektes '''Das Filewacher-Objekt wird mit den entpsrechenden Pfad- sowie '''Dateifilter-Angaben initialisiert. Private Function Init_Filewatcher() As Boolean Try FileWatch.Path = Watch_Directory FileWatch.IncludeSubdirectories = False FileWatch.Filter = "*.*" Return True Catch ex As Exception 'Printout("Fehler bei der Initialisierung des Filewacherobjekts auf " + Watch_Directory + ex.Message, EventLogEntryType.Error) Return False End Try End Function '''Eventhandler des FileWatching-Objektes aktivieren Private Function Start_Watching() As Boolean Try AddHandler FileWatch.Created, New FileSystemEventHandler(AddressOf OnFileEvent) AddHandler FileWatch.Renamed, AddressOf OnFileEventRename FileWatch.EnableRaisingEvents = True 'PrintOut("Filewatch Event-Handler initialisiert: " + Me.Watch_Directory) Return True Catch ex As Exception 'Printout("Fehler bei der Event-Initialisierung " + ex.Message, EventLogEntryType.Error) Return False End Try End Function '''Aktivitäten im Inputverzeichnis verarbeiten '''Wird eine Datei mit der Endung .IND angeliefert, wird der Eventhandler '''gestoppt und die anstehenden Dokumente verarbeitet. ''' '''Nach abgeschlossener Verarbeitung wird der Eventhandler wieder '''eingeschaltet ''' ''' Private Sub OnFileEvent(ByVal source As Object, ByVal e As FileSystemEventArgs) If EventStopped = True Then Exit Sub If UCase(Microsoft.VisualBasic.Right(e.FullPath, 4)) = ".IND" Or UCase(Microsoft.VisualBasic.Right(e.FullPath, 4)) = ".XML" Then FileWatch.EnableRaisingEvents = False EventStopped = True 'IntSleep(Params.WaitAfterFileevent) 'If UCase(Microsoft.VisualBasic.Right(e.FullPath, 4)) = ".XML" Then ' IntSleep(Params.Wait_before_xmlind_ren) ' Rename(e.FullPath, e.FullPath + ".ind") ' PrintTempJournal("Fileevent Rename XML: " + e.FullPath + " -> " + e.FullPath + ".ind") 'End If 'PrintOut("Neue Datei " + e.FullPath) FileWatch.EnableRaisingEvents = True End If End Sub Private Sub OnFileEventRename(ByVal source As Object, ByVal e As RenamedEventArgs) 'If Params.UseFileEventRename = False Then Exit Sub 'If EventStopped = True Then Exit Sub 'If UCase(Microsoft.VisualBasic.Right(e.FullPath, 4)) = ".IND" Then ' FileWatch.EnableRaisingEvents = False ' EventStopped = True ' PrintOut("Neue Datei " + e.FullPath) ' '20130131 - Sleep von 1000 auf 3000 geändert, damit bei FinFox-Dokumente die Verarbeitung nicht aussteigt, sofern die Datei noch nicht angeliefert wurde ' FileWatch.EnableRaisingEvents = True 'End If End Sub #Region "Converter" Public Function Convert_Doc(ByVal dokumentid As String) As String Try PDebug("Start Convert Doc") Dim dok As New DataTable dok = db.Get_Dokument(dokumentid) PDebug("Dok Read OK") mimetype = GetDocType(dok.Rows(0).Item("dokumentname")) PDebug(mimetype) Dim filename As String filename = Parameters.TempDirOffice + "\" + dokumentid + "." + mimetype If File.Exists(filename) Then File.Delete(filename) Thread.Sleep(500) End If db.Get_From_DB(dokumentid, filename) OutputFile = "" Select Case UCase(mimetype) Case "DOC", "DOCX", "DOCM", "DOT", "DOTX", "DOTM" OutputFile = Parameters.TempDir + "\" + dokumentid + ".pdf" If Parameters.AsOffice.IndexOf(dok.Rows(0).Item("dokumenttypnr")) > -1 Then OutputFile = Parameters.TempDir + "\" + dokumentid + "." + mimetype FileCopy(filename, OutputFile) PDebug("Datei kopieren: " + filename + " nach " + OutputFile) Return OutputFile End If 'filename = "K:\EDOKA\__OnBase\dok1.docm" PDebug("Word-Dokument konvertieren: " + filename + " nach " + OutputFile) If Convert_Word(filename, OutputFile) Then Return OutputFile Else Return "" Case "XLS", "XLSX", "XLSM", "XLT", "XLTX", "XLTM" OutputFile = Parameters.TempDir + "\" + dokumentid + ".pdf" If Parameters.AsOffice.IndexOf(dok.Rows(0).Item("dokumenttypnr")) > -1 Then OutputFile = Parameters.TempDir + "\" + dokumentid + "." + mimetype FileCopy(filename, OutputFile) PDebug("Datei kopieren: " + filename + " nach " + OutputFile) Return OutputFile End If PDebug("Excel-Dokument konvertieren: " + filename + " nach " + OutputFile) If Convert_Excel(filename, OutputFile) Then Return OutputFile Else Return "" Case "PDF", "JPG", "TIF" OutputFile = Parameters.TempDir + "\" + dokumentid + "." + mimetype FileCopy(filename, OutputFile) PDebug("Datei kopieren: " + filename + " nach " + OutputFile) Return OutputFile Case Else OutputFile = Parameters.TempDir + "\" + dokumentid + "." + mimetype FileCopy(filename, OutputFile) PDebug("Datei kopieren: " + filename + " nach " + OutputFile) Return OutputFile End Select Catch ex As Exception PDebug(ex.Message) End Try End Function Dim WithEvents WordTimer As New Timers.Timer Dim WithEvents ExcelTimer As New Timers.Timer Public Function Convert_Word(ByVal filename As String, ByVal outputfile As String) As Boolean PDebug(filename) PDebug(outputfile) WordTimer.Interval = 20000 WordTimer.Enabled = True Try If w.Documents.Count > 0 Then For i As Integer = 1 To w.Documents.Count w.Documents(i).Saved = True w.Documents(i).Close(SaveChanges:=False) Next End If Catch ex As Exception w = Nothing w = New Microsoft.Office.Interop.Word.Application End Try Try w.Documents.Open(FileName:=filename.ToString, ReadOnly:=True) w.ActiveDocument.ExportAsFixedFormat(outputfile.ToString, Word.WdExportFormat.wdExportFormatPDF, , Word.WdExportOptimizeFor.wdExportOptimizeForPrint, Word.WdExportRange.wdExportAllDocument, , , Word.WdExportItem.wdExportDocumentContent, True, True, Word.WdExportCreateBookmarks.wdExportCreateNoBookmarks, True, False, False) w.ActiveDocument.Saved = True w.ActiveDocument.Close(SaveChanges:=False) WordTimer.Enabled = False Return True Catch ex As Exception Try w.Quit(SaveChanges:=False) Catch End Try Try w = Nothing Catch End Try Try w = New Microsoft.Office.Interop.Word.Application Catch End Try Return False End Try WordTimer.Enabled = False End Function Public Sub WordTimer_Elapsed(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Handles WordTimer.Elapsed Dim processArray As Process() = Process.GetProcessesByName("winword") For Each p As Process In processArray p.Kill() Next WordTimer.Enabled = False End Sub Public Sub ExcelTimer_Elapsed(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Handles WordTimer.Elapsed Dim processArray As Process() = Process.GetProcessesByName("excel") For Each p As Process In processArray p.Kill() Next ExcelTimer.Enabled = False End Sub Public Function Convert_Excel(ByVal filename As String, ByVal outputfile As String) As Boolean ExcelTimer.Interval = 20000 ExcelTimer.Enabled = True Try If x.Workbooks.Count > 0 Then For i As Integer = 1 To x.Workbooks.Count x.Workbooks(i).Close(SaveChanges:=False) Next End If x.Workbooks.Open(filename.ToString) x.ActiveWorkbook.ExportAsFixedFormat(Microsoft.Office.Interop.Excel.XlFixedFormatType.xlTypePDF, outputfile.ToString, Microsoft.Office.Interop.Excel.XlFixedFormatQuality.xlQualityStandard) x.ActiveWorkbook.Close(SaveChanges:=False) Return True Catch ex As Exception Try x = Nothing Catch End Try Try x = New Microsoft.Office.Interop.Excel.Application Catch End Try Return False End Try ExcelTimer.Enabled = False End Function Public Function GetDocType(ByVal Filename As String) As String Dim NoDot() As String NoDot = Split(Filename, ".") GetDocType = NoDot(UBound(NoDot)) Return GetDocType End Function #End Region End Module