Imports System.Data.SqlClient Imports System.IO Imports iTextSharp.text.pdf Imports System.Drawing.Printing Imports Ghostscript.NET.Processor Imports System.Runtime.InteropServices Imports System.Windows.Forms Imports System.Drawing Imports Spire.Pdf.Print Imports Spire.Pdf Imports Spire.Pdf.HtmlConverter Imports System.Threading Imports System.Net Imports System.Text.RegularExpressions Imports System.Runtime.DesignerServices Public Class cDATENSERVER Property da_id As Object = Nothing Property da_kategorie As String = "" Property da_ordner As String = "" Property da_KundenNr As Integer = 0 Property da_vorlage As Boolean = False Property da_uOrdner1 As String = "" 'SDL: LKW Property da_uOrdner2 As String = "" 'SDL: SDL_Leistung/... Property da_uOrdner3 As String = "" 'SDL: History Property da_name As String = "" 'Property da_pfad As Object = Nothing Property da_info As String = "" Property da_multifiles As Boolean = False Public Property DATA_LIST As New cDatenserverIDCollectionList Dim rootDir = "" Dim rootDirARCHIVARCHIV = "" Dim TopMax = 0 Dim SQL As New SQL ' Public LAST_ID = -1 Sub New(da_id) Me.da_id = da_id Me.rootDir = DATENVERVER_OPTIONS.initRootDir() Me.rootDirARCHIVARCHIV = DATENVERVER_OPTIONS.initRootDirArchivArchiv() LOADById() End Sub Sub New(da_kategorie, da_ordner, Optional TopMax = 0) Me.rootDir = DATENVERVER_OPTIONS.initRootDir() Me.da_KundenNr = da_KundenNr Me.da_vorlage = 0 '(da_KundenNr <= 0) Me.da_kategorie = da_kategorie Me.da_ordner = da_ordner LOAD() End Sub Sub New(da_kategorie, da_ordner, da_uOrdner1, da_uOrdner2, da_uOrdner3, da_name, Optional da_KundenNr = 0) Me.rootDir = DATENVERVER_OPTIONS.initRootDir() Me.da_KundenNr = da_KundenNr Me.da_vorlage = 0 '(da_KundenNr <= 0) Me.da_kategorie = IIf(Not IsDBNull(da_kategorie), da_kategorie, "") Me.da_ordner = IIf(Not IsDBNull(da_ordner), da_ordner, "") Me.da_uOrdner1 = replaceInvalidCahr(IIf(Not IsDBNull(da_uOrdner1), da_uOrdner1, "")) Me.da_uOrdner2 = replaceInvalidCahr(IIf(Not IsDBNull(da_uOrdner2), da_uOrdner2, "")) Me.da_uOrdner3 = replaceInvalidCahr(IIf(Not IsDBNull(da_uOrdner3), da_uOrdner3, "")) Me.da_name = IIf(Not IsDBNull(da_name), da_name, "") LOAD() End Sub Sub New(da_kategorie, da_ordner, da_uOrdner1, da_uOrdner2, da_uOrdner3, da_name, da_KundenNr, da_multifiles, Optional TopMax = 0) Me.rootDir = DATENVERVER_OPTIONS.initRootDir() Me.da_KundenNr = da_KundenNr Me.da_vorlage = 0 '(da_KundenNr <= 0) Me.da_kategorie = da_kategorie Me.da_ordner = da_ordner Me.da_uOrdner1 = replaceInvalidCahr(If(da_uOrdner1, "")) Me.da_uOrdner2 = replaceInvalidCahr(If(da_uOrdner2, "")) Me.da_uOrdner3 = replaceInvalidCahr(If(da_uOrdner3, "")) Me.da_name = da_name Me.da_multifiles = da_multifiles Me.TopMax = TopMax LOAD() End Sub Public Function LOADById() As Boolean Try DATA_LIST = New cDatenserverIDCollectionList Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL() Using cmd As New SqlCommand("SELECT * FROM tblDatenarchiv WHERE da_id=@da_id ", conn) cmd.Parameters.AddWithValue("@da_id", Me.da_id) Dim dr = cmd.ExecuteReader() If dr.Read Then ' Me.da_id = dr.Item("da_id") Me.da_KundenNr = dr.Item("da_KundenNr") Me.da_vorlage = dr.Item("da_vorlage") Me.da_kategorie = dr.Item("da_kategorie") Me.da_ordner = dr.Item("da_ordner") Me.da_uOrdner1 = dr.Item("da_uOrdner1") Me.da_uOrdner2 = dr.Item("da_uOrdner2") Me.da_uOrdner3 = dr.Item("da_uOrdner3") Me.da_name = dr.Item("da_name") Me.da_info = dr.Item("da_info") Me.da_multifiles = dr.Item("da_multifiles") DATA_LIST = New cDatenserverIDCollectionList(Me.da_id, rootDir) End If dr.Close() End Using End Using Return True Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Return False End Function Public Function LOAD() As Boolean Try DATA_LIST = New cDatenserverIDCollectionList Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL() Dim top = "" If TopMax > 0 Then top = " TOP (" & TopMax & ") " 'MsgBox("SELECT * FROM tblDatenarchiv WHERE da_KundenNr = '" & Me.da_KundenNr & "' And da_kategorie = '" & Me.da_kategorie & "' And da_ordner ='" & Me.da_ordner & "' AND da_uOrdner1= '" & Me.da_uOrdner1 & "' AND da_uOrdner2= '" & Me.da_uOrdner2 & "' AND da_uOrdner3= '" & Me.da_uOrdner3 & "' AND da_name='" & Me.da_name & "' ") Using cmd As New SqlCommand("SELECT " & top & " * FROM tblDatenarchiv WHERE da_KundenNr = @da_KundenNr AND da_kategorie = @da_kategorie AND da_ordner=@da_ordner AND da_uOrdner1= @da_uOrdner1 AND da_uOrdner2= @da_uOrdner2 AND da_uOrdner3= @da_uOrdner3 AND da_name=@da_name ", conn) cmd.Parameters.AddWithValue("@da_KundenNr", Me.da_KundenNr) ' cmd.Parameters.AddWithValue("@da_vorlage", Me.da_vorlage) cmd.Parameters.AddWithValue("@da_kategorie", Me.da_kategorie) cmd.Parameters.AddWithValue("@da_ordner", Me.da_ordner) cmd.Parameters.AddWithValue("@da_uOrdner1", Me.da_uOrdner1) cmd.Parameters.AddWithValue("@da_uOrdner2", Me.da_uOrdner2) cmd.Parameters.AddWithValue("@da_uOrdner3", Me.da_uOrdner3) cmd.Parameters.AddWithValue("@da_name", Me.da_name) Dim dr = cmd.ExecuteReader() If dr.Read Then Me.da_id = dr.Item("da_id") Me.da_vorlage = dr.Item("da_vorlage") Me.da_info = dr.Item("da_info") Me.da_multifiles = dr.Item("da_multifiles") DATA_LIST = New cDatenserverIDCollectionList(Me.da_id, rootDir) End If dr.Close() End Using End Using Return True Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Return False End Function 'Function REMANE_FOLDER(new_kategorie, new_ordner, new_uOrdner1, new_uOrdner2, new_uOrdner3, new_kdnr) Function REMANE_FOLDER(old_kategorie, old_ordner, old_uOrdner1, old_uOrdner2, old_uOrdner3, old_kdnr, new_kategorie, new_ordner, new_uOrdner1, new_uOrdner2, new_uOrdner3, new_kdnr) Dim oldDIR = DATENVERVER_OPTIONS.getDescPath(rootDir, old_kategorie, old_ordner, old_uOrdner1, old_uOrdner2, old_uOrdner3, old_kdnr, "", "", True) If new_kategorie IsNot Nothing Then Me.da_kategorie = new_kategorie If new_ordner IsNot Nothing Then Me.da_ordner = new_ordner If new_uOrdner1 IsNot Nothing Then Me.da_uOrdner1 = new_uOrdner1 If new_uOrdner2 IsNot Nothing Then Me.da_uOrdner2 = new_uOrdner2 If new_uOrdner3 IsNot Nothing Then Me.da_uOrdner3 = new_uOrdner3 Dim newDIR = DATENVERVER_OPTIONS.getDescPath(rootDir, new_kategorie, new_ordner, new_uOrdner1, new_uOrdner2, new_uOrdner3, new_kdnr, "", "", True) Try ' My.Computer.FileSystem.RenameDirectory(oldDIR, newname) For Each li In DATA_LIST.LIST Dim newPfad = li.coll_pfad.Replace(oldDIR, newDIR) If Not System.IO.Directory.Exists(newDIR) Then System.IO.Directory.CreateDirectory(newDIR) My.Computer.FileSystem.CopyFile(li.coll_pfad, newPfad, True) My.Computer.FileSystem.DeleteFile(li.coll_pfad) li.coll_pfad = newPfad If Not li.UPDATE() Then Return False End If Next Return UPDATE() Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Return False End Function Function moveTo_ARCHIVARCHIV() Dim oldDIR = DATENVERVER_OPTIONS.getDescPath(rootDir, da_kategorie, da_ordner, da_uOrdner1, da_uOrdner2, da_uOrdner3, da_KundenNr, "", "", True) Dim newDIR = DATENVERVER_OPTIONS.getDescPath(rootDirARCHIVARCHIV, da_kategorie, da_ordner, da_uOrdner1, da_uOrdner2, da_uOrdner3, da_KundenNr, "", "", True) Try ' My.Computer.FileSystem.RenameDirectory(oldDIR, newname) For Each li In DATA_LIST.LIST Dim newPfad = li.coll_pfad.Replace(oldDIR, newDIR) 'MsgBox(li.coll_pfad) ' MsgBox(newPfad) If Not System.IO.Directory.Exists(newDIR) Then System.IO.Directory.CreateDirectory(newDIR) Try If Not li.coll_pfad.ToLower.StartsWith("\\stor01.verag.ost.dmn\datenarchivarchiv") Then If Not li.coll_pfad.Contains("?") Then If System.IO.File.Exists(li.coll_pfad) Then My.Computer.FileSystem.CopyFile(li.coll_pfad, newPfad, True) My.Computer.FileSystem.DeleteFile(li.coll_pfad) li.coll_pfad = newPfad If Not li.UPDATE() Then Return False End If Else 'Datei Existiert nicht! li.coll_pfad = li.coll_pfad.Replace("\\datenarchiv.verag.ost.dmn\", "\\DELETED\") If Not li.UPDATE() Then Return False End If End If End If End If Catch ex2 As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex2.Message, li.coll_pfad & vbNewLine & newPfad & vbNewLine & vbNewLine & ex2.Message & vbNewLine & ex2.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Next Return UPDATE() Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Return False End Function Function UPDATE() As Boolean Try 'If coll_id < 0 Then 'Wenn noch keine ID vergeben 'Me.coll_id = getMaxId() 'End If Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL() Using cmd As New SqlCommand("UPDATE tblDatenarchiv SET da_KundenNr=@da_KundenNr,da_vorlage=@da_vorlage, da_kategorie=@da_kategorie, da_ordner=@da_ordner,da_uOrdner1=@da_uOrdner1, da_uOrdner2=@da_uOrdner2, da_uOrdner3=@da_uOrdner3, da_name=@da_name, da_info=@da_info, da_multifiles=@da_multifiles WHERE da_id=@da_id ", conn) cmd.Parameters.AddWithValue("@da_KundenNr", da_KundenNr) cmd.Parameters.AddWithValue("@da_vorlage", da_vorlage) cmd.Parameters.AddWithValue("@da_kategorie", da_kategorie) cmd.Parameters.AddWithValue("@da_ordner", da_ordner) cmd.Parameters.AddWithValue("@da_uOrdner1", da_uOrdner1) cmd.Parameters.AddWithValue("@da_uOrdner2", da_uOrdner2) cmd.Parameters.AddWithValue("@da_uOrdner3", da_uOrdner3) cmd.Parameters.AddWithValue("@da_name", da_name) cmd.Parameters.AddWithValue("@da_info", da_info) cmd.Parameters.AddWithValue("@da_multifiles", da_multifiles) cmd.Parameters.AddWithValue("@da_id", da_id) cmd.ExecuteNonQuery() Return True End Using End Using Return True Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) Return False End Try End Function Public Shared Function replaceInvalidCahr(ByRef s As String) As String Try s = s.Replace("İ", "I") s = s.Replace("İ", "I") s = s.Replace("ı", "i") s = s.Replace("€", "E") s = s.Replace(",", ".") s = s.Replace("'", "") s = s.Replace("´", "") s = s.Replace("^", "") ' Es gibt Ü, die so geschreiben werden: Ü .... s = s.Replace("Ì", ".") s = s.Replace("Ü", "U") ' .... das zum Beispiel s = s.Replace("А", "A") 'cyrillic A s = s.Replace("Р", "P") 'cyrillic P s = s.Replace("С", "C") 'cyrillic C s = s.Replace("Т", "T") 'cyrillic T s = s.Replace("Ѕ", "S") 'cyrillic S s = s.Replace("І", "I") 'cyrillic I s = s.Replace("Ј", "J") 'cyrillic J s = s.Replace("Е", "E") 'cyrillic E s = s.Replace("?", "") Dim temp = s s = Regex.Replace(s, "[бБвгГдДёЁжЖзЗиИйЙкКлЛмнпПртфФхХцЦчЧшШщЩъЪыЫьЬэЭюЮяЯ]", "").Replace("""", "") 'REMOVE cyrillic letters 'If s = "" Then s = temp Dim tempBytes = System.Text.Encoding.GetEncoding("ISO-8859-8").GetBytes(s) s = System.Text.Encoding.UTF8.GetString(tempBytes) s = s.Replace("�", "") s = s.Replace("?", "") Return s Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try End Function Public Function uploadDataToDATENSERVER(srcPath, Optional bezeichnung = "", Optional endung = "", Optional allowMsg = True, Optional coll_archiv = False, Optional delteFromFileSystem = True, Optional enableOverwritting = False) As Boolean 'LAST_ID = -1 If endung = "" Then Dim fi As New System.IO.DirectoryInfo(srcPath) : endung = fi.Extension ' If bezeichnung = "" Then bezeichnung = System.IO.Path.GetFileName(srcPath) : endung = "" If bezeichnung = "" Then bezeichnung = da_name Dim destpath = DATENVERVER_OPTIONS.getDescPath(rootDir, da_kategorie, da_ordner, da_uOrdner1, da_uOrdner2, da_uOrdner3, da_KundenNr, replaceInvalidCahr(da_name), endung) genHEADER_DATA() If Not da_multifiles Then If allowMsg AndAlso (DATA_LIST.LIST.Count > 0 And Not enableOverwritting) Then If Not vbYes = MsgBox("Die Datei existiert bereits. Soll die Datei ersetzt werden?", vbYesNoCancel) Then Return False 'NICHT Passiert End If End If DATA_LIST.DELETE_ALL(delteFromFileSystem) 'Wenn nur eine Datei existieren darf, müssen zuerst alle Einträge gelöscht werden End If If DATA_LIST.ADD(srcPath, destpath, bezeichnung, "", coll_archiv) Then Dim sql As New VERAG_PROG_ALLGEMEIN.SQL Return (destpath <> "") End If Return False End Function Public Function insertDataToDATENSERVER(srcPath, Optional bezeichnung = "", Optional endung = "", Optional allowMsg = True, Optional coll_archiv = False) As Boolean 'Datei musss schon am Datenserver liegen, wird nciht mehr kopiert!!!!! If endung = "" Then Dim fi As New System.IO.DirectoryInfo(srcPath) : endung = fi.Extension ' If bezeichnung = "" Then bezeichnung = System.IO.Path.GetFileName(srcPath) : endung = "" If bezeichnung = "" Then bezeichnung = da_name replaceInvalidCahr(bezeichnung) genHEADER_DATA() If Not da_multifiles Then DATA_LIST.DELETE_ALL() 'Wenn nur eine Datei existieren darf, müssen zuerst alle Einträge gelöscht werden End If If DATA_LIST.ADD_WOcopy(srcPath, bezeichnung, "", coll_archiv) Then Return True End If Return False End Function Public Function uploadDataToDATENSERVER_fromBytes(bytes, Optional bezeichnung = "", Optional endung = "", Optional allowMsg = True, Optional coll_archiv = False) As Boolean Try Dim tmpPath = DATENVERVER_OPTIONS.getTMPPath(bezeichnung, endung, , True) ', Now.ToString("TMP_ddMMyyyy_HHmmSS_fff")) File.WriteAllBytes(tmpPath, bytes) Return uploadDataToDATENSERVER(tmpPath, bezeichnung, endung, allowMsg, coll_archiv) Catch ex As Exception Return False End Try End Function Public Function uploadDataToDATENSERVER_fromBase64String(base64String, Optional bezeichnung = "", Optional endung = "", Optional allowMsg = True, Optional coll_archiv = False) As Boolean Try Dim bytes As Byte() = Convert.FromBase64String(base64String) Return uploadDataToDATENSERVER_fromBytes(bytes, bezeichnung, endung, allowMsg, coll_archiv) Catch ex As Exception Return False End Try End Function Public Function DELETE_LIST_POS(coll_id) As Boolean Return DATA_LIST.DELETE_ATPOS(coll_id) End Function Public Function uploadDataToDATENSERVERFileDialog(Optional bezeichnung = "", Optional endung = "", Optional allowMsg = True, Optional typ = "", Optional coll_archiv = False) As String Dim fd As New OpenFileDialog ' fd.Filter = "Excel Dateien|*.xls;*.xlsx" fd.RestoreDirectory = True Select Case typ Case "PIC" fd.Title = "Bild auswählen" ' fd.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) fd.Filter = "Image Files(*.BMP;*.JPG;*.GIF;*.PNG)|*.BMP;*.JPG;*.GIF;*.PNG" fd.FilterIndex = 2 Case "PDF" fd.Title = "PDF auswählen" ' fd.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) fd.Filter = "PDF|*.PDF" fd.FilterIndex = 2 fd.DefaultExt = ".pdf" End Select Dim result As DialogResult = fd.ShowDialog() If result = System.Windows.Forms.DialogResult.OK And fd.FileName <> "" Then If bezeichnung = "" Then bezeichnung = System.IO.Path.GetFileName(fd.FileName).ToString End If replaceInvalidCahr(bezeichnung) If da_name = "" Then Me.da_name = bezeichnung : LOAD() 'Wenn sich der Name ändert, muss eine neuer Header erstellt werden... Return uploadDataToDATENSERVER(fd.FileName, bezeichnung, endung, allowMsg, coll_archiv) End If Return False End Function Dim FD_ID = "" Public Function uploadDataToDATENSERVERFileDialog_MULTI(Optional bezeichnung = "", Optional endung = "", Optional allowMsg = True, Optional typ = "", Optional coll_archiv = False) As Boolean Dim fd As New OpenFileDialog fd.RestoreDirectory = True fd.Multiselect = True ' fd.Filter = "Excel Dateien|*.xls;*.xlsx" Select Case typ Case "PIC" fd.Title = "Bild auswählen" ' fd.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) fd.Filter = "Image Files(*.BMP;*.JPG;*.GIF;*.PNG)|*.BMP;*.JPG;*.GIF;*.PNG" fd.FilterIndex = 2 Case "PDF" fd.Title = "PDF auswählen" ' fd.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) fd.Filter = "PDF|*.PDF" fd.FilterIndex = 2 fd.DefaultExt = ".pdf" endung = ".pdf" Case Else fd.Title = "Datei auswählen" End Select Dim result As DialogResult = fd.ShowDialog() If result = System.Windows.Forms.DialogResult.OK And fd.FileNames.Count > 0 Then FD_ID = fd.InitialDirectory For Each f In fd.FileNames Dim bezTmp = bezeichnung If bezeichnung = "" Then bezTmp = System.IO.Path.GetFileName(f).ToString End If 'If da_name = "" Then Me.da_name = bezeichnung : LOAD() 'Wenn sich der Name ändert, muss eine neuer Header erstellt werden... uploadDataToDATENSERVER(f, bezTmp, endung, allowMsg, coll_archiv) Next Me.LOAD() 'neu laden, damit LIST aktualisiert wird Return True End If Return False End Function Public Function genHEADER_DATA() As Integer Dim sqlstr As String = " begin tran" & " if NOT EXISTS(select * FROM [tblDatenarchiv] WHERE da_KundenNr = @da_KundenNr AND da_kategorie = @da_kategorie AND da_ordner=@da_ordner AND da_uOrdner1=@da_uOrdner1 AND da_uOrdner2=@da_uOrdner2 AND da_uOrdner3=@da_uOrdner3 AND da_name=@da_name) " & " begin " & "INSERT INTO [tblDatenarchiv] " & " ([da_KundenNr],[da_vorlage],[da_kategorie],[da_ordner],da_uOrdner1,da_uOrdner2,da_uOrdner3,[da_name],da_info,da_multifiles) " & " VALUES (@da_KundenNr, @da_vorlage, @da_kategorie, @da_ordner, @da_uOrdner1,@da_uOrdner2,@da_uOrdner3,@da_name,@da_info,@da_multifiles)" & " End " & " commit tran " Try Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL() Using cmd As New SqlCommand(sqlstr, conn) cmd.Parameters.AddWithValue("@da_KundenNr", da_KundenNr) cmd.Parameters.AddWithValue("@da_vorlage", da_vorlage) cmd.Parameters.AddWithValue("@da_kategorie", da_kategorie) cmd.Parameters.AddWithValue("@da_ordner", da_ordner) cmd.Parameters.AddWithValue("@da_uOrdner1", da_uOrdner1) cmd.Parameters.AddWithValue("@da_uOrdner2", da_uOrdner2) cmd.Parameters.AddWithValue("@da_uOrdner3", da_uOrdner3) cmd.Parameters.AddWithValue("@da_name", da_name) cmd.Parameters.AddWithValue("@da_info", da_info) cmd.Parameters.AddWithValue("@da_multifiles", da_multifiles) cmd.ExecuteNonQuery() Dim newcmd As New SqlCommand("SELECT @@IDENTITY", conn) Dim id = (newcmd.ExecuteScalar) If id Is DBNull.Value Then Return da_id Else 'Wenn insert+ DATA_LIST.coll_daId = id Me.da_id = id Return id End If End Using End Using Return False Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Return da_id End Function Public Function hasITEMS() As Boolean Return DATA_LIST.LIST.Count > 0 End Function Public Function OPEN_SINGLE(Optional openFile As Boolean = True, Optional useBezeichnung As Boolean = False) As String If DATA_LIST.LIST.Count > 0 Then Return DATA_LIST.LIST(0).OPEN(openFile, useBezeichnung) End If Return "" End Function Public Function OPEN_SINGLE_ORIG(Optional openFile As Boolean = True) As String If DATA_LIST.LIST.Count > 0 Then Return DATA_LIST.LIST(0).OPEN_ORIG(openFile) End If Return "" End Function Public Function OPEN(coll_id As Integer, Optional openFile As Boolean = True, Optional useBezeichnung As Boolean = False) As String For Each li In DATA_LIST.LIST If li.coll_id = coll_id Then Return li.OPEN(openFile, useBezeichnung) End If Next Return "" End Function Public Function GET_TOP1_PATH(Optional openFile As Boolean = False) As String If DATA_LIST.LIST.Count > 0 Then If openFile Then OPEN(DATA_LIST.LIST(0).coll_id) Return DATA_LIST.LIST(0).coll_pfad End If Return "" End Function Public Shared Function GET_PDFPath_BY_DocID(docId As Integer, Optional openFile As Boolean = False) As String Dim DS As New cDATENSERVER(docId) Return DS.GET_TOP1_PATH(openFile) End Function Public Shared Function GET_PDFPath_BY_DocID_onlyPATH(docId As Integer) As String Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL Return SQL.getValueTxtBySql("SELECT TOP (1) [coll_pfad] FROM [tblDatenarchiv_Collection] where coll_daId=" & docId & " ORDER BY coll_date DESC", "FMZOLL") End Function ' Public Function getPathByIdTOP1(da_id) As String ' Try ' Return SQL.getValueTxtBySql("SELECT TOP 1 isnull([coll_pfad],'') FROM [tblDatenarchiv] INNER JOIN [tblDatenarchiv_Collection] ON [da_id]=[coll_daId] WHERE da_id='" & da_id & "' ", "FMZOLL") ' Catch ex As Exception ' Return "" ' End Try 'End Function ' Public Function openDataTMPByDatenarchivIdTOP1(id) As Boolean ' Try ' Dim srcPath = SQL.getValueTxtBySql("SELECT TOP 1 isnull([coll_pfad],'') FROM [tblDatenarchiv] INNER JOIN [tblDatenarchiv_Collection] ON [da_id]=[coll_daId] WHERE da_id='" & da_id & "' ", "FMZOLL") ' If Not System.IO.File.Exists(srcPath) Then MsgBox("Die Datei existiert nicht") : Exit Function ' Dim fi As New System.IO.DirectoryInfo(srcPath) ' Dim destPath = DATENVERVER_OPTIONS.getTMPPath(fi.Name, fi.Extension) ' System.IO.File.Copy(srcPath, destPath, True) ' Process.Start(destPath) ' Return True ' Catch ex As Exception ' MsgBox(ex.Message & ex.StackTrace) ' Return False ' End Try 'End Function Public Function DELETE_COMPLETE() As Boolean Try If DATA_LIST.DELETE_ALL() Then ' Dim path = SQL.getValueTxtBySql("SELECT TOP 1 isnull([coll_pfad],'') FROM [tblDatenarchiv] INNER JOIN [tblDatenarchiv_Collection] ON [da_id]=[coll_daId] WHERE da_id='" & da_id & "' ", "FMZOLL") 'If path.Contains(rootDir) Then 'Um sicher zu gehen, dass der pfad im richtigem VZ ist. ' saveFileToDel(path) ' System.IO.File.Delete(path) 'End If SQL.doSQL("DELETE FROM [tblDatenarchiv] WHERE [da_id]=" & Me.da_id & " ", "FMZOLL") 'SQL.doSQL("DELETE FROM [tblDatenarchiv_Collection] WHERE [coll_daId]=" & id & " ", "FMZOLL") End If Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) Return False End Try Return True End Function ' Public Function getLAST_ID(destpath) As Integer ' Try ' Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL() ' Dim newcmd As New SqlCommand("select isnull(da_id,-1) from tblDatenarchiv with (updlock,serializable) where da_pfad = @da_pfad ", conn) ' newcmd.Parameters.AddWithValue("@da_pfad", destpath) ' Return CInt(newcmd.ExecuteScalar) ' End Using ' Return False ' Catch ex As Exception ' MsgBox("Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message) ' End Try ' Return -1 'End Function End Class Public Class cDatenserver_Change_Value Property da_kategorie As String = "" Property da_ordner As String = "" Property da_KundenNr As Integer = 0 Property da_uOrdner1 As String = "" 'SDL: LKW Property da_uOrdner2 As String = "" 'SDL: SDL_Leistung/... Property da_uOrdner3 As String = "" 'SDL: History Sub New(da_kategorie, da_ordner, da_KundenNr, da_uOrdner1, da_uOrdner2, da_uOrdner3) Me.da_kategorie = da_kategorie Me.da_ordner = da_ordner Me.da_KundenNr = da_KundenNr Me.da_uOrdner1 = da_uOrdner1 Me.da_uOrdner2 = da_uOrdner2 Me.da_uOrdner3 = da_uOrdner3 End Sub End Class Public Class cFormularManager 'Dim cDATENSERVER As New cDATENSERVER Shared Function open(ds_id, Optional openFile = True) As String Dim DS As New cDATENSERVER(ds_id) Return DS.OPEN_SINGLE(openFile) End Function Shared Function open(da_kategorie, da_ordner, da_uOrdner1, da_uOrdner2, da_uOrdner3, da_name, Optional da_KundenNr = 0, Optional openFile = True) As String Dim DS As New cDATENSERVER(da_kategorie, da_ordner, da_uOrdner1, da_uOrdner2, da_uOrdner3, da_name, da_KundenNr) Return DS.OPEN_SINGLE(openFile) End Function Public Sub fillGestellungsGarantie(kdnr As String, sprache As String) 'list As cKundenFMZOLL) Dim name = "GenerelleGestellungsgarantieT1_DEUTSCH.pdf" Select Case sprache Case "DE" : name = "GenerelleGestellungsgarantieT1_DEUTSCH.pdf" Case "EN" : name = "GenerelleGestellungsgarantieT1_ENGLISCH.pdf" Case "NL" : name = "GenerelleGestellungsgarantieT1_NIEDERLAENDISCH.pdf" Case "FR" : name = "GenerelleGestellungsgarantieT1_FRANZOESISCH.pdf" End Select Dim list As New List(Of VERAG_PROG_ALLGEMEIN.MyListItem) If IsNumeric(kdnr) AndAlso kdnr > 0 Then 'Dim KDSQL As New kundenSQL 'Dim kd As cKundenFMZOLL = KDSQL.getKundeFMZOLLByKdNr(kdnr) Dim KD As New cAdressen(kdnr) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("FaxAn", KD.Telefax)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("FaxVon", "")) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("zHd", KD.Ansprechpartner)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Datum", Now.ToShortDateString)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Firma", (KD.Name_1 & " " & KD.Name_2).Trim)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Adresse1", KD.Straße)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Adresse2", KD.LandKz & " " & KD.PLZ & " " & KD.Ort)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Tel", KD.Telefon)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Fax", KD.Telefax)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Ansprechpartner", KD.Ansprechpartner)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Bestimmungszollamt", "")) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Anmerkung1", "")) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Anmerkung2", "")) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Anmerkung3", "")) End If fillPDF(name, list, Nothing) End Sub Public Sub fillVollmacht(kdnr As Integer, art As String) 'list As cKundenFMZOLL) Dim name = "DE-ZOLLVOLLMACHT.pdf" Dim kd As cKunde = Nothing Dim ad As cAdressen = Nothing If IsNumeric(kdnr) AndAlso kdnr > 0 Then ad = New cAdressen(kdnr) kd = New cKunde(kdnr) End If Dim list As New List(Of VERAG_PROG_ALLGEMEIN.MyListItem) Select Case art Case "ZVM_DE" name = "DE-ZOLLVOLLMACHT.pdf" If IsNumeric(kdnr) AndAlso kdnr > 0 Then list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("zHd", ad.Ansprechpartner)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Firma", (ad.Name_1 & " " & ad.Name_2).Trim)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Rechtsform", getRechtsform(ad.Name_1 & " " & ad.Name_2).Trim)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Inhaber", "")) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Straße", ad.Straße)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("PLZ_Ort", ad.PLZ & " " & ad.Ort)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("TelFax", ad.Telefon.Replace(" ", "") & " / " & ad.Telefax.Replace(" ", ""))) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("UIDNr", ad.UstIdKz & ad.UstIdNr)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("EORINr", kd.EORITIN)) End If Case "ZVM_DE_Englisch" name = "DE-ZOLLVOLLMACHT Englisch.pdf" If IsNumeric(kdnr) AndAlso kdnr > 0 Then list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Company", (ad.Name_1 & " " & ad.Name_2).Trim)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Street", ad.Straße)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Plz", ad.PLZ & " " & ad.Ort)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("TelFax", ad.Telefon.Replace(" ", "") & " / " & ad.Telefax.Replace(" ", ""))) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Email", ad.E_Mail)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("TaxID", ad.UstIdKz & ad.UstIdNr)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("DutyNo", kd.EORITIN)) End If Case "ZVM_CS" name = "AT-ZOLLVOLLMACHT.pdf" 'Customs Servie If IsNumeric(kdnr) AndAlso kdnr > 0 Then list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Firma", (ad.Name_1 & " " & ad.Name_2).Trim)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Straße", ad.Straße)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("PLZ_Ort", ad.PLZ & " " & ad.Ort)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Tel", ad.Telefon)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("UIDNr", ad.UstIdKz & ad.UstIdNr)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("EORINr", kd.EORITIN)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("FA StNr", ad.Steuernummer)) End If Case "ZVM_CS_4200" name = "AT-ZOLLVOLLMACHT 4200.pdf" If IsNumeric(kdnr) AndAlso kdnr > 0 Then list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("zu Hd", ad.Ansprechpartner)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Firmenname", (ad.Name_1 & " " & ad.Name_2).Trim)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Rechtsform", getRechtsform(ad.Name_1 & " " & ad.Name_2).Trim)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Einzelfirma", "")) 'inhaber list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Straße", ad.Straße)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("PLZ_Ort", ad.PLZ & " " & ad.Ort)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("TelFax", ad.Telefon.Replace(" ", "") & " / " & ad.Telefax.Replace(" ", ""))) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("UIDNr", ad.UstIdKz & ad.UstIdNr)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("EORINr", kd.EORITIN)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("FA StNr", ad.Steuernummer)) End If End Select fillPDF(name, list, Nothing) End Sub Sub fillImportaviso(kdnr As Integer, art As String) Dim kd As cAdressen = Nothing If IsNumeric(kdnr) AndAlso kdnr > 0 Then kd = New cAdressen(kdnr) End If Dim name = "Importaviso_Standard.pdf" Dim list As New List(Of VERAG_PROG_ALLGEMEIN.MyListItem) Select Case art Case "Standard" name = "Importaviso_Standard.pdf" If IsNumeric(kdnr) AndAlso kdnr > 0 Then list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("VERAGContact", "")) ' AKT MA list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("To", kd.Ansprechpartner)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Company", (kd.Name_1 & " " & kd.Name_2).Trim)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Road", kd.Straße)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("PostTown", kd.LandKz & " " & kd.PLZ & " " & kd.Ort)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("TelFax", kd.Telefon.Replace(" ", "") & " / " & kd.Telefax.Replace(" ", ""))) End If fillPDF(name, list, Nothing) Case "Vorauskasse" name = "Importaviso Vorauszahlung.xlt" 'SONDERFALL DA EXCEL Dim DS As New cDATENSERVER("DOKUMENTE", "VORLAGEN", "", "", "", name) DS.OPEN_SINGLE(True) 'Dim path_src As String = cDATENSERVER.getTOP1Path("DOKUMENTE", "VORLAGEN", , name) 'If path_src = "" Then Exit Sub 'Dim path As String = cDATENSERVER.openDataTMP(path_src, True) 'If path = "" Then Exit Sub End Select End Sub Sub fillDispoliste(kdnr As Integer, art As String) Dim name = "Dispoliste_TR.pdf" Select Case art Case "TR" : name = "Dispoliste_TR.pdf" Case "EN" : name = "Dispoliste_EN.pdf" End Select Dim list As New List(Of VERAG_PROG_ALLGEMEIN.MyListItem) If IsNumeric(kdnr) AndAlso kdnr > 0 Then Dim kd As New cAdressen(kdnr) ' Dim kd As cKundenFMZOLL = KDSQL.getKundeFMZOLLByKdNr(kdnr) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("zHd", kd.Ansprechpartner)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Datum", Now.ToShortDateString)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("An", (kd.Name_1 & " " & kd.Name_2).Trim)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("LkwKz", "")) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("SB", "")) ' AKT MA End If fillPDF(name, list, Nothing) End Sub Sub fillVerzollungspreise() MsgBox("NOCH NICHT VERFÜGBAR") Exit Sub Dim name = "Verzollungspreise_ohnePreise.pdf" Dim f As New Object 'frmVerzollungspreiseFuellen If f.ShowDialog() = DialogResult.OK Then Dim list As New List(Of VERAG_PROG_ALLGEMEIN.MyListItem) ' Dim KDSQL As New kundenSQL list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Preis1", f.txtVerzollung.Text)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Preis2", f.txtTarifnummer.Text)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Preis3", f.txtPapierePorti.Text)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Preis4", f.txtSVS.Text)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Preis5", f.txtATLAS.Text)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("PreisClearing", f.txtClearing.Text)) ' AKT MA fillPDF(name, list, Nothing, , False) End If End Sub Sub fillCreditreform(kdnr As Integer) Dim name = "Creditreform Bonität mit GF.pdf" Dim list As New List(Of VERAG_PROG_ALLGEMEIN.MyListItem) If IsNumeric(kdnr) AndAlso kdnr > 0 Then Dim kd As New cAdressen(kdnr) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Heute", Now.ToShortDateString)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Firma1", (kd.Name_1 & " " & kd.Name_2).Trim)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Firma2", kd.Straße)) list.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Firma3", kd.LandKz & " " & kd.PLZ & " " & kd.Ort)) End If fillPDF(name, list, Nothing) End Sub Public Function fillPDF(vorlagenname As String, list As List(Of VERAG_PROG_ALLGEMEIN.MyListItem), listToWrite As List(Of cPDFWriteValues), Optional editierbar As Boolean = True, Optional autoDruck As Boolean = False, Optional printerName As String = "", Optional barcode As Image = Nothing, Optional barcodeLKW As Image = Nothing, Optional uo2 As String = "", Optional openfile As Boolean = True) As String Return fillPDF_Editierbar("DOKUMENTE", "VORLAGEN", "", uo2, "", vorlagenname, list, listToWrite, editierbar, autoDruck, printerName, barcode, barcodeLKW) End Function Public Function fillPDF_Editierbar(da_kategorie As String, da_ordner As String, da_uOrdner1 As String, da_uOrdner2 As String, da_uOrdner3 As String, da_name As String, list As List(Of VERAG_PROG_ALLGEMEIN.MyListItem), listToWrite As List(Of cPDFWriteValues), Optional editierbar As Boolean = True, Optional autoDruck As Boolean = False, Optional printerName As String = "", Optional barcode As Image = Nothing, Optional barcodeLKW As Image = Nothing, Optional openfile As Boolean = True) As String Try Dim DS As New cDATENSERVER(da_kategorie, da_ordner, da_uOrdner1, da_uOrdner2, da_uOrdner3, da_name) If Not DS.hasITEMS Then Return "" Dim path_src As String = DS.OPEN_SINGLE(False) If path_src = "" Then Return "" Dim fi As New System.IO.DirectoryInfo(path_src) Dim destPath = DATENVERVER_OPTIONS.getTMPPath(fi.Name, fi.Extension, True, False) Dim pdf As iTextSharp.text.pdf.PdfReader = New iTextSharp.text.pdf.PdfReader(path_src) Using fw As New FileStream(destPath, FileMode.OpenOrCreate) Dim stamper = New PdfStamper(pdf, fw) If True Then Try Dim f = stamper.AcroFields f.GenerateAppearances = True For Each i In list f.SetField(i.Text, i.Value) Next Catch ex As Exception End Try If listToWrite IsNot Nothing Then Dim overStr As PdfContentByte = stamper.GetOverContent(1) For Each i In listToWrite If i.Text <> "" Then write(overStr, i, pdf.GetPageSize(1).Height) Next End If End If If barcode IsNot Nothing Then Try Dim n = pdf.NumberOfPages Dim pagesize As iTextSharp.text.Rectangle For cnt = 1 To pdf.NumberOfPages Dim over As PdfContentByte = stamper.GetOverContent(cnt) pagesize = pdf.GetPageSize(cnt) Dim x As Double = 15 'pagesize.Left + 10 Dim y As Double = pagesize.Height / 2 - 100 'pagesize.Top - 50 ' barcode = btnScale_Click2(barcode, 40) barcode.RotateFlip(RotateFlipType.Rotate270FlipNone) 'MsgBox(mm(pagesize.Height)) Dim image As iTextSharp.text.Image = iTextSharp.text.Image.GetInstance(barcode, System.Drawing.Imaging.ImageFormat.Png) ' Dim image As iTextSharp.text.Image = iTextSharp.text.Image.GetInstance(New Bitmap(80, 80), System.Drawing.Imaging.ImageFormat.Bmp) image.SetAbsolutePosition(x, y) 'Dim r As iTextSharp.text.Image = iTextSharp.text.Rectangle 'image.Width = 35 over.AddImage(image) Next Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try End If If barcodeLKW IsNot Nothing Then Try Dim n = pdf.NumberOfPages Dim pagesize As iTextSharp.text.Rectangle For cnt = 1 To pdf.NumberOfPages Dim over As PdfContentByte = stamper.GetOverContent(cnt) pagesize = pdf.GetPageSize(cnt) Dim x As Double = 40 'pagesize.Left + 10 Dim y As Double = pagesize.Top - 80 Dim image As iTextSharp.text.Image = iTextSharp.text.Image.GetInstance(barcodeLKW, System.Drawing.Imaging.ImageFormat.Png) image.SetAbsolutePosition(x, y) over.AddImage(image) Next Catch ex As Exception MsgBox(ex.Message & ex.StackTrace) End Try End If stamper.FormFlattening = Not editierbar stamper.Close() If openfile Then If autoDruck Then PrintViaGS(destPath, printerName) 'If Not PrintFile(destPath, printerName) Then Process.Start(destPath) ' Druck! Wenn Problem, wird das PDF geöffnet Else Process.Start(destPath) End If Else 'weiter zu return End If fw.Close() End Using pdf.Close() Return destPath Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Return "" End Function Public Function getPDFFields_Editierbar(da_kategorie As String, da_ordner As String, da_uOrdner1 As String, da_uOrdner2 As String, da_uOrdner3 As String, da_name As String) As List(Of VERAG_PROG_ALLGEMEIN.MyListItem) Dim list As New List(Of VERAG_PROG_ALLGEMEIN.MyListItem) Try Dim DS As New cDATENSERVER(da_kategorie, da_ordner, da_uOrdner1, da_uOrdner2, da_uOrdner3, da_name) If Not DS.hasITEMS Then Return list Dim path_src As String = DS.OPEN_SINGLE(False) If path_src = "" Then Return list Dim fi As New System.IO.DirectoryInfo(path_src) Dim destPath = DATENVERVER_OPTIONS.getTMPPath(fi.Name, fi.Extension, True, False) Dim pdf As iTextSharp.text.pdf.PdfReader = New iTextSharp.text.pdf.PdfReader(path_src) pdf.unethicalreading = True Using fw As New FileStream(destPath, FileMode.OpenOrCreate) Dim stamper = New PdfStamper(pdf, fw) Try Dim f = stamper.AcroFields If f IsNot Nothing AndAlso f.Fields.Count > 0 Then f.GenerateAppearances = True For Each r In f.Fields Dim key = r.Key.ToString Dim value = IIf(f.GetField(r.Key.ToString) = "", " ", r.Key.ToString) Dim listItem As VERAG_PROG_ALLGEMEIN.MyListItem listItem = New VERAG_PROG_ALLGEMEIN.MyListItem(r.Key.ToString, f.GetField(r.Key.ToString)) list.Add(listItem) Next Else 'MsgBox("In der Vorlage wurden sind keine ausfühlbaren Felder vorhanden!") End If Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try End Using Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Return list End Function Public Function fillPDFVorhandenesLokalesPDF_Path(path As String, listToWrite As List(Of cPDFWriteValues), Optional editierbar As Boolean = True, Optional autoDruck As Boolean = False, Optional printerName As String = "", Optional genNewPath As Boolean = True, Optional barcode As List(Of barcodeToPdf) = Nothing) As String Return fillPDF("", "", "", "", "", "", listToWrite, editierbar, autoDruck, printerName, genNewPath, path, barcode) End Function Public Function fillPDF(da_kategorie As String, da_ordner As String, da_uOrdner1 As String, da_uOrdner2 As String, da_uOrdner3 As String, da_name As String, listToWrite As List(Of cPDFWriteValues), Optional editierbar As Boolean = True, Optional autoDruck As Boolean = False, Optional printerName As String = "", Optional genNewPath As Boolean = True, Optional vorhandenesLokalesPDF_Path As String = "", Optional barcode As List(Of barcodeToPdf) = Nothing) As String Try Dim path_src As String = "" If vorhandenesLokalesPDF_Path = "" Then Dim DS As New cDATENSERVER(da_kategorie, da_ordner, da_uOrdner1, da_uOrdner2, da_uOrdner3, da_name) If Not DS.hasITEMS Then Return "" path_src = DS.GET_TOP1_PATH Else path_src = vorhandenesLokalesPDF_Path End If Dim fi As New System.IO.DirectoryInfo(path_src) Dim destPath = "" destPath = DATENVERVER_OPTIONS.getTMPPath(fi.Name, fi.Extension, True, False) Dim pdf As iTextSharp.text.pdf.PdfReader = New iTextSharp.text.pdf.PdfReader(path_src) Using fw As New FileStream(destPath, FileMode.OpenOrCreate) Dim stamper = New PdfStamper(pdf, fw) If True Then If listToWrite IsNot Nothing Then For Each i In listToWrite Dim overStr As PdfContentByte = stamper.GetOverContent(i.getPage) If overStr IsNot Nothing AndAlso i.Text <> "" Then Dim height = pdf.GetPageSize(i.getPage).Height If height IsNot Nothing Then write(overStr, i, height) End If Next End If End If If barcode IsNot Nothing Then For Each bc As barcodeToPdf In barcode Try ' Dim n = pdf.NumberOfPages Dim pagesize As iTextSharp.text.Rectangle Dim over As PdfContentByte = stamper.GetOverContent(bc.onpage) pagesize = pdf.GetPageSize(bc.onpage) 'Dim x As Double = 40 'pagesize.Left + 10 'Dim y As Double = pagesize.Top - 80 bc.image.RotateFlip(bc.rotate) Dim image As iTextSharp.text.Image = iTextSharp.text.Image.GetInstance(bc.image, System.Drawing.Imaging.ImageFormat.Png) image.SetAbsolutePosition(bc.x, pagesize.Top - bc.y) over.AddImage(image) Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Next End If stamper.FormFlattening = Not editierbar stamper.Close() If autoDruck Then PrintViaGS(destPath, printerName) Else 'Process.Start(destPath) End If fw.Close() End Using pdf.Close() Return destPath Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) Return "" End Try End Function Public Shared f_bold As BaseFont = BaseFont.CreateFont(BaseFont.HELVETICA_BOLD, BaseFont.WINANSI, BaseFont.NOT_EMBEDDED) Public Shared f_normal As BaseFont = BaseFont.CreateFont(BaseFont.HELVETICA, BaseFont.WINANSI, BaseFont.NOT_EMBEDDED) Shared Function getFont(t) As BaseFont If t = "bold" Then Return f_bold If t = "normal" Then Return f_normal Return Nothing End Function Shared Function mm(pnt As Double) As Integer Return CInt(iTextSharp.text.Utilities.MillimetersToPoints(pnt)) End Function Public Shared Sub write(ByVal cb As PdfContentByte, i As cPDFWriteValues, pageHeight As Integer) ' ByVal Text As String, ByVal X As Integer, ByVal Y As Integer, ByVal height As Integer, ByVal width As Integer, ByVal font As String, ByVal Size As Integer, Optional maxlength As Integer = -1, Optional align As Integer = PdfContentByte.ALIGN_LEFT) Dim myCol As New ColumnText(cb) Dim f As iTextSharp.text.Font = New iTextSharp.text.Font(1, i.Size, 0) Select Case i.font 'Case "normal" ' f = New iTextSharp.text.Font(1, i.Size, 0) Case "bold" f = New iTextSharp.text.Font(1, i.Size, 1) Case "boldRed" f = New iTextSharp.text.Font(1, i.Size, 1) f.Color = iTextSharp.text.BaseColor.RED Case "italic" f = New iTextSharp.text.Font(1, i.Size, 2) Case "underine" f = New iTextSharp.text.Font(1, i.Size, 4) End Select Dim paragraph = New iTextSharp.text.Paragraph(New iTextSharp.text.Chunk(CStr(i.Text), f)) '1=Helvetica pageHeight = CInt(iTextSharp.text.Utilities.PointsToMillimeters(pageHeight)) ' in mm myCol.SetSimpleColumn(mm(i.getX), mm(pageHeight - i.getY - i.getHeight), mm(i.getX + i.getWidth), mm(pageHeight - i.getY), i.Size, i.getAlign) ' ' 1. the phrase ' 2. lower -Left() - x ' 3. lower -Left() - y ' 4. upper -Right() - x(llx + width) ' 5. upper -Right() - y(lly + height) ' 6. leading (The amount of blank space between lines of print) ' 7. alignment. myCol.AddText(paragraph) myCol.Go() End Sub Function btnScale_Click(bm_source As Bitmap, height As Integer) As Bitmap Dim width As Integer = bm_source.Width / (bm_source.Height / height) ' Make a bitmap for the result. Dim bm_dest As New Bitmap(width, height) ' Make a Graphics object for the result Bitmap. Dim gr_dest As Graphics = Graphics.FromImage(bm_dest) ' Copy the source image into the destination bitmap. gr_dest.DrawImage(bm_source, 0, 0, bm_dest.Width + 1, bm_dest.Height + 1) ' Display the result. Return bm_dest End Function Function btnScale_Click2(bm_source As Bitmap, height As Integer) As Bitmap Dim width As Integer = bm_source.Width * 0.7 ' Make a bitmap for the result. Dim bm_dest As New Bitmap(width, height) ' Make a Graphics object for the result Bitmap. Dim gr_dest As Graphics = Graphics.FromImage(bm_dest) ' Copy the source image into the destination bitmap. gr_dest.DrawImage(bm_source, 0, 0, bm_dest.Width + 1, bm_dest.Height + 1) ' Display the result. Return bm_dest End Function Public Shared Function PrintFile(fileName As String, printerName As String) As Boolean Try Dim psi As New ProcessStartInfo psi.UseShellExecute = True psi.CreateNoWindow = True psi.Verb = "PrintTo" psi.WindowStyle = ProcessWindowStyle.Hidden If printerName <> "" Then psi.Arguments = printerName Else Dim p As New PrintDialog If (p.ShowDialog() = DialogResult.OK) Then psi.Arguments = p.PrinterSettings.PrinterName Else Return False End If End If psi.FileName = fileName ' Need to replace this with a string based on the textbox1 input and add .pdf to the string and the location of it for printing. Using P As New Process ' P.StartInfo = psi P.StartInfo.UseShellExecute = True P.StartInfo.CreateNoWindow = True P.StartInfo.Arguments = printerName P.StartInfo.WindowStyle = ProcessWindowStyle.Hidden P.StartInfo.Verb = "PrintTo" ' P.StartInfo.FileName = PDFs(PDFs.Count - 1) 'P.StartInfo.Verb = "Print" P.Start() P.WaitForExit() End Using 'Process.Start(psi) Return True Catch ex As Exception Return False End Try End Function '??????????????????????????????????????????'??????????????????????????????????????????'??????????????????????????????????????????'??????????????????????????????????????????'?????????????????????????????????????????? 'Dim pdftmp As New Spire.PdfViewer.Forms.PdfViewer ' pdftmp.LoadFromFile("C:\Users\DEVELOPER1\Desktop\Agrotel.pdf") ' pdftmp.Print() ' Dim docs As PdfDocument() = {New PdfDocument("C:\Users\DEVELOPER1\Desktop\Agrotel.pdf")} ' For Each doc As PdfDocument In docs ' doc.PageSettings.Size = PdfPageSize.A4 ' doc.PrintDocument.DefaultPageSettings.Landscape = True ' doc.PageScaling = PdfPrintPageScaling.FitSize ' doc.PrinterName = "ES3452 MFP(PCL)" ' doc.PrintDocument.Print() ' Next Public Shared Sub PrintViaSpirePDF(PDFFile As List(Of String), Optional printerName As String = "") PrintViaSpirePDF(PDFFile.ToArray, printerName) End Sub Public Shared Sub mergePDFs(files As List(Of String), ByRef outputFile As String) 'If Not VERAG_PROG_ALLGEMEIN.cProgramFunctions.spireLoadLicense() Then MsgBox("Fehler beim Laden der SPIRE-Lizenz") files.RemoveAll(Function(v) v.Equals("")) 'Alle leeren Stings löschen If files.Count > 0 Then Dim doc As Spire.Pdf.PdfDocumentBase = Spire.Pdf.PdfDocument.MergeFiles(files.ToArray) doc.Save(outputFile, Spire.Pdf.FileFormat.PDF) End If End Sub Public Shared Sub PrintViaSpirePDF(PDFFile As String(), Optional printerName As String = "") '---------------------WEGEN PERFORMANCE-PROBLEMEN DEAKTIVIERT! 'Try ' Dim printerPaperSizeA4 As Boolean = False ' If printerName = "" Then ' Dim sPrinters As ArrayList ' If VERAG_PROG_ALLGEMEIN.cAllgemein.PRINTER_LIST IsNot Nothing Then ' sPrinters = VERAG_PROG_ALLGEMEIN.cAllgemein.PRINTER_LIST ' Else ' sPrinters = New ArrayList ' For Each sPrinter As String In System.Drawing.Printing.PrinterSettings.InstalledPrinters ' sPrinters.Add(sPrinter) ' Next ' End If ' If VERAG_PROG_ALLGEMEIN.cAllgemein.PRINTER_STANDARD <> String.Empty Then ' For Each printer In sPrinters ' If printer.ToString.ToLower.Contains(VERAG_PROG_ALLGEMEIN.cAllgemein.PRINTER_STANDARD.ToLower) Then ' printerName = printer ' For Each installedPrinter In System.Drawing.Printing.PrinterSettings.InstalledPrinters ' If printerName = installedPrinter.ToString Then ' Dim currentInstalledPrinter As New System.Drawing.Printing.PrinterSettings ' currentInstalledPrinter.PrinterName = printerName ' For Each sizes In currentInstalledPrinter.PaperSizes ' If sizes.PaperName = "A4" Then ' printerPaperSizeA4 = True ' Exit For ' End If ' Next ' Exit For ' End If ' Next ' Exit For ' End If ' Next ' End If ' End If ' If printerName = "" Then ' Dim oPS As New System.Drawing.Printing.PrinterSettings ' printerName = oPS.PrinterName ' For Each sizes In oPS.PaperSizes ' If sizes.PaperName = "A4" Then printerPaperSizeA4 = True ' Exit For ' Next ' Else ' If Not printerPaperSizeA4 Then ' Dim currentInstalledPrinter As New System.Drawing.Printing.PrinterSettings ' currentInstalledPrinter.PrinterName = printerName ' For Each sizes In currentInstalledPrinter.PaperSizes ' If sizes.PaperName = "A4" Then printerPaperSizeA4 = True ' Exit For ' Next ' End If ' End If ' If printerName = "" Then ' MsgBox("Drucker konnte nicht ermittelt werden!") ' Exit Sub ' End If ' If Not printerPaperSizeA4 Then ' MsgBox("Der ermittelte Drucker " & printerName & " unterstützt keinen A4 Ausdrucke!" & vbNewLine & "Vorang wird abgebrochen!") ' Exit Sub ' End If ' VERAG_PROG_ALLGEMEIN.cProgramFunctions.spireLoadLicense() ' For Each pdfPath In PDFFile ' Dim doc As New Spire.Pdf.PdfDocument(pdfPath) ' doc.PageSettings.Size = Spire.Pdf.PdfPageSize.A4 ' doc.PageSettings.Orientation = Spire.Pdf.PdfPageOrientation.Landscape ' doc.PrintSettings.SelectSinglePageLayout(PdfSinglePageScalingMode.FitSize, True) ' doc.PrintSettings.PrinterName = printerName ' If doc.PrintSettings.IsValid Then ' doc.Print() ' Else ' MsgBox("Druckereinstellungen ungültig!") ' Exit Sub ' End If ' Next Try If printerName = "" Then Dim sPrinters As ArrayList If VERAG_PROG_ALLGEMEIN.cAllgemein.PRINTER_LIST IsNot Nothing Then sPrinters = VERAG_PROG_ALLGEMEIN.cAllgemein.PRINTER_LIST Else sPrinters = New ArrayList For Each sPrinter As String In System.Drawing.Printing.PrinterSettings.InstalledPrinters sPrinters.Add(sPrinter) Next End If If VERAG_PROG_ALLGEMEIN.cAllgemein.PRINTER_STANDARD <> String.Empty Then For i As Integer = 0 To sPrinters.Count - 1 If i.ToString.ToLower.Contains(VERAG_PROG_ALLGEMEIN.cAllgemein.PRINTER_STANDARD.ToLower) Then printerName = i End If Next End If If printerName = "" Then Dim oPS As New System.Drawing.Printing.PrinterSettings printerName = oPS.PrinterName End If End If If printerName = "" Then MsgBox("Drucker konnte nicht ermittelt werden!") Exit Sub End If 'If Not printerPaperSizeA4 Then ' MsgBox("Der ermittelte Drucker " & printerName & " unterstützt keinen A4 Ausdrucke!" & vbNewLine & "Vorang wird abgebrochen!") ' Exit Sub 'End If 'If Not VERAG_PROG_ALLGEMEIN.cProgramFunctions.spireLoadLicense() Then MsgBox("Fehler beim Laden der SPIRE-Lizenz") For Each pdfPath As String In PDFFile Dim doc As New Spire.Pdf.PdfDocument(pdfPath) doc.PageSettings.Size = Spire.Pdf.PdfPageSize.A4 doc.PageSettings.Orientation = Spire.Pdf.PdfPageOrientation.Landscape doc.PrintSettings.SelectSinglePageLayout(PdfSinglePageScalingMode.FitSize, True) doc.PrintSettings.PrinterName = printerName doc.Print() Next Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try End Sub 'Public Shared Sub PrintViaitext7(PDFFile As String(), Optional printerName As String = "") ' Try ' Catch ex As Exception ' MsgBox(ex.Message & ex.StackTrace) ' End Try 'End Sub Public Shared Sub Print_PICTURE(File As String(), Optional printerName As String = "") Try If printerName = "" Then Dim oPS As New System.Drawing.Printing.PrinterSettings printerName = oPS.PrinterName End If 'Dim docs As Spire.Pdf.PdfDocument() = {New Spire.Pdf.PdfDocument("C:\Users\DEVELOPER1\Desktop\Agrotel.pdf")} For Each pdfPath In File Dim printer As PrintDocument = New PrintDocument AddHandler printer.PrintPage, Sub(snd As Object, ev As PrintPageEventArgs) Dim img As Image = Image.FromFile(pdfPath) ev.Graphics.DrawImage(img, ev.PageBounds) End Sub ' printer.PrinterSettings.DefaultPageSettings.PrintableArea. printer.Print() 'Dim PrintDocument1 As PrintDocument = New PrintDocument 'PrintDocument1.DocumentName = pdfPath ''PrintDialog1.Document = PrintDocument1 ''PrintDocument1.PrinterSettings. 'PrintDocument1.Print() Next Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try End Sub Public Shared Sub PrintViaSpirePDF_FromURL(URLs As String(), Optional printerName As String = "") Try 'If Not VERAG_PROG_ALLGEMEIN.cProgramFunctions.spireLoadLicense() Then MsgBox("Fehler beim Laden der SPIRE-Lizenz") If printerName = "" Then Dim oPS As New System.Drawing.Printing.PrinterSettings printerName = oPS.PrinterName End If 'Dim docs As Spire.Pdf.PdfDocument() = {New Spire.Pdf.PdfDocument("C:\Users\DEVELOPER1\Desktop\Agrotel.pdf")} 'For Each doc As Spire.Pdf.PdfDocument In docs For Each pdfPath In URLs 'Dim doc As New Spire.Pdf.PdfDocument() Using webClient As New Net.WebClient() Dim data() As Byte = webClient.DownloadData(pdfPath) Using stream As New MemoryStream(data) Dim doc As Spire.Pdf.PdfDocument = New Spire.Pdf.PdfDocument(stream) If doc IsNot Nothing Then doc.PageSettings.Size = Spire.Pdf.PdfPageSize.A4 'doc.PrintDocument.DefaultPageSettings.Landscape = True 'doc.PageScaling = Spire.Pdf.PdfPrintPageScaling.FitSize 'doc.PrinterName = printerName 'doc.PrintDocument.Print() doc.PageSettings.Orientation = Spire.Pdf.PdfPageOrientation.Landscape doc.PrintSettings.SelectSinglePageLayout(PdfSinglePageScalingMode.FitSize, True) doc.PrintSettings.PrinterName = printerName doc.Print() End If End Using End Using ' doc.LoadFromHTML(pdfPath, True, True, True) Next Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try End Sub Shared Function getTMPPath_PDF() As String Return System.IO.Path.GetTempPath() & Guid.NewGuid().ToString() & ".pdf" End Function Shared Function getTMPPath_MSG() As String Return System.IO.Path.GetTempPath() & Guid.NewGuid().ToString() & ".msg" End Function Public Shared Function getPDFViaSpirePDF_FromURL(URL As String, Optional targetPath As String = "") As String Try If targetPath = "" Then targetPath = getTMPPath_PDF() 'If Not VERAG_PROG_ALLGEMEIN.cProgramFunctions.spireLoadLicense() Then MsgBox("Fehler beim Laden der SPIRE-Lizenz") Dim doc As New Spire.Pdf.PdfDocument '= New Spire.Pdf.PdfDocument(URL) doc.LoadFromHTML(URL, True, True, True) If doc IsNot Nothing Then doc.PageSettings.Size = Spire.Pdf.PdfPageSize.A4 ' doc.PrintDocument.DefaultPageSettings.Landscape = True 'doc.PageScaling = Spire.Pdf.PdfPrintPageScaling.FitSize doc.PageSettings.Orientation = Spire.Pdf.PdfPageOrientation.Landscape doc.PrintSettings.SelectSinglePageLayout(PdfSinglePageScalingMode.FitSize, True) ' doc.PrinterName = printerName ' doc.PrintDocument.Print() doc.SaveToFile(targetPath) End If Return targetPath Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Return "" End Function Public Shared Function getPDFViaSpirePDF_FromURLStream(URL As String, Optional filename As String = "", Optional targetPath As String = "", Optional openFileAfterDownload As Boolean = True) As String Try If targetPath = "" Then If filename <> "" Then targetPath = System.IO.Path.GetTempPath() & filename & ".pdf" Else targetPath = getTMPPath_PDF() End If End If 'If Not VERAG_PROG_ALLGEMEIN.cProgramFunctions.spireLoadLicense() Then MsgBox("Fehler beim Laden der SPIRE-Lizenz") Using webClient As New Net.WebClient() Dim data() As Byte = webClient.DownloadData(URL) Using stream As New MemoryStream(data) Dim doc As Spire.Pdf.PdfDocument = New Spire.Pdf.PdfDocument doc.LoadFromStream(stream) If doc IsNot Nothing Then doc.PageSettings.Size = Spire.Pdf.PdfPageSize.A4 If targetPath.EndsWith(".pdf") Then doc.SaveToFile(targetPath) Else doc.SaveToFile(targetPath & "\" & filename) End If If openFileAfterDownload Then End If End If End Using End Using Return targetPath Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Return "" End Function Public Shared Sub PrintViaGS(PDFFile As String, printerName As String) Try Dim assembly = System.Reflection.Assembly.GetExecutingAssembly() Dim location As String = assembly.CodeBase Dim fullPath As String = New Uri(location).LocalPath Dim directoryPath As String = Path.GetDirectoryName(fullPath) Dim MyP As New System.Diagnostics.Process MyP.StartInfo.FileName = directoryPath & "\Resources\GS\gswin32c.exe" Dim sw As New List(Of String)() 'MyP.StartInfo.Arguments = "-dPrinted -dBATCH -dNOPAUSE -dNOSAFER -dPDFFitPage -dNumCopies=1 -dNoCancel -sDEVICE=mswinpr2 " & (Convert.ToString("-sOutputFile=%printer%") & printerName) & " -f" & PDFFile ' MyP.StartInfo.Arguments = "-dPrinted -dBATCH -dNOPAUSE -dNOSAFER -dPDFFitPage -dNumCopies=1 -dNoCancel -sDEVICE=mswinpr2 -sOutputFile=" & PDFFile ' & " -f" & PDFFile 'OK MyP.StartInfo.Arguments = "-dPrinted -dBATCH -dNOPROMPT -dNOSAFER -dPDFFitPage -dNumCopies=1 -dNoCancel -sDEVICE=ppmraw -sOutputFile=""%printer%" & printerName & """ -f " & PDFFile ' MyP.StartInfo.Arguments = "-dPrinted -dBATCH -dNOPROMPT -dNOSAFER -dQUIET -dNOPAUSE -dNOSAFER -sDEVICE=mswinpr2 -dPDFFitPage -dNumCopies=1 -dNoCancel -sOutputFile=""%printer%" & printerName & """ -f " & PDFFile MyP.StartInfo.Arguments = "-dPrinted -dBATCH -dNOPROMPT -dNOSAFER -dQUIET -dNOPAUSE -dNOSAFER -sDEVICE=mswinpr2 -dPDFFitPage -dNumCopies=1 -dNoCancel -sOutputFile=""%printer%" & printerName & """ -f " & PDFFile '-dQUIET -sDEVICE=jpeg mswinpr2 ' MsgBox(MyP.StartInfo.Arguments) MyP.StartInfo.UseShellExecute = False MyP.StartInfo.CreateNoWindow = True ' MyP.StartInfo.WindowStyle = ProcessWindowStyle.Hidden MyP.StartInfo.RedirectStandardOutput = True MyP.StartInfo.RedirectStandardError = True MyP.StartInfo.CreateNoWindow = True MyP.Start() ' Using processor As New GhostscriptProcessor() ' Dim switches As New List(Of String)() ' switches.Add("-empty") 'switches.Add("-dPrinted") 'switches.Add("-dBATCH") 'switches.Add("-dNOPAUSE") 'switches.Add("-dNOSAFER") 'switches.Add("-dPDFFitPage") 'switches.Add("-dNumCopies=1") 'switches.Add("-sDEVICE=mswinpr2") 'mswinpr2 'switches.Add("-dNoCancel") 'switches.Add(Convert.ToString("-sOutputFile=%printer%") & printerName) 'switches.Add("-f") 'switches.Add(PDFFile) 'processor.StartProcessing(switches.ToArray(), Nothing) 'End Using Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try End Sub Public Shared Function PrintFadile2(fileName As String, printerName As String) As Boolean PrintViaGS(fileName, printerName) Return True ' Dim rasterizer As Ghostscript.NET.Rasterizer.GhostscriptRasterizer Dim rasterizer = New Ghostscript.NET.Rasterizer.GhostscriptRasterizer rasterizer.Open(fileName) '//Image page = rasterizer.GetPage(96,96); <-- this one prints ok Dim page As Image = rasterizer.GetPage(600, 600, 1) ' doc.DocumentName = fileName Dim doc As New PrintDocument doc.PrinterSettings.PrinterName = printerName doc.PrinterSettings.Copies = 1 ' doc.PrinterSettings.PaperSizes AddHandler doc.PrintPage, Sub(send As System.Object, ev As System.Drawing.Printing.PrintPageEventArgs) Dim g As Graphics = ev.Graphics g.DrawImage(page, 5, 5) End Sub doc.Print() End Function Function getRechtsform(firma) As String If firma.Trim.Replace(" ", "").ToLower.EndsWith("GMBH&COKG".ToLower) Then Return "GMBH & CO KG" If firma.Trim.Replace(" ", "").ToLower.EndsWith("GMBH".ToLower) Then Return "GMBH" If firma.Trim.ToLower.EndsWith(" AG".ToLower) Then Return "Aktiengesellschaft" If firma.Trim.ToLower.EndsWith(" OG".ToLower) Then Return "Offene Gesellschaft" If firma.Trim.Replace(" ", "").ToLower.EndsWith("e.U.".ToLower) Then Return "Eingetragenes Einzelunternehmen" If firma.Trim.Replace(" ", "").ToLower.EndsWith("GesbR".ToLower) Then Return "Gesellschaft bürgerl. Rechts" If firma.Trim.Replace(" ", "").ToLower.EndsWith("GesmbH".ToLower) Then Return "GMBH" If firma.Trim.Replace(" ", "").ToLower.EndsWith("Ges.mbH".ToLower) Then Return "GMBH" If firma.Trim.Replace(" ", "").ToLower.EndsWith("Ges.m.b.H.".ToLower) Then Return "GMBH" If firma.Trim.ToLower.EndsWith(" KEG".ToLower) Then Return "Kommanditerwerbsgesellschaft" If firma.Trim.ToLower.EndsWith(" KG".ToLower) Then Return "Kommanditgesellschaft " If firma.Trim.ToLower.EndsWith(" OEG ".ToLower) Then Return "Offene Erwerbsgesellschaft" If firma.Trim.ToLower.EndsWith(" OHG ".ToLower) Then Return "Offene Handelsgesellschaft" If firma.Trim.ToLower.EndsWith(" SCE".ToLower) Then Return "Europäische Genossenschaft" If firma.Trim.ToLower.EndsWith(" SE".ToLower) Then Return "Europäische Gesellschaft" Return "" End Function Public Shared Sub PrintViaSpirePDF(task As Task(Of List(Of String))) Throw New NotImplementedException() End Sub End Class Public Class cDatenarchiv_Collection Property coll_id As Object = Nothing Property coll_daId As Object = Nothing Property coll_bezeichnung As String = "" Property coll_pfad As String = "" Property coll_info As String = "" Property coll_date As Date = Now Property coll_archiv As Boolean = False Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL Sub New(coll_daId, coll_pfad, coll_bezeichnung, coll_info, coll_archiv) Me.coll_daId = coll_daId Me.coll_pfad = coll_pfad Me.coll_bezeichnung = coll_bezeichnung Me.coll_info = coll_info Me.coll_archiv = coll_archiv End Sub Sub New(coll_id, coll_daId, coll_pfad, coll_bezeichnung, coll_info, coll_archiv) Me.coll_id = coll_id Me.coll_daId = coll_daId Me.coll_pfad = coll_pfad Me.coll_bezeichnung = coll_bezeichnung Me.coll_info = coll_info Me.coll_archiv = coll_archiv End Sub Public Function DELETE() As Boolean Try If coll_pfad.Contains(VERAG_PROG_ALLGEMEIN.DATENVERVER_OPTIONS.getRootDir) Then '"\\192.168.0.91\DATENARCHIV\") Then 'Um sicher zu gehen, dass der pfad im richtigem VZ ist. If My.Computer.FileSystem.FileExists(coll_pfad) Then saveFileToDel(coll_pfad) Try System.IO.File.Delete(coll_pfad) Catch : End Try Return SQL.doSQL("DELETE FROM [tblDatenarchiv_Collection] WHERE [coll_id]=" & coll_id & " ", "FMZOLL") Else Return True End If End If Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Return False End Function Sub saveFileToDel(path) Dim delPath = "" If VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM Then delPath = path.Replace("\DATENARCHIV_TESTSYSTEM\", "\DATENARCHIV_TESTSYSTEM\DELETE\") Else delPath = path.Replace("\DATENARCHIV\", "\DATENARCHIV\DELETE\") '\\192.168.0.91\Datenarchiv\DOKUMENTE\VORLAGEN\FISKALSCHREIBEN End If If Not System.IO.Directory.Exists(delPath.Substring(0, delPath.LastIndexOf("\"))) Then System.IO.Directory.CreateDirectory(delPath.Substring(0, delPath.LastIndexOf("\"))) If System.IO.File.Exists(delPath) Then If delPath.Contains(".") Then Dim commaIndex = delPath.LastIndexOf(".") delPath = delPath.Substring(0, commaIndex) + Now.ToString("_del_ddMMyyyy_HHmmss") + delPath.Substring(commaIndex) ' + 1) ' delPath = delPath.Substring(0, delPath.LastIndexOf(".") - 1) & Now.ToString("_ddMMyyyy_HHmmss") & delPath.Substring(delPath.LastIndexOf("."), delPath.LastIndexOf(".") - 1) ' delPath.LastIndexOf(".") ' delPath.Replace(".", Now.ToString("_ddMMyyyy_HHmmss") & ".") End If End If System.IO.File.Copy(path, delPath) End Sub Function INSERT() As Integer Try 'If coll_id < 0 Then 'Wenn noch keine ID vergeben 'Me.coll_id = getMaxId() 'End If Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL() Using cmd As New SqlCommand("INSERT INTO tblDatenarchiv_Collection (coll_daId,coll_pfad, coll_bezeichnung, coll_info,coll_archiv) VALUES (@coll_daId,@coll_pfad, @coll_bezeichnung, @coll_info,@coll_archiv) ", conn) cmd.Parameters.AddWithValue("@coll_daId", coll_daId) cmd.Parameters.AddWithValue("@coll_pfad", coll_pfad) cmd.Parameters.AddWithValue("@coll_bezeichnung", coll_bezeichnung) cmd.Parameters.AddWithValue("@coll_info", coll_info) cmd.Parameters.AddWithValue("@coll_archiv", coll_archiv) cmd.ExecuteNonQuery() Dim newcmd As New SqlCommand("SELECT @@IDENTITY", conn) Dim id = CInt(newcmd.ExecuteScalar) Me.coll_id = id Return id End Using End Using Return True Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) Return -1 End Try End Function Function UPDATE() As Boolean Try 'If coll_id < 0 Then 'Wenn noch keine ID vergeben 'Me.coll_id = getMaxId() 'End If Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL() Using cmd As New SqlCommand("UPDATE tblDatenarchiv_Collection SET coll_daId=@coll_daId,coll_pfad=@coll_pfad, coll_bezeichnung=@coll_bezeichnung, coll_info=@coll_info,coll_archiv=@coll_archiv WHERE [coll_id]=@coll_id ", conn) cmd.Parameters.AddWithValue("@coll_id", coll_id) cmd.Parameters.AddWithValue("@coll_daId", coll_daId) cmd.Parameters.AddWithValue("@coll_pfad", coll_pfad) cmd.Parameters.AddWithValue("@coll_bezeichnung", coll_bezeichnung) cmd.Parameters.AddWithValue("@coll_info", coll_info) cmd.Parameters.AddWithValue("@coll_archiv", coll_archiv) cmd.ExecuteNonQuery() Return True End Using End Using Return True Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) Return False End Try End Function Public Function OPEN(Optional openFILE As Boolean = True, Optional useBezeichnung As Boolean = False) As String If Not System.IO.File.Exists(coll_pfad) Then MsgBox("Die Datei existiert nicht") : Return "" Dim fi As New System.IO.DirectoryInfo(coll_pfad) Dim destPath = "" If useBezeichnung Then destPath = DATENVERVER_OPTIONS.copyToTmp_KeepFilename(coll_pfad, coll_bezeichnung) Else destPath = DATENVERVER_OPTIONS.getTMPPath(fi.Name, fi.Extension, , False) End If ' MsgBox(destPath) System.IO.File.Copy(coll_pfad, destPath, True) If openFILE Then Process.Start(destPath) Return destPath End Function Public Function OPEN_ORIG(Optional openFILE As Boolean = True) As String If Not System.IO.File.Exists(coll_pfad) Then MsgBox("Die Datei existiert nicht") : Return "" If openFILE Then Process.Start(coll_pfad) Return coll_pfad End Function End Class Public Class cDatenserverIDCollectionList Property coll_daId = -1 Property rootDir = "" Property LIST As New List(Of cDatenarchiv_Collection) Public lastID = -1 Sub New() End Sub Sub New(coll_daId, rootDir) Me.coll_daId = coll_daId Me.rootDir = rootDir LOAD() End Sub Public Sub LOAD() Try LIST.Clear() Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL() 'Using cmd As New SqlCommand("SELECT coll_id, coll_daId, da_pfad, da_name FROM tblDatenarchiv_Collection INNER JOIN tblDatenarchiv ON coll_daId=da_id WHERE coll_id=@coll_id ", conn) Using cmd As New SqlCommand("SELECT coll_id, coll_daId, coll_pfad, coll_bezeichnung,coll_info,coll_archiv FROM tblDatenarchiv_Collection WHERE coll_daId=@coll_daId order by coll_bezeichnung ", conn) ' order by [coll_date] desc cmd.Parameters.AddWithValue("@coll_daId", Me.coll_daId) Dim dr = cmd.ExecuteReader() 'LIST = New List(Of cDatenarchiv_Collection) While dr.Read LIST.Add(New cDatenarchiv_Collection(dr.Item("coll_id"), dr.Item("coll_daId"), dr.Item("coll_pfad"), dr.Item("coll_bezeichnung"), dr.Item("coll_info"), dr.Item("coll_archiv"))) End While dr.Close() End Using End Using Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try End Sub Public Function getMaxId() As Integer getMaxId = -1 Try Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL() Using cmd As New SqlCommand("SELECT isnull(max(coll_id),0)+1 FROM tblDatenarchiv_Collection ", conn) Dim dr = cmd.ExecuteReader() If dr.Read Then getMaxId = dr.Item(0) End If dr.Close() End Using End Using Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try End Function Function ADD(srcpath, destPath, coll_bezeichnung, coll_info, coll_archiv) As Boolean Try Dim l As New cDatenarchiv_Collection(coll_daId, destPath, coll_bezeichnung, coll_info, coll_archiv) Dim ID = l.INSERT() If ID > 0 Then 'COPY Dim errorMsg = "ERR" If COPY_FILE(srcpath, destPath, errorMsg) Then ' Der Eintrag wird in die Liste aufgenommen. LIST.Add(l) lastID = l.coll_id Else ' Wenn beim Kopieren ein Fehler aufgetreten ist, wird der DB_Eintrag gelöscht, ' der Eintrag wird nicht in die Liste aufgenommen. l.DELETE() VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(errorMsg, errorMsg, System.Reflection.MethodInfo.GetCurrentMethod.Name) Return False End If End If Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) Return False End Try Return True End Function Function ADD_WOcopy(destPath, coll_bezeichnung, coll_info, coll_archiv) As Boolean Try Dim l As New cDatenarchiv_Collection(coll_daId, destPath, coll_bezeichnung, coll_info, coll_archiv) Dim ID = l.INSERT() If ID > 0 Then ' Der Eintrag wird in die Liste aufgenommen. LIST.Add(l) lastID = l.coll_id End If Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) Return False End Try Return True End Function Function COPY_FILE(srcPath, destPath, ByRef errorMsg) As Boolean For i = 1 To 3 '3 Versuche Try System.IO.File.Copy(srcPath, destPath, True) ' Kopiert die Dateien Next Return True Catch ex As Exception errorMsg = ex.Message End Try System.Threading.Thread.Sleep(500) Next Return False End Function Function DELETE_ALL(Optional delteFromFileSystem = True) As Boolean Try If delteFromFileSystem Then LIST.Clear() Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL Return SQL.doSQL("DELETE FROM [tblDatenarchiv_Collection] WHERE [coll_daId]=" & coll_daId & " ", "FMZOLL") Else While LIST.Count > 0 If LIST(0).DELETE() Then LIST.RemoveAt(0) Else Return False End If End While End If Return True Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) Return False End Try End Function Function DELETE_ATPOS(coll_id) As Boolean Try For Each li In LIST If li.coll_id = coll_id Then If li.DELETE() Then LIST.Remove(li) Return True Else Return False End If End If Next Return True Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) Return False End Try End Function End Class Public Class DATENVERVER_OPTIONS ' Public Shared TMP_PATH = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\DatenTMP\" Public Shared TMP_PATH = "C:\VeragTMP\USER_" & VERAG_PROG_ALLGEMEIN.cAllgemein.USRID & "\" Shared Function getTMPPath(name As String, extension As String, Optional special As Boolean = False, Optional delete As Boolean = True, Optional unterOrdner As String = "") As String If Environment.GetFolderPath(Environment.SpecialFolder.Personal) = "" Then ' WEB_SERV TMP_PATH = Path.GetTempPath() & "\VERAG\DatenTMP\" End If ' If Not System.IO.Directory.Exists(TMP_PATH) Then System.IO.Directory.CreateDirectory(TMP_PATH) Dim TMP_PATH2 = TMP_PATH & If(unterOrdner <> "", "\" & unterOrdner & "\", "") TMP_PATH2 = TMP_PATH2.replace("\\", "\") If Not My.Computer.FileSystem.DirectoryExists(TMP_PATH2) Then My.Computer.FileSystem.CreateDirectory(TMP_PATH2) End If If delete Then clearTMPPath(unterOrdner) If name = "" Then name = "TMP" Else name = VERAG_PROG_ALLGEMEIN.cDATENSERVER.replaceInvalidCahr(name) name = name.Replace("?", "") End If Dim destPath = TMP_PATH2 & name If special Then destPath = TMP_PATH2 & name & "_" & Now.ToString("yyyyMMddHHmmssfff") & extension While System.IO.File.Exists(destPath) destPath = TMP_PATH2 & name & "_" & Now.ToString("yyyyMMddHHmmssfff") & extension End While Return destPath End Function Shared Function copyToTmp_KeepFilenameByDS(dId As Integer, bezeichnung As String) As String Dim DS As New cDATENSERVER(dId) Dim pfad As String = DS.GET_TOP1_PATH If pfad = "" Then Return "" Dim fi As New System.IO.FileInfo(pfad) Dim tmpPath = VERAG_PROG_ALLGEMEIN.DATENVERVER_OPTIONS.getTMPPath(bezeichnung, fi.Extension,, False, "ClipBoard_TMP\ClipBoard_" & Now.ToString("ddMMyyyyHHmmss_sss") & "\") Try System.IO.File.Copy(pfad, tmpPath) Return tmpPath Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Return pfad End Function Shared Function copyToTmp_KeepFilename(pfad As String, bezeichnung As String) As String Dim fi As New System.IO.FileInfo(pfad) Dim tmpPath = VERAG_PROG_ALLGEMEIN.DATENVERVER_OPTIONS.getTMPPath(bezeichnung, fi.Extension,, False, "ClipBoard_TMP\ClipBoard_" & Now.ToString("ddMMyyyyHHmmss_sss") & "\") Try System.IO.File.Copy(pfad, tmpPath) Return tmpPath Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Return pfad End Function Shared Function getTMPAbsolutePath(AbsolutePath As String, extension As String, Optional special As Boolean = False, Optional delete As Boolean = True) As String If delete Then Try : System.IO.File.Delete(AbsolutePath) : Catch ex As Exception : End Try End If Dim destPath = AbsolutePath If special Then destPath = AbsolutePath.Replace(extension, "") & "_" & Now.ToString("yyyyMMddHHmmssfff") & extension While System.IO.File.Exists(destPath) destPath = AbsolutePath.Replace(extension, "") & "_" & Now.ToString("yyyyMMddHHmmssfff") & extension End While Return destPath End Function Shared Sub clearTMPPath(Optional unterOrdner As String = "") Dim TMP_PATH2 As String = TMP_PATH & If(unterOrdner <> "", "\" & unterOrdner & "\", "") TMP_PATH2 = TMP_PATH2.Replace("\\", "\") If My.Computer.FileSystem.DirectoryExists(TMP_PATH2) Then For Each file As String In System.IO.Directory.GetFiles(TMP_PATH2) ' Ermittelt alle Dateien des Ordners und löscht diese (sind tmp) Try : System.IO.File.Delete(file) : Catch : End Try Next For Each dir As String In System.IO.Directory.GetDirectories(TMP_PATH2) ' Ermittelt alle Dateien des Ordners und löscht diese (sind tmp) Try : System.IO.Directory.Delete(dir, True) : Catch : End Try Next End If End Sub Shared Function REMANE_FOLDER_KDNR(OLD_V As cDatenserver_Change_Value, NEW_V As cDatenserver_Change_Value) 'kategorie, ordner, kdnr, da_uOrdner1, da_uOrdner2, da_uOrdner3, new_kategorie, new_ordner, new_kdnr, new_uOrdner1, new_uOrdner2, new_uOrdner3) Try If OLD_V Is Nothing Then MsgBox("OLD_V: Keinen Wert angegeben!") : Return False If NEW_V Is Nothing Then MsgBox("NEW_V: Keinen Wert angegeben!") : Return False If OLD_V.da_kategorie = "" Then MsgBox("OLD_V: Keine Kategorie!") : Return False If OLD_V.da_ordner = "" Then MsgBox("OLD_V: Kein Ordner!") : Return False If NEW_V.da_kategorie = "" Then MsgBox("NEW_V: Keine Kategorie!") : Return False If NEW_V.da_ordner = "" Then MsgBox("NEW_V: Kein Ordner!") : Return False 'Dim oldDIR = getDescPath(initRootDir(), kategorie, ordner, da_uOrdner1, da_uOrdner2, da_uOrdner3, kdnr, "", "", True) ' Dim DS As New cDATENSERVER(kategorie, ordner, da_uOrdner1, da_uOrdner2, da_uOrdner3, da_name, kdnr) 'If System.IO.Directory.Exists(oldDIR) Then Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL Dim dt As DataTable = Nothing If OLD_V.da_uOrdner3 IsNot Nothing Then : dt = SQL.loadDgvBySql("select [da_id] from [tblDatenarchiv] where da_KundenNr = '" & OLD_V.da_KundenNr & "' AND da_kategorie ='" & OLD_V.da_kategorie & "' AND da_ordner='" & OLD_V.da_ordner & "' AND da_uOrdner1= '" & OLD_V.da_uOrdner1 & "' AND da_uOrdner2= '" & OLD_V.da_uOrdner2 & "' AND da_uOrdner3='" & OLD_V.da_uOrdner3 & "' ", "FMZOLL") ElseIf OLD_V.da_uOrdner2 IsNot Nothing Then : dt = SQL.loadDgvBySql("select [da_id] from [tblDatenarchiv] where da_KundenNr = '" & OLD_V.da_KundenNr & "' AND da_kategorie ='" & OLD_V.da_kategorie & "' AND da_ordner='" & OLD_V.da_ordner & "' AND da_uOrdner1= '" & OLD_V.da_uOrdner1 & "' AND da_uOrdner2= '" & OLD_V.da_uOrdner2 & "' ", "FMZOLL") ElseIf OLD_V.da_uOrdner1 IsNot Nothing Then : dt = SQL.loadDgvBySql("select [da_id] from [tblDatenarchiv] where da_KundenNr = '" & OLD_V.da_KundenNr & "' AND da_kategorie ='" & OLD_V.da_kategorie & "' AND da_ordner='" & OLD_V.da_ordner & "' AND da_uOrdner1= '" & OLD_V.da_uOrdner1 & "' ", "FMZOLL") End If If dt IsNot Nothing Then For Each r As DataRow In dt.Rows Dim DS As New cDATENSERVER(r.Item("da_id")) DS.REMANE_FOLDER(OLD_V.da_kategorie, OLD_V.da_ordner, OLD_V.da_uOrdner1, OLD_V.da_uOrdner2, OLD_V.da_uOrdner3, OLD_V.da_KundenNr, NEW_V.da_kategorie, NEW_V.da_ordner, NEW_V.da_uOrdner1, NEW_V.da_uOrdner2, NEW_V.da_uOrdner3, NEW_V.da_KundenNr) Next End If Return True ' Else 'MsgBox("Der Ordner existiert nicht!") ' End If Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Return False End Function Shared Function initRootDirArchivArchiv() As String initRootDirArchivArchiv = getRootDirArchivArchiv() End Function Shared Function initRootDir() As String initRootDir = getRootDir() End Function Shared Function getRootDir(Optional TESTSYSTEM = Nothing) As String Dim TS = If(TESTSYSTEM IsNot Nothing, TESTSYSTEM, VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM) If VERAG_PROG_ALLGEMEIN.cAllgemein.FIRMA = "UNISPED" Then If TS Then ' getRootDir = "\\192.168.0.91\DATENARCHIV\DATENARCHIV_TESTSYSTEM\" getRootDir = "\\datenarchiv.verag.ost.dmn\DATENARCHIV\DATENARCHIV_TESTSYSTEM\" Else ' getRootDir = "\\192.168.0.91\DATENARCHIV\" getRootDir = "\\datenarchiv.verag.ost.dmn\DATENARCHIV\" End If Else If TS Then ' getRootDir = "\\192.168.0.91\DATENARCHIV\DATENARCHIV_TESTSYSTEM\" getRootDir = "\\datenarchiv.verag.ost.dmn\DATENARCHIV\DATENARCHIV_TESTSYSTEM\" Else ' getRootDir = "\\192.168.0.91\DATENARCHIV\" getRootDir = "\\datenarchiv.verag.ost.dmn\DATENARCHIV\" End If End If End Function Shared Function getRootDirArchivArchiv(Optional TESTSYSTEM = Nothing) As String Dim TS = If(TESTSYSTEM IsNot Nothing, TESTSYSTEM, VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM) If TS Then ' getRootDir = "\\192.168.0.91\DATENARCHIV\DATENARCHIV_TESTSYSTEM\" getRootDirArchivArchiv = "\\stor01.verag.ost.dmn\DATENARCHIVArchiv\DATENARCHIV_TESTSYSTEM\" Else ' getRootDir = "\\192.168.0.91\DATENARCHIV\" getRootDirArchivArchiv = "\\stor01.verag.ost.dmn\DATENARCHIVArchiv\" End If End Function Shared Function getDescPath(rootDir, kategorie, ordner, da_uOrdner1, da_uOrdner2, da_uOrdner3, kdnr, bezeichnung, endung, Optional onlyordner = False) As String Try If kdnr Is Nothing Then MsgBox("Keine Kundennummer angegeben!") : Return "" If ordner Is Nothing Then MsgBox("Kein Ordner angegeben!") : Return "" Dim dateiName = "" If Not onlyordner Then If bezeichnung Is Nothing Then MsgBox("Keine Bezeichnung angegeben!") : Return "" dateiName = Now.ToString("yyyyMMdd_HHmmss_") & bezeichnung End If Dim kdnr_path = "" If kdnr IsNot Nothing AndAlso IsNumeric(kdnr) AndAlso kdnr > 0 Then kdnr_path = kdnr End If If kategorie <> "" Then Dim dir = "" dir &= rootDir dir &= kategorie & "\" dir &= If(ordner IsNot Nothing AndAlso ordner <> "", ordner & "\", "") dir &= If(kdnr_path <> "", kdnr_path & "\", "") dir &= If(da_uOrdner1 IsNot Nothing AndAlso da_uOrdner1 <> "", da_uOrdner1 & "\", "") dir &= If(da_uOrdner2 IsNot Nothing AndAlso da_uOrdner2 <> "", da_uOrdner2 & "\", "") dir &= If(da_uOrdner3 IsNot Nothing AndAlso da_uOrdner3 <> "", da_uOrdner3 & "\", "") If Not onlyordner Then If Not System.IO.Directory.Exists(dir) Then System.IO.Directory.CreateDirectory(dir) End If Dim zusatz = "" : Dim zusatzcnt = 1 While System.IO.File.Exists(dir & dateiName & zusatz & If(bezeichnung.ToString.EndsWith(endung), "", endung)) zusatz = "_" & zusatzcnt zusatzcnt += 1 End While dir &= dateiName & zusatz & If(bezeichnung.ToString.EndsWith(endung), "", endung) End If Return dir Else If Not onlyordner Then If Not System.IO.Directory.Exists(rootDir & "DOKUMENTE\KEINE_ZUORDNUNG\" & kdnr_path & "\") Then System.IO.Directory.CreateDirectory(rootDir & "DOKUMENTE\KEINE_ZUORDNUNG\" & kdnr_path & "\") End If Return rootDir & "DOKUMENTE\KEINE_ZUORDNUNG\" & kdnr_path & "\" & dateiName End If Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, "Fehler in der Funktion '" & System.Reflection.MethodInfo.GetCurrentMethod.Name & "'" & vbNewLine & vbNewLine & ex.Message & vbNewLine & vbNewLine & ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) Return "" End Try End Function Shared Function OPEN_PATH(path As String) As Boolean Try If Not System.IO.File.Exists(path) Then MsgBox("Die Datei existiert nicht") : Return False Dim fi As New System.IO.DirectoryInfo(path) Dim destPath = DATENVERVER_OPTIONS.getTMPPath(fi.Name, fi.Extension, , False) System.IO.File.Copy(path, destPath, True) Process.Start(destPath) Return True Catch ex As Exception MsgBox(ex.Message & ex.StackTrace) Return False End Try End Function Public Shared Function getPDFViaSpirePDF_FromFile(File As String, Optional targetPath As String = "") As String Try If targetPath = "" Then targetPath = TMP_PATH 'If Not VERAG_PROG_ALLGEMEIN.cProgramFunctions.spireLoadLicense() Then MsgBox("Fehler beim Laden der SPIRE-Lizenz") Dim doc As New Spire.Pdf.PdfDocument '= New Spire.Pdf.PdfDocument(URL) doc.LoadFromHTML(File, False, False, False) 'doc.LoadFromFile(File) If doc IsNot Nothing Then doc.PageSettings.Size = Spire.Pdf.PdfPageSize.A4 ' doc.PrintDocument.DefaultPageSettings.Landscape = True ' doc.PageScaling = Spire.Pdf.PdfPrintPageScaling.FitSize doc.PageSettings.Orientation = Spire.Pdf.PdfPageOrientation.Landscape doc.PrintSettings.SelectSinglePageLayout(PdfSinglePageScalingMode.FitSize, True) ' doc.PrinterName = printerName ' doc.PrintDocument.Print() doc.SaveToFile(targetPath) End If Return targetPath Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Return "" End Function End Class Public Class barcodeToPdf Public image As Image = Nothing Public x As Integer Public y As Integer Public width As Integer Public height As Integer Public onpage = 1 Public rotate As Drawing.RotateFlipType = RotateFlipType.RotateNoneFlipNone Sub New(image As Image, x As Integer, y As Integer, width As Integer, height As Integer, onpage As Integer, rotate As Drawing.RotateFlipType) Me.image = image Me.x = x Me.y = y Me.width = width Me.height = height Me.onpage = onpage Me.rotate = rotate End Sub End Class