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 Dim reservedwords As Collection() #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 Function Get_Empfaenger() Load_Empfaenger() End Function Public Function Vorlagendaten_aufbreiten() As DataTable Return Datentabelle_Generieren() 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 Dim dt As New DataTable() Dim dn As DataRow Dim i As Integer 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() Dim dr As DataRow dv = Me.dsempfaenger.Tables(0).Select("Dokumentid='' or dokumentid<>''") For Each dr In dv dt.ImportRow(dr) Next ' dt = Me.dsempfaenger.Tables(0).Copy '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 = "N" + dc.ColumnName ' End Select ' If resword(dc.ColumnName) Then ' dc.ColumnName = dc.ColumnName + "_" ' End If 'Next Dim tmkopfzeile As Boolean = False Me.dsempfaenger.Tables("UsedFelder").AcceptChanges() Try 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 Catch ex As Exception Dim a a = 1 End Try 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") Dim s As String 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").ToString 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() 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() As DataTable Dim scmCmdToExecute As SqlCommand = New SqlCommand() 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.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, 0)) 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)) scmCmdToExecute.Parameters.Add(New SqlParameter("@preview", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1)) 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) 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 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() End Sub Private Sub Save_Data_To_Temptable(ByRef dt As DataTable) Dim tdt As New DataTable("EDKB09_" + Me.Serienbriefnr.ToString) Dim tdr As DataRow Dim i As Integer Dim ii As Integer 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 connection.Open() da.Update(tdt) connection.Close() End Sub Private Sub Load_Empfaenger() 'Dim dokumentname = Globals.Params.Pfad_Serienbrief_Daten + Me.Serienbriefnr.ToString + "_empfaenger.xml" '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 ' 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 'Finally ' Try ' File.Delete(dokumentname) ' Catch ' 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, z, e As Integer Dim xx As String 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