Imports System.IO Imports System.Data.SqlClient Imports System.Data.SqlTypes Imports System.Reflection '''Diverse allgemeine Funktionen '''Diesee Klasse kapselt diverse, allgemeine Funktionen, welche aus '''diversen anderen Klassen genutzt werden.$EOL$ '''Die Instanzierung der Klasse erfolgt über das Module Globals.vb '''Globals.DivFnkt Public Class clsDivFnkt '''Generieren der EDOKA-DokumentID '''Diese Methode generiert eine neue eindeutige, 22-stellige '''EDOKA-Dokumentid. $EOL$ '''Die Letzte ziffer ist eine Prüfziffer '''DokumentID für EDOKA '''Prüfziffer-Berechnung Public Function Generate_Key() As String Dim dbkey As New edokadb.clsMyKey_Tabelle() Dim key As Long Dim skey As String Dim s As String dbkey.cpMainConnectionProvider = conn_edoka conn_edoka.OpenConnection() key = dbkey.get_dbkey("dokument") conn_edoka.CloseConnection(False) skey = "OFFEDK000" s = Str(Year(Now)) While Microsoft.VisualBasic.Left(s, 1) = " " s = Microsoft.VisualBasic.Right(s, Len(s) - 1) End While skey = skey + s s = Str(key) While Microsoft.VisualBasic.Left(s, 1) = " " s = Microsoft.VisualBasic.Right(s, Len(s) - 1) End While While Len(s) < 8 s = "0" + s End While skey = skey + s s = Pruefziffer(Microsoft.VisualBasic.Right(skey, 15)) While Microsoft.VisualBasic.Left(s, 1) = " " s = Microsoft.VisualBasic.Right(s, Len(s) - 1) End While skey = skey + s Generate_Key = skey End Function '''Berechnung der Prüfziffer nach Modulo9/Rekursiv '''Dokumentid ohne Präfix '''DokumentID ohne Präfix (OFFEDK) inkl. Prüfziffer '''EDKB08.clsDivFnkt Public Function Pruefziffer(ByVal zahl As String) As String Dim ptab(9, 9) As Integer Dim pz(9) As Integer Dim s1, s2, s3 As String Dim i1, i2 As Long s1 = "0,9,4,6,8,2,7,1,3,5" s2 = s1 For i1 = 0 To 9 For i2 = 0 To 9 ptab(i1, i2) = Mid(s2, (i2 * 2) + 1, 1) Next s3 = Microsoft.VisualBasic.Left(s1, 1) s1 = Microsoft.VisualBasic.Right(s1, Len(s1) - 2) s1 = s1 + "," + s3 s2 = s1 Next pz(0) = 0 pz(1) = 9 pz(2) = 8 pz(3) = 7 pz(4) = 6 pz(5) = 5 pz(6) = 4 pz(7) = 3 pz(8) = 2 pz(9) = 1 Dim i, x, y As Integer y = 0 For i = 1 To Len(zahl) x = Val(Mid(zahl, i, 1)) y = ptab(x, y) Next Pruefziffer = Str(pz(y)) End Function '''Dokumen in der EDOKA-Datenbank speichern '''Die Funktion speichert ein Dokument des Filesystems in die '''EDOKA-Datenbank Tabelle DOKS '''DEDOKA-Dokumentid '''Origianl-Dokumentname (Fullpath) '''True=Speichern erfolgreich, False=Speichern fehlgeschalgen Public Function Save_To_DB(ByVal sDokumentID As String, ByVal sDokumentName As String, ByVal barcodekleberdokument As Boolean) As Boolean Dim sqlstatement As String = "Select * from doks where dokumentid='" + sDokumentID + "'" If barcodekleberdokument = True Then Dim s As String s = sDokumentID s = s.Replace("OFFEDK", "EDKIMP") sqlstatement = "Select * from doks where dokumentid='" + s + "'" End If Try Dim Connection As New SqlConnection() ' Dim DA As New SqlDataAdapter("select * from doks where dokumentid='" + sDokumentID + "'", Connection) Dim DA As New SqlDataAdapter(sqlstatement, Connection) Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA) Dim ds As New DataSet() Dim fs As New FileStream(sDokumentName, FileMode.Open, FileAccess.Read) Dim mydata(fs.Length) As Byte Try fs.Read(mydata, 0, fs.Length) fs.Close() Connection.ConnectionString = Globals.sConnectionString_edoka Connection.Open() DA.Fill(ds, "docs") Dim myRow As DataRow If ds.Tables(0).Rows.Count = 0 Then ' Neues Dokument speichern myRow = ds.Tables(0).NewRow myRow.Item(0) = sDokumentID myRow.Item(1) = mydata ds.Tables(0).Rows.Add(myRow) DA.Update(ds, "docs") Else 'Bestehendes Dokument sichenr myRow = ds.Tables(0).Rows(0) myRow.Item(1) = mydata DA.Update(ds, "docs") End If If Params.DeleteOriginalfiles = 1 Then Try File.SetAttributes(sDokumentName, FileAttributes.Normal) Catch End Try Try File.Delete(sDokumentName) Catch ex As Exception PrintOut("clsDivFnkt.Save_To_DB().2" + ex.Message, EventLogEntryType.Error) End Try End If Catch ex As Exception PrintOut("clsDivFnkt.Save_To_DB().0" + ex.Message, EventLogEntryType.Error) Return False End Try fs = Nothing cb = Nothing ds = Nothing DA = Nothing Connection.Close() Connection = Nothing Return True Catch EX As Exception PrintOut("clsDivFnkt.Save_To_DB().1" + ex.Message, EventLogEntryType.Error) Return False End Try End Function Public Function Save_Indexdata(ByVal jobid As Integer, ByVal datei As String) As Boolean Dim sqlstatement As String = "Select * from import_job where import_jobnr = " + LTrim(Str(jobid)) Dim Connection As New SqlConnection() Dim DA As New SqlDataAdapter("Select * from import_job where import_jobnr = " + LTrim(Str(jobid)), Connection) Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA) Dim ds As New DataSet() Dim fs As New FileStream(datei, FileMode.Open, FileAccess.Read) Dim mydata(fs.Length) As Byte Try fs.Read(mydata, 0, fs.Length) fs.Close() Connection.ConnectionString = Globals.sConnectionString_journale Connection.Open() DA.Fill(ds, "docs") Dim myRow As DataRow 'Bestehendes Dokument sichenr myRow = ds.Tables(0).Rows(0) myRow.Item(7) = mydata DA.Update(ds, "docs") Catch ex As Exception PrintOut("clsDivFnkt.Save_Indexdata()" + ex.Message, EventLogEntryType.Error) Return False Finally fs = Nothing cb = Nothing ds = Nothing DA = Nothing Connection.Close() Connection = Nothing End Try End Function Public Function ApplicationPath() As String 'Return Path.GetDirectoryName([Assembly].GetExecutingAssembly().Location) Return Path.GetDirectoryName([Assembly].GetEntryAssembly().Location) + "\" End Function End Class