Imports System.Data Imports System.Data.SqlTypes Imports System.Data.SqlClient Imports System.IO Public Class frmExportDataFremdanwendung Inherits System.Windows.Forms.Form 'Variable für Rekursiven VorlagenExport (Counter-Variable) Private intEbeneID As Integer = 0 Private arrVorlagenXML(10) As String #Region " Vom Windows Form Designer generierter Code " Public Sub New() MyBase.New() ' Dieser Aufruf ist für den Windows Form-Designer erforderlich. InitializeComponent() ' Initialisierungen nach dem Aufruf InitializeComponent() hinzufügen End Sub ' Die Form überschreibt den Löschvorgang der Basisklasse, um Komponenten zu bereinigen. Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean) If disposing Then If Not (components Is Nothing) Then components.Dispose() End If End If MyBase.Dispose(disposing) End Sub ' Für Windows Form-Designer erforderlich Private components As System.ComponentModel.IContainer 'HINWEIS: Die folgende Prozedur ist für den Windows Form-Designer erforderlich 'Sie kann mit dem Windows Form-Designer modifiziert werden. 'Verwenden Sie nicht den Code-Editor zur Bearbeitung. Friend WithEvents ImageList1 As System.Windows.Forms.ImageList Friend WithEvents ToolBar1 As System.Windows.Forms.ToolBar Friend WithEvents tbbEnde As System.Windows.Forms.ToolBarButton Friend WithEvents txtPfad As System.Windows.Forms.TextBox Friend WithEvents btnExport As System.Windows.Forms.Button Friend WithEvents cbxDocktypen As System.Windows.Forms.CheckBox Friend WithEvents cbxDokStruktur As System.Windows.Forms.CheckBox Friend WithEvents btnFolderOpen As System.Windows.Forms.Button Friend WithEvents cbxVorlage As System.Windows.Forms.CheckBox Friend WithEvents Label1 As System.Windows.Forms.Label Private Sub InitializeComponent() Me.components = New System.ComponentModel.Container Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(frmExportDataFremdanwendung)) Me.ImageList1 = New System.Windows.Forms.ImageList(Me.components) Me.ToolBar1 = New System.Windows.Forms.ToolBar Me.tbbEnde = New System.Windows.Forms.ToolBarButton Me.txtPfad = New System.Windows.Forms.TextBox Me.btnExport = New System.Windows.Forms.Button Me.cbxDocktypen = New System.Windows.Forms.CheckBox Me.cbxDokStruktur = New System.Windows.Forms.CheckBox Me.btnFolderOpen = New System.Windows.Forms.Button Me.Label1 = New System.Windows.Forms.Label Me.cbxVorlage = New System.Windows.Forms.CheckBox Me.SuspendLayout() ' 'ImageList1 ' Me.ImageList1.ImageStream = CType(resources.GetObject("ImageList1.ImageStream"), System.Windows.Forms.ImageListStreamer) Me.ImageList1.TransparentColor = System.Drawing.Color.Transparent Me.ImageList1.Images.SetKeyName(0, "") ' 'ToolBar1 ' Me.ToolBar1.Buttons.AddRange(New System.Windows.Forms.ToolBarButton() {Me.tbbEnde}) Me.ToolBar1.DropDownArrows = True Me.ToolBar1.ImageList = Me.ImageList1 Me.ToolBar1.Location = New System.Drawing.Point(0, 0) Me.ToolBar1.Name = "ToolBar1" Me.ToolBar1.ShowToolTips = True Me.ToolBar1.Size = New System.Drawing.Size(328, 28) Me.ToolBar1.TabIndex = 0 ' 'tbbEnde ' Me.tbbEnde.ImageIndex = 0 Me.tbbEnde.Name = "tbbEnde" Me.tbbEnde.ToolTipText = "Beenden" ' 'txtPfad ' Me.txtPfad.Location = New System.Drawing.Point(24, 144) Me.txtPfad.Name = "txtPfad" Me.txtPfad.Size = New System.Drawing.Size(248, 20) Me.txtPfad.TabIndex = 1 ' 'btnExport ' Me.btnExport.Location = New System.Drawing.Point(24, 184) Me.btnExport.Name = "btnExport" Me.btnExport.Size = New System.Drawing.Size(75, 23) Me.btnExport.TabIndex = 2 Me.btnExport.Text = "Export" ' 'cbxDocktypen ' Me.cbxDocktypen.Checked = True Me.cbxDocktypen.CheckState = System.Windows.Forms.CheckState.Checked Me.cbxDocktypen.Location = New System.Drawing.Point(24, 64) Me.cbxDocktypen.Name = "cbxDocktypen" Me.cbxDocktypen.Size = New System.Drawing.Size(128, 24) Me.cbxDocktypen.TabIndex = 3 Me.cbxDocktypen.Text = "Dokumenttypen" ' 'cbxDokStruktur ' Me.cbxDokStruktur.Checked = True Me.cbxDokStruktur.CheckState = System.Windows.Forms.CheckState.Checked Me.cbxDokStruktur.Location = New System.Drawing.Point(24, 88) Me.cbxDokStruktur.Name = "cbxDokStruktur" Me.cbxDokStruktur.Size = New System.Drawing.Size(136, 24) Me.cbxDokStruktur.TabIndex = 4 Me.cbxDokStruktur.Text = "Dokumentstruktur" ' 'btnFolderOpen ' Me.btnFolderOpen.Location = New System.Drawing.Point(272, 144) Me.btnFolderOpen.Name = "btnFolderOpen" Me.btnFolderOpen.Size = New System.Drawing.Size(20, 20) Me.btnFolderOpen.TabIndex = 5 Me.btnFolderOpen.Text = "..." ' 'Label1 ' Me.Label1.Location = New System.Drawing.Point(16, 40) Me.Label1.Name = "Label1" Me.Label1.Size = New System.Drawing.Size(100, 16) Me.Label1.TabIndex = 6 Me.Label1.Text = "Export-Typ" ' 'cbxVorlage ' Me.cbxVorlage.Checked = True Me.cbxVorlage.CheckState = System.Windows.Forms.CheckState.Checked Me.cbxVorlage.Location = New System.Drawing.Point(24, 114) Me.cbxVorlage.Name = "cbxVorlage" Me.cbxVorlage.Size = New System.Drawing.Size(136, 24) Me.cbxVorlage.TabIndex = 7 Me.cbxVorlage.Text = "Vorlagenexport" ' 'frmExportDataFremdanwendung ' Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13) Me.ClientSize = New System.Drawing.Size(328, 229) Me.Controls.Add(Me.cbxVorlage) Me.Controls.Add(Me.Label1) Me.Controls.Add(Me.btnFolderOpen) Me.Controls.Add(Me.cbxDokStruktur) Me.Controls.Add(Me.cbxDocktypen) Me.Controls.Add(Me.btnExport) Me.Controls.Add(Me.txtPfad) Me.Controls.Add(Me.ToolBar1) Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon) Me.Name = "frmExportDataFremdanwendung" Me.Text = "Datenexport Fremdanwendung" Me.ResumeLayout(False) Me.PerformLayout() End Sub #End Region #Region " Formular Controls" Private Sub ToolBar1_ButtonClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ToolBarButtonClickEventArgs) Handles ToolBar1.ButtonClick Me.Close() End Sub Private Sub btnFolderOpen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFolderOpen.Click Try 'öffnet den FolderSelect und speichert den Pfad im Textfeld ab. Dim f As New FolderSelect() f.InitialDirectory = "H:\" f.InitialDirectoryExpanded = True Me.Cursor = Cursors.WaitCursor f.ShowDialog() If f.DialogResult = DialogResult.OK Then txtPfad.Text = f.fullPath End If Me.Cursor = Cursors.Default f.Dispose() Catch ex As Exception MsgBox("frmExportDataFremdanwendung:btnFolderOpen_Click::" & ex.Message, MsgBoxStyle.Critical, Me.Text) End Try End Sub Private Sub btnExport_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExport.Click Try 'Prüfen ob Pfad angegeben If Len(txtPfad.Text) < 3 Then MsgBox("Bitte Pfad angeben!", MsgBoxStyle.Exclamation, Me.Text) Exit Sub End If 'Prüfen ob Export Typ angegeben If Not cbxDocktypen.Checked And Not cbxDokStruktur.Checked And Not cbxVorlage.Checked Then MsgBox("Mindestens ein Export-Typ muss ausgewählt werden!", MsgBoxStyle.Exclamation, Me.Text) Exit Sub End If 'Prüfen ob Pfad existiert If DivFnkt.FolderExist(txtPfad.Text) = False Then If MsgBox("Der angegebene Pfad existiert nicht, soll er erstellt werden?", MsgBoxStyle.OKCancel + MsgBoxStyle.Question, Me.Text) = MsgBoxResult.OK Then DivFnkt.Create_Folders(txtPfad.Text) If DivFnkt.FolderExist(txtPfad.Text) = False Then MsgBox("Der angegebene Pfad konnte nicht erstellt werden", MsgBoxStyle.Exclamation, Me.Text) Exit Sub End If Else Exit Sub End If End If ExportData() Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, Me.Text) End Try End Sub #End Region Private Sub ExportData() Dim fP As New frmProgress() Try Dim i As Integer = 0 For i = 0 To UBound(arrVorlagenXML) - 1 arrVorlagenXML(i) = "" Next fP.Info.Text = "Starten des Exports" fP.Bar1a.Visible = True fP.Bar1a.Maximum = 100 fP.Show() If cbxDocktypen.Checked Then fP.Info.Text = "Dokumenttyp Daten werden exportiert" fP.Bar1a.Value = 50 GenXMLDataTable(txtPfad.Text, 1, "Dokumenttyp.xml") System.Threading.Thread.Sleep(1000) End If If cbxDokStruktur.Checked Then fP.Info.Text = "Dokumentstruktur Daten werden exportiert" fP.Bar1a.Value = 100 GenXMLDataTable(txtPfad.Text, 2, "Dokumentstruktur.xml") System.Threading.Thread.Sleep(1500) End If 'Rel 4.0 Vorlagen-Export für Avaloq If cbxVorlage.Checked Then fP.Info.Text = "Vorlagenreferenzen exportieren" fP.Bar1a.Value = 0 System.Threading.Thread.Sleep(2500) GenVorlagenReferences(txtPfad.Text) fP.Info.Text = "Vorlagenstruktur erstellen" fP.Bar1a.Value = 30 System.Threading.Thread.Sleep(2500) GenVorlagenExport(intEbeneID, 0, 0) fP.Info.Text = "Vorlagenstruktur speichern" fP.Bar1a.Value = 80 System.Threading.Thread.Sleep(2500) GenVorlagenExportFileStuff(txtPfad.Text) End If fP.Info.Text = "Ende Daten Export" fP.Bar1a.Value = 100 System.Threading.Thread.Sleep(1500) Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, Me.Text) Finally fP.Dispose() End Try End Sub Private Sub GenVorlagenExportFileStuff(ByVal strPath As String) Dim i As Integer = 0 Dim fi As FileStream Dim sWrite As StreamWriter Try If Not Directory.Exists(strPath & "\temp") Then Directory.CreateDirectory(strPath & "\temp") End If Do While arrVorlagenXML(i) <> "" fi = New FileStream(strPath & "\temp\tgkb_edoka_dot_0" & i + 1 & "_" & Replace(DateTime.Now.ToShortDateString, ".", "") & ".xml", FileMode.Create, FileAccess.Write) sWrite = New StreamWriter(fi) arrVorlagenXML(i) = arrVorlagenXML(i).Replace("", "" & vbNewLine & "") arrVorlagenXML(i) = "" & vbNewLine & arrVorlagenXML(i) arrVorlagenXML(i) = arrVorlagenXML(i) & "" sWrite.Write(arrVorlagenXML(i)) sWrite.Close() fi.Close() i = i + 1 Loop Dim dir As New IO.DirectoryInfo(strPath & "\temp") Dim iCounter As Integer iCounter = 0 Dim files As IO.FileInfo() = dir.GetFiles() Dim file As IO.FileInfo Dim newFilename As String Dim intCounter As Integer = 1 Dim intCounter2 As Integer = i For Each file In files If file.Name Like "tgkb_edoka_dot_0?_" & Replace(DateTime.Now.ToShortDateString, ".", "") & ".xml" Then 'Filter: Nur soeben generierte Files nehmen newFilename = file.Name newFilename = Replace(file.Name, "dot_0" & intCounter, "dot_0" & intCounter2) intCounter = intCounter + 1 intCounter2 = intCounter2 - 1 file.CopyTo(strPath & "\" & newFilename) End If Next Catch ex As Exception Throw New Exception("frmExportDataFremdanwendung:GenVorlagenExportFileStuff::Error occured." & ex.Message, ex) End Try End Sub '************************************************************************************************************ '| Funktion um den Vorlagenkatalog zu exportieren | '| Parameter: | '| intEbene: Hirarchiestufe es Vorlagenbaums | '| intParentID: Parent-Element nach dem gesucht wird | '| Return: | '| Gibt die Sub-Items des Parents zurück (collections oder Files) | '| | '| Funktionalität: | '| Funktion wird mit "0,0" zum 1.mal aufgerufen (Root-Element) | '| Der Baum wird Rekursiv aufgebaut, d.h Die Funktion wird für jedes Sub-Element wieder aufgerufen. | '| Sub-Items können Collection oder Product (File) sein. | '| Der Rückgabewert der Funktion wird in einer Variable zusammengeführt und entspricht den Sub-Items. | '************************************************************************************************************ Private DP_ID As Integer = 0 Private Function GenVorlagenExport(ByVal intEbene As Integer, ByVal intParentID As Integer, ByVal intRootID As Integer) As String Dim sData As DataSet = New DataSet() Dim row As DataRow Dim scmCmdToExecute As SqlCommand = New SqlCommand() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) Dim subItem As String Dim boolDoIt As Boolean = True scmCmdToExecute.CommandText = "dbo.sp_VorlagenExport_GetEbeneByID" scmCmdToExecute.CommandType = CommandType.StoredProcedure scmCmdToExecute.Connection = conn.scoDBConnection If intParentID = 180 Then 'MsgBox("Hit") End If Try scmCmdToExecute.Parameters.Add(New SqlParameter("@parentID", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, intParentID)) sdaAdapter.Fill(sData) 'Loop over the Resultset For Each row In sData.Tables(0).Rows ' You can set a Parameter in the Table (VorlagenExport) on the 1. Hyrarchie ' Takes only these Nodes which have a 1 defined in the row If intEbene = 1 Then If row("VorlagenExport") Is System.DBNull.Value Then boolDoIt = False Else If row("bezeichnung") = "Dokumentpakete" Then DP_ID = row("dokumentartnr") Else DP_ID = 0 End If boolDoIt = True End If End If If DP_ID = 173 Then intRootID = 173 End If 'If DP_ID = intParentID Then ' DP_ID = row("dokumentartnr") 'ElseIf intParentID > 1 And DP_ID < intParentID Then 'DP_ID = 0 'End If If boolDoIt Then ' Create the XML-String arrVorlagenXML(intEbene) = arrVorlagenXML(intEbene) & "" & vbNewLine If DP_ID > 0 Then arrVorlagenXML(intEbene) = arrVorlagenXML(intEbene) & "" & CInt(row("dokumentartnr")) + 900000000 + 100000 & "" & vbNewLine Else arrVorlagenXML(intEbene) = arrVorlagenXML(intEbene) & "" & CInt(row("dokumentartnr")) + 900000000 + 10000 & "" & vbNewLine End If arrVorlagenXML(intEbene) = arrVorlagenXML(intEbene) & "" & row("bezeichnung") & "" & vbNewLine arrVorlagenXML(intEbene) = arrVorlagenXML(intEbene) & "" & vbNewLine arrVorlagenXML(intEbene) = arrVorlagenXML(intEbene) & "" & CInt(row("dokumentartnr")) & "" & vbNewLine arrVorlagenXML(intEbene) = arrVorlagenXML(intEbene) & "collection" & vbNewLine arrVorlagenXML(intEbene) = arrVorlagenXML(intEbene) & "" & vbNewLine arrVorlagenXML(intEbene) = arrVorlagenXML(intEbene) & "01.08.2025" & vbNewLine arrVorlagenXML(intEbene) = arrVorlagenXML(intEbene) & "" & vbNewLine subItem = subItem & "" & vbNewLine subItem = subItem & "collection" & vbNewLine If DP_ID > 0 Then subItem = subItem & "" & CInt(row("dokumentartnr")) + 900000000 + 100000 & "" & vbNewLine Else subItem = subItem & "" & CInt(row("dokumentartnr")) + 900000000 + 10000 & "" & vbNewLine End If subItem = subItem & "" 'Call the Function recursively arrVorlagenXML(intEbene) = arrVorlagenXML(intEbene) & GenVorlagenExport(intEbene + 1, row("dokumentartnr"), intRootID) & vbNewLine arrVorlagenXML(intEbene) = arrVorlagenXML(intEbene) & "" & vbNewLine arrVorlagenXML(intEbene) = arrVorlagenXML(intEbene) & "" & vbNewLine End If Next '-------------------- ' Check for Files | '-------------------- Dim sData2 As DataSet = New DataSet() Dim row2 As DataRow Dim scmCmdToExecute2 As SqlCommand = New SqlCommand() Dim sdaAdapter2 As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute2) If DP_ID > 0 Then scmCmdToExecute2.CommandText = "dbo.sp_VorlagenExport_GetDokumentPaketeByEbeneID" Else scmCmdToExecute2.CommandText = "dbo.sp_VorlagenExport_GetDokumenteByEbeneID" End If scmCmdToExecute2.CommandType = CommandType.StoredProcedure scmCmdToExecute2.Connection = conn.scoDBConnection scmCmdToExecute2.Parameters.Add(New SqlParameter("@ID", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, intParentID)) sdaAdapter2.Fill(sData2) For Each row2 In sData2.Tables(0).Rows subItem = subItem & "product" & vbNewLine If DP_ID > 0 Then subItem = subItem & "" & CInt(row2("dokumentpaketnr")) + 900000000 + 100000 & "" & vbNewLine Else subItem = subItem & "" & CInt(row2("dokumenttypnr")) + 900000000 & "" & vbNewLine End If Next Catch ex As Exception Throw New Exception("frmExportDataFremdanwendung:GenVorlagenExport::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex) End Try Return subItem End Function '************************************************************************************************ '| Methode um die Vorlagen-Referenzen zu exportieren | '| | '| Parameter: strPath = Exportpfad der XML-Datei | '| | '| Funktionalität: | '| Es wird nach alles Dokumenttypen gesucht welche aktiv sind. | '| Das Ergebnis wird nach der Vorgegebenen Namenskonvention auf dem angegebenen Pfad abgelegt. | '************************************************************************************************ Private Sub GenVorlagenReferences(ByVal strPath As String) Dim sData As DataSet = New DataSet() Dim row As DataRow Dim scmCmdToExecute As SqlCommand = New SqlCommand() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) Dim sData2 As DataSet = New DataSet() Dim row2 As DataRow Dim scmCmdToExecute2 As SqlCommand = New SqlCommand() Dim sdaAdapter2 As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute2) Dim strXML As String scmCmdToExecute.CommandText = "dbo.sp_VorlagenExport_GetDokReference" scmCmdToExecute.CommandType = CommandType.StoredProcedure scmCmdToExecute.Connection = conn.scoDBConnection Try sdaAdapter.Fill(sData) strXML = strXML & "" & vbNewLine For Each row In sData.Tables(0).Rows strXML = strXML & "" & vbNewLine strXML = strXML & " " & CInt(row("dokumenttypnr")) + 900000000 & "" & vbNewLine strXML = strXML & " " & row("bezeichnung") & "" & vbNewLine strXML = strXML & " " & row("beschreibung") & "" & vbNewLine strXML = strXML & " " & CInt(row("dokumenttypnr")) & "" & vbNewLine strXML = strXML & " " & row("bezeichnung") & "" & vbNewLine strXML = strXML & " 01.08.2008" & vbNewLine strXML = strXML & " 01.08.2025" & vbNewLine strXML = strXML & " 01.08.2025" & vbNewLine strXML = strXML & "" & vbNewLine Next 'Get Dokumentpakete ID + 100000 weil könnte gleich sein wie Dokumenttypnr scmCmdToExecute2.CommandText = "dbo.sp_VorlagenExport_GetDokPaketeReference" scmCmdToExecute2.CommandType = CommandType.StoredProcedure scmCmdToExecute2.Connection = conn.scoDBConnection sdaAdapter2.Fill(sData2) For Each row2 In sData2.Tables(0).Rows strXML = strXML & "" & vbNewLine strXML = strXML & " " & CInt(row2("dokumentpaketnr")) + 900000000 + 100000 & "" & vbNewLine strXML = strXML & " " & row2("bezeichnung") & "" & vbNewLine strXML = strXML & " " & row2("beschreibung") & "" & vbNewLine strXML = strXML & " " & CInt(row2("dokumentpaketnr")) & "" & vbNewLine strXML = strXML & " " & row2("bezeichnung") & "" & vbNewLine strXML = strXML & " 01.08.2008" & vbNewLine strXML = strXML & " 01.08.2025" & vbNewLine strXML = strXML & " 01.08.2025" & vbNewLine strXML = strXML & "" & vbNewLine Next strXML = strXML & "" & vbNewLine Dim fi As New FileStream(strPath & "\tgkb_edoka_dot_00_" & Replace(DateTime.Now.ToShortDateString, ".", "") & ".xml", FileMode.Create, FileAccess.Write) Dim sWrite As New StreamWriter(fi) sWrite.Write(strXML) sWrite.Close() fi.Close() Catch ex As Exception Throw New Exception("frmExportDataFremdanwendung:GenVorlagenReferences::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex) End Try End Sub Private Function GenXMLDataTable(ByVal Exportpfad As String, ByVal typ As Integer, ByVal sFileName As String) As Boolean Dim sTempDataSet As DataSet = New DataSet() Dim scmCmdToExecute As SqlCommand = New SqlCommand() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) GenXMLDataTable = True scmCmdToExecute.CommandText = "dbo.sp_Export_Data" scmCmdToExecute.CommandType = CommandType.StoredProcedure scmCmdToExecute.Connection = conn.scoDBConnection Try scmCmdToExecute.Parameters.Add(New SqlParameter("@typ", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, typ)) sdaAdapter.Fill(sTempDataSet) sTempDataSet.WriteXml(Exportpfad & "\" & sFileName, XmlWriteMode.WriteSchema) Catch ex As Exception GenXMLDataTable = False Throw New Exception("frmExportDataFremdanwendung:GenXMLDataTable::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex) Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() End Try End Function End Class