Option Strict On
Option Explicit On
Imports System.IO
Imports IntraSell_DLL

Module ModuleXML

    ''' <summary>
    ''' 
    ''' </summary>
    ''' <param name="sql"></param>
    ''' <param name="baseTagName"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function QueryToXML(sql As String, Optional baseTagName As String = "") As String
        Dim line As String = ""
        Dim FeldName, FeldWert As String
        Dim i As Integer
        Dim rsT = OpenRecordsetInMemory(sql)

        For Each rs As DataRow In rsT.Rows
            If baseTagName <> "" Then
                line = line & "<" & baseTagName & ">"
            End If

            For i = 1 To rsT.Columns.Count
                FeldName = Replace(rsT.Columns(i - 1).ColumnName, " ", "")
                FeldName = Replace(FeldName, "_", "")

                If InStr(FeldName, "<") <= 0 And InStr(FeldName, ">") <= 0 Then
                    If IsDBNull(rs(i - 1)) Then
                        FeldWert = "_"
                    Else
                        FeldWert = CType(rs(i - 1), String)
                    End If

                    If Trim(FeldWert) <> "" Then 'nur dann einfügen wenn daten vorhanden sind
                        'Start Tag
                        If Not IsNumeric(FeldName) Then
                            line = line & "<" & FeldName & ">"
                            If IsNumeric(FeldWert) And Not IsDate(FeldWert) _
                            And Not (InStr(FeldName, "Nr") > 0 Or _
                                     InStr(FeldName, "PLZ") > 0 Or _
                                     FeldName = "IDNR" Or _
                                     FeldName = "Nr" Or _
                                     FeldName = "ID" Or _
                                     FeldName = "Pos" Or _
                                     FeldName = "Position" Or _
                                     FeldName = "Nummer" Or _
                                     FeldName = "BHReferenz" Or _
                                     FeldName = "LandNr" Or _
                                     FeldName = "Land" Or _
                                     FeldName = "Tel" Or _
                                     FeldName = "Fax" Or _
                                     FeldName = "MitarbeiterId" Or _
                                     FeldName = "ArtikelIdentifikation" Or _
                                     FeldName = "VorgangNummer" Or _
                                     FeldName = "AnfrageNr") Then
                                'Als Sandard Zahl Formatieren, aber nur dann wenn keine Differenz entsteht

                                If CDbl(FeldWert) * 1 = 1 * CDbl(Format(CDbl(FeldWert), "Standard")) Then
                                    line &= Format(FeldWert, "Standard") '2 nachkommastellige Zahl
                                Else
                                    line &= encodeForXML(FeldWert) '3 nachkommastellen Zahl
                                End If

                            Else
                                If InStr(FeldName, "Preis") > 0 And IsNumeric(FeldWert) Then
                                    If CDbl(FeldWert) * 1 = 1 * CDbl(Format(CDbl(FeldWert), "Standard")) Then
                                        line &= Format(FeldWert, "Standard")
                                    Else
                                        line &= encodeForXML(FeldWert) '3 nachkommastellen Zahl
                                    End If
                                Else
                                    line &= encodeForXML(FeldWert)
                                End If
                            End If

                            'End Tag
                            line = line & "</" & FeldName & ">" & Chr(13) & Chr(10)
                        End If 'nicht numeric
                    End If

                End If
            Next
            If baseTagName <> "" Then
                line = line & "</" & baseTagName & ">"
            End If

        Next

        Return line
    End Function


    ''' <summary>
    ''' 
    ''' </summary>
    ''' <param name="txt"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function EncodeForXML(txt As String) As String
        If Left(txt, 1) = "_" Then 'führende "_" entfernen
            txt = Mid(txt, 2)
        End If
        txt = "<![CDATA[" & txt & "]]>"
        Return txt
    End Function


    ''' <summary>
    ''' makes XML file from query or table
    ''' </summary>
    ''' <param name="content"></param>
    ''' <param name="fileName"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function SaveXML(content As String, fileName As String) As Boolean
        Dim fileLine As String
        fileLine = "<?xml version=""1.0"" encoding=""utf-8""?>" & vbCrLf
        Dim fw As New StreamWriter(fileName, False)
        fileLine &= content
        fw.WriteLine(fileLine)
        fw.Close()
        Return True
    End Function

End Module
