edv/SDL
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
1718ee4f67284fabc2dede5e481e531b07feed75
SDL/VERAG_PROG_ALLGEMEIN/DATENSERVER/cDATENSERVER.vb
d.breimaier 06a4256140 MDM
2024-09-20 12:23:41 +02:00

2297 lines
105 KiB
VB.net
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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 IO.Directory.Exists(newDIR) Then 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 IO.Directory.Exists(newDIR) Then 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 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("<EFBFBD>", "")
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 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 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 IO.File.Exists(srcPath) Then MsgBox("Die Datei existiert nicht") : Exit Function
' Dim fi As New IO.DirectoryInfo(srcPath)
' Dim destPath = DATENVERVER_OPTIONS.getTMPPath(fi.Name, fi.Extension)
' 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)
' 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 = DS.OPEN_SINGLE(False)
If path_src = "" Then Return ""
Dim fi As New 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 = DS.OPEN_SINGLE(False)
If path_src = "" Then Return list
Dim fi As New 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 = ""
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 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 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
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 IO.Directory.Exists(delPath.Substring(0, delPath.LastIndexOf("\"))) Then IO.Directory.CreateDirectory(delPath.Substring(0, delPath.LastIndexOf("\")))
If 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
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 IO.File.Exists(coll_pfad) Then MsgBox("Die Datei existiert nicht") : Return ""
Dim fi As New 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)
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 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
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 IO.Directory.Exists(TMP_PATH) Then 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 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 IO.FileInfo(pfad)
Dim tmpPath = VERAG_PROG_ALLGEMEIN.DATENVERVER_OPTIONS.getTMPPath(bezeichnung, fi.Extension,, False, "ClipBoard_TMP\ClipBoard_" & Now.ToString("ddMMyyyyHHmmss_sss") & "\")
Try
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 IO.FileInfo(pfad)
Dim tmpPath = VERAG_PROG_ALLGEMEIN.DATENVERVER_OPTIONS.getTMPPath(bezeichnung, fi.Extension,, False, "ClipBoard_TMP\ClipBoard_" & Now.ToString("ddMMyyyyHHmmss_sss") & "\")
Try
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 : 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 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 IO.Directory.GetFiles(TMP_PATH2) ' Ermittelt alle Dateien des Ordners und löscht diese (sind tmp)
Try : IO.File.Delete(file) : Catch : End Try
Next
For Each dir As String In IO.Directory.GetDirectories(TMP_PATH2) ' Ermittelt alle Dateien des Ordners und löscht diese (sind tmp)
Try : 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 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 IO.Directory.Exists(dir) Then
IO.Directory.CreateDirectory(dir)
End If
Dim zusatz = "" : Dim zusatzcnt = 1
While 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 IO.Directory.Exists(rootDir & "DOKUMENTE\KEINE_ZUORDNUNG\" & kdnr_path & "\") Then 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 IO.File.Exists(path) Then MsgBox("Die Datei existiert nicht") : Return False
Dim fi As New IO.DirectoryInfo(path)
Dim destPath = DATENVERVER_OPTIONS.getTMPPath(fi.Name, fi.Extension, , False)
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
Reference in New Issue View Git Blame Copy Permalink