Imports System.Data Imports System.Data.SqlClient Imports System.Data.SqlTypes Imports System.IO Public Class clsEmpfaengerdata #Region "Deklarationen" Dim dsempfaenger As DataSet Dim Serienbriefnr As Integer #End Region #Region "öffentliche Methoden" Public Sub New(ByRef DsEmpfaenger As DataSet, ByVal Serienbriefnr As Integer) Me.dsempfaenger = DsEmpfaenger Me.Serienbriefnr = Serienbriefnr End Sub Public Sub Get_Empfaenger() Load_Empfaenger() End Sub Public Function Vorlagendaten_aufbreiten() As DataTable Return Datentabelle_Generieren() End Function Public Sub save() save_empfaenger() End Sub Private Function save_empfaenger() As Boolean Try Dim dokumentname As String = Globals.Params.Pfad_Serienbrief_Daten + Me.Serienbriefnr.ToString + "_empfaenger.xml" Me.dsempfaenger.WriteXml(dokumentname) Dim Connection As New SqlConnection() Dim DA As New SqlDataAdapter("select * from edex_sb_empfaenger where serienbriefnr=" + Str(Me.Serienbriefnr), Connection) Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA) Dim ds As New DataSet() Dim fs As New FileStream(dokumentname, 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, "empf") Dim myRow As DataRow If ds.Tables(0).Rows.Count = 0 Then 'Neue Serienbrief_Empfaenger speichern myRow = ds.Tables(0).NewRow myRow.Item(1) = Me.Serienbriefnr myRow.Item(2) = mydata ds.Tables(0).Rows.Add(myRow) DA.Update(ds, "empf") Else ' Bestehende Empfängerliste überschreiben myRow = ds.Tables(0).Rows(0) myRow.Item(2) = mydata DA.Update(ds, "empf") End If Catch ex As Exception Return False End Try fs = Nothing cb = Nothing ds = Nothing DA = Nothing Connection.Close() Connection = Nothing Return True Catch EX As Exception Return False End Try End Function Private Function hascoltodelete(ByRef edata As DataTable, ByVal Prefix As String) As Boolean Dim i As Integer Dim s As String = "" For i = 0 To edata.Columns.Count - 1 If Left(edata.Columns(i).ColumnName, 2) = Prefix Then s = edata.Columns(i).ColumnName Exit For End If Next If s <> "" Then edata.Columns.Remove(s) Return True End If Return False End Function #End Region #Region "Datentabelle" Private Function Datentabelle_Generieren() As DataTable Try Dim dt As New DataTable() Dim dn As DataRow Dim i As Integer Dim s As String Dim aPrimaryKey(0) As DataColumn Dim oDatacolumn As DataColumn Me.dsempfaenger.Tables(0).Columns.Add("IntEintragnr") For i = 0 To Me.dsempfaenger.Tables(0).Rows.Count - 1 Me.dsempfaenger.Tables(0).Rows(i).Item("IntEintragNr") = i Next oDatacolumn = Me.dsempfaenger.Tables(0).Columns("IntEintragnr") aPrimaryKey(0) = oDatacolumn Me.dsempfaenger.Tables(0).PrimaryKey = aPrimaryKey dt.TableName = "EDKB09_" + Me.Serienbriefnr.ToString For i = 0 To Me.dsempfaenger.Tables(0).Columns.Count - 1 dt.Columns.Add(Me.dsempfaenger.Tables(0).Columns(i).ColumnName) Next Dim dv As DataRow() i = 0 Dim dav As New DataView(Me.dsempfaenger.Tables(0), "Status='1'", "Partnernr, Name, Vorname", DataViewRowState.CurrentRows) Dim darv As DataRowView dv = Me.dsempfaenger.Tables(0).Select("Status='1'") For Each darv In dav dt.ImportRow(darv.Row) i = i + 1 If i > Params.Anzahl_Dokumente_Auftrag Then Exit For Next 'Dim dc As DataColumn 'For Each dc In dt.Columns ' dc.ColumnName = dc.ColumnName.Replace(" ", "_") ' dc.ColumnName = dc.ColumnName.Replace(" ", "_") ' dc.ColumnName = dc.ColumnName.Replace("ö", "oe") ' dc.ColumnName = dc.ColumnName.Replace("Ö", "OE") ' dc.ColumnName = dc.ColumnName.Replace("ü", "ue") ' dc.ColumnName = dc.ColumnName.Replace("Ü", "UE") ' dc.ColumnName = dc.ColumnName.Replace("ä", "ae") ' dc.ColumnName = dc.ColumnName.Replace("Ä", "AE") ' dc.ColumnName = dc.ColumnName.Replace("-", "_") ' dc.ColumnName = dc.ColumnName.Replace("/", "_") ' dc.ColumnName = dc.ColumnName.Replace("\", "_") ' dc.ColumnName = dc.ColumnName.Replace(".", "_") ' dc.ColumnName = dc.ColumnName.Replace(":", "_") ' dc.ColumnName = dc.ColumnName.Replace(",", "_") ' Select Case Left(dc.ColumnName, 1) ' Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "0" ' dc.ColumnName = "_" + dc.ColumnName ' End Select ' If resword(dc.ColumnName) Then ' dc.ColumnName = dc.ColumnName + "_" ' End If 'Next ' dt = Me.dsempfaenger.Tables(0).Copy Dim tmkopfzeile As Boolean = False For i = 0 To Me.dsempfaenger.Tables("UsedFelder").Rows.Count - 1 If Me.dsempfaenger.Tables("UsedFelder").Rows(i).Item("Nr") = 33 Then tmkopfzeile = True End If Next If tmkopfzeile = False Then dn = Me.dsempfaenger.Tables("UsedFelder").NewRow dn.Item(0) = 33 dn.Item(1) = "TGEDKCompanyBBEB99" dn.Item(2) = "" dn.Item(3) = "TGEDKCompanyBBEB99" dn.Item(4) = "" Me.dsempfaenger.Tables("UsedFelder").Rows.Add(dn) End If Me.dsempfaenger.Tables("UsedFelder").Columns.Add("TempFeldname") Me.dsempfaenger.Tables("UsedFelder").Columns.Add("Fnkt") For i = 0 To Me.dsempfaenger.Tables("UsedFelder").Rows.Count - 1 If Me.dsempfaenger.Tables("UsedFelder").Rows(i).Item("Nr") <> 0 Then s = "F_09_" + Me.dsempfaenger.Tables("UsedFelder").Rows(i).Item("Nr") Me.dsempfaenger.Tables("UsedFelder").Rows(i).Item("fnkt") = s s = Insert_DT_Column(dt, s) Me.dsempfaenger.Tables("UsedFelder").Rows(i).Item("Tempfeldname") = s Else s = "I_09_" + Me.dsempfaenger.Tables("UsedFelder").Rows(i).Item("Beginntextmarke") Me.dsempfaenger.Tables("UsedFelder").Rows(i).Item("fnkt") = s s = Insert_DT_Column(dt, s) Me.dsempfaenger.Tables("UsedFelder").Rows(i).Item("Tempfeldname") = s End If Next Create_SQL_Server_Table(dt) Save_Data_To_Temptable(dt) Return Fill_And_Get_Data(dt.Rows.Count) Catch ex As Exception Throw New Exception("Serienbrief: " + Me.Serienbriefnr.ToString + ": Generierung der Datentabelle ist fehlgeschlagen:" + ex.Message) End Try End Function 'GAGA Private Function Insert_DT_Column(ByRef dt As DataTable, ByVal colname As String) As String Dim i As Integer = 0 Dim dc As DataColumn For Each dc In dt.Columns If UCase(Microsoft.VisualBasic.Left(dc.ColumnName, Len(colname))) = UCase(colname) Then i = i + 1 End If Next If i > 0 Then colname = colname + "_" + i.ToString dt.Columns.Add(colname) Return colname End Function #End Region #Region "Datenzugriffe" Dim Dokid As Integer Private Function Fill_And_Get_Data(ByVal rowcount As Integer) As DataTable Dim scmCmdToExecute As SqlCommand = New SqlCommand() scmCmdToExecute.CommandTimeout = Params.TimeOutKleinAuftraege Dim i As Integer Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) scmCmdToExecute.CommandText = "dbo.sp_edex_sb_fill_sbdata" scmCmdToExecute.CommandType = CommandType.StoredProcedure scmCmdToExecute.Connection = Globals.conn_edoka.scoDBConnection Try scmCmdToExecute.Parameters.Add(New SqlParameter("@serienbriefnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Me.Serienbriefnr)) scmCmdToExecute.Parameters.Add(New SqlParameter("@ROWCOUNT", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, rowcount)) scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0)) scmCmdToExecute.Parameters.Add(New SqlParameter("@bedr", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0)) sdaAdapter.Fill(dtToReturn) Dokid = scmCmdToExecute.Parameters("@dokumentid").Value For i = 0 To dtToReturn.Rows.Count - 1 dtToReturn.Rows(i).Item("Dokumentid") = Generate_Key(Dokid) Dokid = Dokid + 1 If scmCmdToExecute.Parameters("@bedr").Value = 1 Then dtToReturn.Rows(i).Item("dokumentidbdr") = Generate_Key(Dokid) Dokid = Dokid + 1 End If Next Return dtToReturn Catch ex As Exception Throw New Exception("sp_check_dokumentreaktivierung::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex) Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() End Try End Function Private Sub Create_SQL_Server_Table(ByRef dt As DataTable) Try Dim s As String Dim s1 As String Dim i As Integer 'dt.Columns.Add("NRPAR00") 'dt.Columns.Add("IntEintragNr") s1 = "Drop Table dbo.EDKB09_" + Me.Serienbriefnr.ToString 's = "Create Table EDKB09_" + Me.Serienbriefnr.ToString + "( NRPAR00 int, intEintragNr int," s = "Create Table dbo.EDKB09_" + Me.Serienbriefnr.ToString + "( NRPAR00 varchar(11)," For i = 1 To dt.Columns.Count - 1 s = s + "[" + dt.Columns(i).ColumnName + "]" + " varchar(255)," Next s = Left(s, Len(s) - 1) s = s + ")" Dim conn As New SqlConnection() conn.ConnectionString = Globals.sConnectionString_edoka conn.Open() Dim sqlcmd0 As New SqlCommand(s1, conn) Try sqlcmd0.ExecuteNonQuery() Catch End Try Dim sqlcmd As New SqlCommand(s, conn) sqlcmd.ExecuteNonQuery() conn.Close() Catch ex As Exception Throw New Exception("Serienbrief: " + Me.Serienbriefnr.ToString + ": Temp. Tabelle konnte nicht erstellt werden:" + ex.Message) End Try End Sub Private Sub Save_Data_To_Temptable(ByRef dt As DataTable) Dim tdt As New DataTable("EDKB09_" + Me.Serienbriefnr.ToString) tdt = dt.Copy tdt.Columns(0).ColumnName = "NRPAR00" Dim connection As New SqlConnection() Dim da As New SqlDataAdapter("Select * from EDKB09_" + Me.Serienbriefnr.ToString, connection) Dim cb As New SqlCommandBuilder(da) connection.ConnectionString = Globals.sConnectionString_edoka connection.Open() da.Update(tdt) connection.Close() End Sub Private Sub Load_Empfaenger() Dim dokumentname As String = Globals.Params.Pfad_Serienbrief_Daten + Me.Serienbriefnr.ToString + "_empfaenger.xml" If File.Exists(dokumentname) Then Try File.Delete(dokumentname) Catch ex As Exception Globals.BMS_Log(Globals.BMS_Fnkt.BMSMessage, "EDKB09: EDKB09: Load_Empfaenger :" + Serienbriefnr.ToString + ex.Message, Globals.Enum_BMS_Typen.Information) End Try End If Try Me.dsempfaenger.Tables.Clear() Dim Connection As New SqlConnection() Dim DA As New SqlDataAdapter("select * from edex_sb_empfaenger where serienbriefnr=" + Str(Me.Serienbriefnr), Connection) Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA) Dim ds As New DataSet() Try Connection.ConnectionString = Globals.sConnectionString_edoka Connection.Open() DA.Fill(ds, "empf") Dim myRow As DataRow If ds.Tables(0).Rows.Count = 0 Then MsgBox("Empfänger konnten nicht geladen werden.") Else myRow = ds.Tables(0).Rows(0) Dim MyData() As Byte MyData = myRow.Item(2) Dim K As Long K = UBound(MyData) Dim fs As New FileStream(dokumentname, FileMode.OpenOrCreate, FileAccess.Write) fs.Write(MyData, 0, K) fs.Close() fs = Nothing Me.dsempfaenger.ReadXml(dokumentname) End If Catch ex As Exception End Try cb = Nothing ds = Nothing DA = Nothing Connection.Close() Connection = Nothing Catch EX As Exception Throw New Exception("Serienbrief: " + Me.Serienbriefnr.ToString + ": Empfängerdaten konnten nicht aus der DB gelesen werden:" + ex.Message) Finally Try File.Delete(dokumentname) Catch ex As Exception End Try End Try End Sub Public Function Generate_Key(ByVal key As Long) As String Dim skey As String Dim s As String 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 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 #End Region End Class