' XRechnung 3.0 (CII, UN/CEFACT D16B) aus einem bestehenden VB-Programm erzeugen.
' Ein Modul, keine Fremdbibliothek: nur System.Xml.
' Aufruf: Dim xml As String = XRechnungCII.Erzeuge(rechnung) -> als .xml speichern / versenden.
' Für ZUGFeRD (PDF + eingebettete XML) wird dieselbe XML als factur-x.xml in eine PDF/A-3 gehängt.

Imports System.Globalization
Imports System.IO
Imports System.Text
Imports System.Xml

Public Class Partei
    Public Property Name As String
    Public Property Strasse As String
    Public Property Plz As String
    Public Property Ort As String
    Public Property Land As String = "DE"
    Public Property Email As String
    Public Property UStId As String          ' z. B. DE123456789 (Verkäufer: UStId oder Steuernummer)
    Public Property Steuernummer As String
    Public Property Kontaktname As String
    Public Property Telefon As String
End Class

Public Class Position
    Public Property Bezeichnung As String
    Public Property Menge As Decimal
    Public Property Einheit As String = "C62" ' C62 = Stück, HUR = Stunde, DAY = Tag
    Public Property Einzelpreis As Decimal    ' netto
    Public Property UStSatz As Decimal = 19D
    Public ReadOnly Property Netto As Decimal
        Get
            Return Math.Round(Menge * Einzelpreis, 2, MidpointRounding.AwayFromZero)
        End Get
    End Property
End Class

Public Class Rechnung
    Public Property Nummer As String
    Public Property Datum As Date
    Public Property Leistungsdatum As Date
    Public Property Faellig As Date
    Public Property Kaeuferreferenz As String  ' BT-10: Leitweg-ID bei Behörden, sonst z. B. Bestellnummer
    Public Property Verkaeufer As New Partei
    Public Property Kaeufer As New Partei
    Public Property Iban As String
    Public Property Zahlungsbedingung As String
    Public Property Positionen As New List(Of Position)
End Class

Public Module XRechnungCII
    Private Const RSM As String = "urn:un:unece:uncefact:data:standard:CrossIndustryInvoice:100"
    Private Const RAM As String = "urn:un:unece:uncefact:data:standard:ReusableAggregateBusinessInformationEntity:100"
    Private Const UDT As String = "urn:un:unece:uncefact:data:standard:UnqualifiedDataType:100"
    Private ReadOnly Inv As CultureInfo = CultureInfo.InvariantCulture

    Private Function Betrag(d As Decimal) As String
        Return d.ToString("0.00", Inv)
    End Function

    Public Function Erzeuge(r As Rechnung) As String
        Dim sb As New StringBuilder()
        Dim einst As New XmlWriterSettings With {.Indent = True, .Encoding = New UTF8Encoding(False)}
        Using sw As New Utf8Writer(sb), w As XmlWriter = XmlWriter.Create(sw, einst)
            w.WriteStartDocument()
            w.WriteStartElement("rsm", "CrossIndustryInvoice", RSM)
            w.WriteAttributeString("xmlns", "ram", Nothing, RAM)
            w.WriteAttributeString("xmlns", "udt", Nothing, UDT)

            ' Kontext: XRechnung 3.0
            w.WriteStartElement("rsm", "ExchangedDocumentContext", RSM)
            w.WriteStartElement("ram", "BusinessProcessSpecifiedDocumentContextParameter", RAM)
            w.WriteElementString("ram", "ID", RAM, "urn:fdc:peppol.eu:2017:poacc:billing:01:1.0")
            w.WriteEndElement()
            w.WriteStartElement("ram", "GuidelineSpecifiedDocumentContextParameter", RAM)
            w.WriteElementString("ram", "ID", RAM, "urn:cen.eu:en16931:2017#compliant#urn:xeinkauf.de:kosit:xrechnung_3.0")
            w.WriteEndElement()
            w.WriteEndElement()

            ' Kopf
            w.WriteStartElement("rsm", "ExchangedDocument", RSM)
            w.WriteElementString("ram", "ID", RAM, r.Nummer)
            w.WriteElementString("ram", "TypeCode", RAM, "380")
            Datum(w, "IssueDateTime", r.Datum)
            w.WriteEndElement()

            w.WriteStartElement("rsm", "SupplyChainTradeTransaction", RSM)

            ' Positionen
            Dim nr As Integer = 0
            For Each p In r.Positionen
                nr += 1
                w.WriteStartElement("ram", "IncludedSupplyChainTradeLineItem", RAM)
                w.WriteStartElement("ram", "AssociatedDocumentLineDocument", RAM)
                w.WriteElementString("ram", "LineID", RAM, nr.ToString(Inv))
                w.WriteEndElement()
                w.WriteStartElement("ram", "SpecifiedTradeProduct", RAM)
                w.WriteElementString("ram", "Name", RAM, p.Bezeichnung)
                w.WriteEndElement()
                w.WriteStartElement("ram", "SpecifiedLineTradeAgreement", RAM)
                w.WriteStartElement("ram", "NetPriceProductTradePrice", RAM)
                w.WriteElementString("ram", "ChargeAmount", RAM, Betrag(p.Einzelpreis))
                w.WriteEndElement()
                w.WriteEndElement()
                w.WriteStartElement("ram", "SpecifiedLineTradeDelivery", RAM)
                w.WriteStartElement("ram", "BilledQuantity", RAM)
                w.WriteAttributeString("unitCode", p.Einheit)
                w.WriteString(p.Menge.ToString("0.####", Inv))
                w.WriteEndElement()
                w.WriteEndElement()
                w.WriteStartElement("ram", "SpecifiedLineTradeSettlement", RAM)
                w.WriteStartElement("ram", "ApplicableTradeTax", RAM)
                w.WriteElementString("ram", "TypeCode", RAM, "VAT")
                w.WriteElementString("ram", "CategoryCode", RAM, "S")
                w.WriteElementString("ram", "RateApplicablePercent", RAM, Betrag(p.UStSatz))
                w.WriteEndElement()
                w.WriteStartElement("ram", "SpecifiedTradeSettlementLineMonetarySummation", RAM)
                w.WriteElementString("ram", "LineTotalAmount", RAM, Betrag(p.Netto))
                w.WriteEndElement()
                w.WriteEndElement()
                w.WriteEndElement()
            Next

            ' Vereinbarung: Käuferreferenz, Verkäufer, Käufer
            w.WriteStartElement("ram", "ApplicableHeaderTradeAgreement", RAM)
            w.WriteElementString("ram", "BuyerReference", RAM, r.Kaeuferreferenz)
            Partei(w, "SellerTradeParty", r.Verkaeufer, True)
            Partei(w, "BuyerTradeParty", r.Kaeufer, False)
            w.WriteEndElement()

            ' Lieferung
            w.WriteStartElement("ram", "ApplicableHeaderTradeDelivery", RAM)
            w.WriteStartElement("ram", "ActualDeliverySupplyChainEvent", RAM)
            Datum(w, "OccurrenceDateTime", r.Leistungsdatum)
            w.WriteEndElement()
            w.WriteEndElement()

            ' Abrechnung
            w.WriteStartElement("ram", "ApplicableHeaderTradeSettlement", RAM)
            w.WriteElementString("ram", "InvoiceCurrencyCode", RAM, "EUR")
            w.WriteStartElement("ram", "SpecifiedTradeSettlementPaymentMeans", RAM)
            w.WriteElementString("ram", "TypeCode", RAM, "58") ' SEPA-Überweisung
            w.WriteStartElement("ram", "PayeePartyCreditorFinancialAccount", RAM)
            w.WriteElementString("ram", "IBANID", RAM, r.Iban.Replace(" ", ""))
            w.WriteEndElement()
            w.WriteEndElement()

            ' Steuer je Satz
            Dim saetze = r.Positionen.GroupBy(Function(p) p.UStSatz)
            Dim summeNetto As Decimal = 0D, summeSteuer As Decimal = 0D
            For Each g In saetze
                Dim basis As Decimal = g.Sum(Function(p) p.Netto)
                Dim steuer As Decimal = Math.Round(basis * g.Key / 100D, 2, MidpointRounding.AwayFromZero)
                summeNetto += basis : summeSteuer += steuer
                w.WriteStartElement("ram", "ApplicableTradeTax", RAM)
                w.WriteElementString("ram", "CalculatedAmount", RAM, Betrag(steuer))
                w.WriteElementString("ram", "TypeCode", RAM, "VAT")
                w.WriteElementString("ram", "BasisAmount", RAM, Betrag(basis))
                w.WriteElementString("ram", "CategoryCode", RAM, "S")
                w.WriteElementString("ram", "RateApplicablePercent", RAM, Betrag(g.Key))
                w.WriteEndElement()
            Next

            w.WriteStartElement("ram", "SpecifiedTradePaymentTerms", RAM)
            w.WriteElementString("ram", "Description", RAM, r.Zahlungsbedingung)
            w.WriteStartElement("ram", "DueDateDateTime", RAM)
            w.WriteStartElement("udt", "DateTimeString", UDT)
            w.WriteAttributeString("format", "102")
            w.WriteString(r.Faellig.ToString("yyyyMMdd", Inv))
            w.WriteEndElement()
            w.WriteEndElement()
            w.WriteEndElement()

            Dim brutto As Decimal = summeNetto + summeSteuer
            w.WriteStartElement("ram", "SpecifiedTradeSettlementHeaderMonetarySummation", RAM)
            w.WriteElementString("ram", "LineTotalAmount", RAM, Betrag(summeNetto))
            w.WriteElementString("ram", "TaxBasisTotalAmount", RAM, Betrag(summeNetto))
            w.WriteStartElement("ram", "TaxTotalAmount", RAM)
            w.WriteAttributeString("currencyID", "EUR")
            w.WriteString(Betrag(summeSteuer))
            w.WriteEndElement()
            w.WriteElementString("ram", "GrandTotalAmount", RAM, Betrag(brutto))
            w.WriteElementString("ram", "DuePayableAmount", RAM, Betrag(brutto))
            w.WriteEndElement()

            w.WriteEndElement() ' Settlement
            w.WriteEndElement() ' Transaction
            w.WriteEndElement() ' Invoice
            w.WriteEndDocument()
        End Using
        Return sb.ToString()
    End Function

    Private Sub Datum(w As XmlWriter, name As String, d As Date)
        w.WriteStartElement("ram", name, RAM)
        w.WriteStartElement("udt", "DateTimeString", UDT)
        w.WriteAttributeString("format", "102")
        w.WriteString(d.ToString("yyyyMMdd", Inv))
        w.WriteEndElement()
        w.WriteEndElement()
    End Sub

    Private Sub Partei(w As XmlWriter, rolle As String, p As Partei, verkaeufer As Boolean)
        w.WriteStartElement("ram", rolle, RAM)
        w.WriteElementString("ram", "Name", RAM, p.Name)
        If verkaeufer Then
            ' XRechnung verlangt beim Verkäufer Kontakt mit Name, Telefon, E-Mail (BR-DE-2/5/6/7)
            w.WriteStartElement("ram", "DefinedTradeContact", RAM)
            w.WriteElementString("ram", "PersonName", RAM, p.Kontaktname)
            w.WriteStartElement("ram", "TelephoneUniversalCommunication", RAM)
            w.WriteElementString("ram", "CompleteNumber", RAM, p.Telefon)
            w.WriteEndElement()
            w.WriteStartElement("ram", "EmailURIUniversalCommunication", RAM)
            w.WriteElementString("ram", "URIID", RAM, p.Email)
            w.WriteEndElement()
            w.WriteEndElement()
        End If
        w.WriteStartElement("ram", "PostalTradeAddress", RAM)
        w.WriteElementString("ram", "PostcodeCode", RAM, p.Plz)
        w.WriteElementString("ram", "LineOne", RAM, p.Strasse)
        w.WriteElementString("ram", "CityName", RAM, p.Ort)
        w.WriteElementString("ram", "CountryID", RAM, p.Land)
        w.WriteEndElement()
        ' Elektronische Adresse (BT-34 / BT-49), Pflicht in XRechnung 3.0
        w.WriteStartElement("ram", "URIUniversalCommunication", RAM)
        w.WriteStartElement("ram", "URIID", RAM)
        w.WriteAttributeString("schemeID", "EM")
        w.WriteString(p.Email)
        w.WriteEndElement()
        w.WriteEndElement()
        If verkaeufer Then
            If Not String.IsNullOrEmpty(p.UStId) Then
                Steuer(w, "VA", p.UStId)
            ElseIf Not String.IsNullOrEmpty(p.Steuernummer) Then
                Steuer(w, "FC", p.Steuernummer)
            End If
        End If
        w.WriteEndElement()
    End Sub

    Private Sub Steuer(w As XmlWriter, schema As String, wert As String)
        w.WriteStartElement("ram", "SpecifiedTaxRegistration", RAM)
        w.WriteStartElement("ram", "ID", RAM)
        w.WriteAttributeString("schemeID", schema)
        w.WriteString(wert)
        w.WriteEndElement()
        w.WriteEndElement()
    End Sub

    ' StringWriter, der UTF-8 im XML-Kopf meldet
    Private Class Utf8Writer
        Inherits StringWriter
        Public Sub New(sb As StringBuilder)
            MyBase.New(sb, Inv)
        End Sub
        Public Overrides ReadOnly Property Encoding As Encoding
            Get
                Return New UTF8Encoding(False)
            End Get
        End Property
    End Class
End Module