Imports System.IO Imports System.Data.SqlClient Imports System.Data.SqlTypes Imports System.Reflection Public Class clsDivFnkt #Region "Deklarationen" Dim clsjournaleintrag As New edokaDB.clsJournaleintrag Public Enum Enum_InfoTyp Keine = 0 Information = 1 Warnung = 2 Fehler = 3 End Enum #End Region 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 = Globals.conn conn.OpenConnection() key = dbkey.get_dbkey("dokument") conn.CloseConnection(True) 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 '''EDKB12.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 Public Sub InsertJournale(ByVal Message As String, ByVal sTyp As Enum_InfoTyp) If sTyp <> Enum_InfoTyp.Keine Then End If clsjournaleintrag.iJournalnr = New SqlInt32(CType(-2, Int32)) clsjournaleintrag.daDatumzeit = New SqlDateTime(CType(Now, DateTime)) clsjournaleintrag.sEintrag = New SqlString(CType(Message, String)) clsjournaleintrag.cpMainConnectionProvider = Globals.connJournale Console.WriteLine(Message) Globals.connJournale.OpenConnection() clsjournaleintrag.Insert() Globals.connJournale.CloseConnection(True) If sTyp = Enum_InfoTyp.Fehler Then Send_Message(Message) End If End Sub Private Sub Send_Message(ByVal message As String) Dim betreff As String Dim meldung As String betreff = Param.FehlermeldungBetreff meldung = Param.FehlerMeldungMeldung meldung = meldung.Replace("#Message#", message) Dim scmCmdToExecute As SqlCommand = New SqlCommand() scmCmdToExecute.CommandText = "sp_edkb12_meldung" scmCmdToExecute.CommandType = CommandType.StoredProcedure Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) Try scmCmdToExecute.Connection = Globals.conn.scoDBConnection scmCmdToExecute.Parameters.Add(New SqlParameter("@status", SqlDbType.Int, 225, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, -1)) scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiter", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Param.MaNrFehlermeldung)) scmCmdToExecute.Parameters.Add(New SqlParameter("@betreff", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, betreff)) scmCmdToExecute.Parameters.Add(New SqlParameter("@meldung", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, meldung)) scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, "")) sdaAdapter.Fill(dtToReturn) Return Catch ex As Exception DivFnkt.InsertJournale("EDKB12::Fehler:: Send_Message::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Fehler) If Param.DebugMode Then DivFnkt.InsertJournale("EDKB12: Ende Send_Message (False)::" & ex.Message, clsDivFnkt.Enum_InfoTyp.Information) End If Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() End Try End Sub End Class