You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

564 lines
23 KiB

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
'''<summary>Initialisierung des Filewacher-Objektes</summary>
'''<remarks>Das Filewacher-Objekt wird mit den entpsrechenden Pfad- sowie
'''Dateifilter-Angaben initialisiert.</remarks>
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
'''<summary>Eventhandler des FileWatching-Objektes aktivieren</summary>
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
'''<summary>Aktivitäten im Inputverzeichnis verarbeiten</summary>
'''<remarks>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</remarks>
'''<param name="source"></param>
'''<param name="e"></param>
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