diff --git a/SDL/Fakturierung/cFakturierung.vb b/SDL/Fakturierung/cFakturierung.vb
index 7ca96d37..2fd19048 100644
--- a/SDL/Fakturierung/cFakturierung.vb
+++ b/SDL/Fakturierung/cFakturierung.vb
@@ -3,6 +3,7 @@ Imports System.Globalization
Imports System.IO
Imports System.Net
Imports System.Web.UI.WebControls.Expressions
+Imports com.sun.org.apache.xpath.internal.operations
Imports Microsoft.Office.Interop
Imports s2industries.ZUGFeRD
Imports VERAG_PROG_ALLGEMEIN
@@ -1200,6 +1201,13 @@ Public Class cFakturierung
If vorschau = False And RECHNUNG.Sammelrechnung <> "0" Then MsgBox("Nur bei Einzelrechnung möglich!") : Return False
End If
+ If Not vorschau Then
+ Select Case RECHNUNG.Rechnungsart
+ Case "RU" : MsgBox("Unvollständige Rechnungen können nur mit einem Rechnungskopf in der Sammelrechnung gedruckt werden! Siehe Rechnungsart.") : Return False
+ Case "RK" : MsgBox("Ein Rechnungskopf kann nur mit zumindest einer unvollständigen Rechnung gedruckt werden! Siehe Rechnungsart.") : Return False
+ End Select
+ End If
+
If RECHNUNG.POSITIONEN.Count = 0 Then MsgBox("Keine Daten vorhanden!") : Return False
Dim dtDataSource As New DataTable
@@ -3134,15 +3142,15 @@ Public Class cFakturierung
Dim whereAutoMailversand = ""
If AUTOMailversand <> "" Then whereAutoMailversand = " AND isnull(Rechnungsausgang.Automailversand,0) = 1 "
- Dim sqlStr = " SELECT Rechnungsausgang.RK_ID, Rechnungsausgang.Firma_ID, Rechnungsausgang.FilialenNr, Rechnungsausgang.RechnungsKundenNr, Rechnungsausgang.BelegartenNr, Rechnungsausgang.[Steuersatz %], Rechnungsausgang.Lastschrift, Rechnungsausgang.Währungscode, Rechnungsausgang.AvisoID, Rechnungsausgang.RechnungsNr, Rechnungsausgang.RechnungsDatum, Rechnungsausgang.DruckDatumZeit, Rechnungsausgang.Status, Rechnungsausgang.Sammelrechnung, Rechnungsausgang.Abfertigungsdatum, Rechnungsausgang.Buchungsjahr,Rechnungsausgang.AbfertigungsNr,Rechnungsausgang.SpeditionsbuchUnterNr,[SteuerpflichtigerGesamtbetrag],[SteuerfreierGesamtbetrag]
+ Dim sqlStr = " SELECT Rechnungsausgang.RK_ID, Rechnungsausgang.Firma_ID, Rechnungsausgang.FilialenNr, Rechnungsausgang.RechnungsKundenNr, Rechnungsausgang.BelegartenNr, Rechnungsausgang.[Steuersatz %], Rechnungsausgang.Lastschrift, Rechnungsausgang.Währungscode, Rechnungsausgang.AvisoID, Rechnungsausgang.RechnungsNr, Rechnungsausgang.RechnungsDatum, Rechnungsausgang.DruckDatumZeit, Rechnungsausgang.Status, Rechnungsausgang.Sammelrechnung, Rechnungsausgang.Abfertigungsdatum, Rechnungsausgang.Buchungsjahr,Rechnungsausgang.AbfertigungsNr,Rechnungsausgang.SpeditionsbuchUnterNr,[SteuerpflichtigerGesamtbetrag],[SteuerfreierGesamtbetrag],Rechnungsausgang.Rechnungsart
From Rechnungsausgang
WHERE Rechnungsausgang.Status IN(0, 2) And Rechnungsausgang.Firma_ID = " & Firma_ID & " And Rechnungsausgang.Sammelrechnung = '" & SammelrechungArt & "' And Rechnungsausgang.FakturierungsGruppe = '" & FakturierungsGruppe & "' And CONVERT(DATE,Rechnungsausgang.Abfertigungsdatum,104) <= '" & DatumBis.ToShortDateString & "' " & whereKdNr & whereAbfArt & "
" & If(SammelrechungArt = 7 And SB <> "", " AND Sachbearbeiter='" & SB & "' ", "") & "" & getWhereAvisoId(AvisoIds) & whereAutoMailversand
'Rechnungsausgang.Status IN(0, 2) --> vorher nur 2, da Anlagen vor der SR gedruckt wurden...
If SammelrechungArt = 7 Then
- sqlStr &= " ORDER BY Rechnungsausgang.AvisoID,Rechnungsausgang.Firma_ID,Rechnungsausgang.RechnungsKundenNr,Rechnungsausgang.FilialenNr, Rechnungsausgang.AbfertigungsNr, Rechnungsausgang.BelegartenNr, Rechnungsausgang.[Steuersatz %], Rechnungsausgang.Lastschrift, Rechnungsausgang.Währungscode "
+ sqlStr &= " ORDER BY Rechnungsausgang.AvisoID,Rechnungsausgang.Firma_ID,Rechnungsausgang.RechnungsKundenNr,Rechnungsausgang.FilialenNr, Rechnungsausgang.AbfertigungsNr, Rechnungsausgang.BelegartenNr, Rechnungsausgang.[Steuersatz %], Rechnungsausgang.Lastschrift, Rechnungsausgang.Währungscode, CASE Rechnungsausgang.Rechnungsart WHEN 'RK' THEN 1 WHEN 'RU' THEN 2 WHEN 'RG' THEN 3 ELSE 4 END "
Else
- sqlStr &= " ORDER BY Rechnungsausgang.Firma_ID, Rechnungsausgang.RechnungsKundenNr,Rechnungsausgang.FilialenNr,Rechnungsausgang.AbfertigungsNr, Rechnungsausgang.BelegartenNr, Rechnungsausgang.[Steuersatz %], Rechnungsausgang.Lastschrift, Rechnungsausgang.Währungscode, Rechnungsausgang.AvisoID "
+ sqlStr &= " ORDER BY Rechnungsausgang.Firma_ID, Rechnungsausgang.RechnungsKundenNr,Rechnungsausgang.FilialenNr,Rechnungsausgang.AbfertigungsNr, Rechnungsausgang.BelegartenNr, Rechnungsausgang.[Steuersatz %], Rechnungsausgang.Lastschrift, Rechnungsausgang.Währungscode, Rechnungsausgang.AvisoID, CASE Rechnungsausgang.Rechnungsart WHEN 'RK' THEN 1 WHEN 'RU' THEN 2 WHEN 'RG' THEN 3 ELSE 4 END "
End If
' MsgBox(sqlStr)
Dim dt = SQL.loadDgvBySql(sqlStr, "FMZOLL")
@@ -3152,13 +3160,46 @@ Public Class cFakturierung
Public Shared Function CHECK_SR_SQLDT(dt As DataTable) As Boolean
For Each r In dt.Rows
- If (CDbl(r("SteuerpflichtigerGesamtbetrag")) + CDbl(r("SteuerfreierGesamtbetrag"))) = 0 Then
- Return False
+ If r("Rechnungsart") <> "RU" Then 'Sofern es sich nicht um eine unvollständige RG handelt, muss der Steuerpflichtige Gesamtbetrag <> 0 sein.
+ If (CDbl(r("SteuerpflichtigerGesamtbetrag")) + CDbl(r("SteuerfreierGesamtbetrag"))) = 0 Then
+ Return False
+ End If
End If
Next
Return True
End Function
+ Public Shared Function CHECK_SR_GESSUM_SQLDT(dt As DataTable) As Boolean
+ Dim sum As Double = 0
+ For Each r In dt.Rows
+ If r("Rechnungsart") <> "RU" Then 'Sofern es sich nicht um eine unvollständige RG handelt, muss der Steuerpflichtige Gesamtbetrag <> 0 sein.
+ sum += (CDbl(r("SteuerpflichtigerGesamtbetrag")) + CDbl(r("SteuerfreierGesamtbetrag")))
+ End If
+ Next
+ If sum = 0 Then Return False
+ Return True
+ End Function
+
+ Public Shared Function CHECK_SR_RU_RK_SQLDT(dt As DataTable) As Boolean
+ Dim sum As Double = 0
+ Dim RU_found = False
+ Dim RK_found = False
+ For Each r In dt.Rows
+ If r("Rechnungsart") = "RU" Then 'Sofern mind. eine unvollständige RG vorhanden ist, muss auch ein Kopfeintrag vorhanden sein
+ RU_found = True
+ End If
+ If r("Rechnungsart") = "RK" Then 'Sofern mind. eine unvollständige RG vorhanden ist, muss auch ein Kopfeintrag vorhanden sein
+ RK_found = True
+ End If
+ Next
+ MsgBox(RU_found)
+ MsgBox(RK_found)
+ MsgBox(RU_found And RK_found)
+ If RU_found And RK_found Then Return True
+ If Not RU_found And Not RK_found Then Return True
+
+ Return False
+ End Function
Public Shared Function getWhereAvisoId(ids As List(Of Integer)) As String
If ids Is Nothing Then Return ""
If ids.Count = 0 Then Return ""
@@ -3198,6 +3239,9 @@ Public Class cFakturierung
If dt Is Nothing Then MsgBox("ERR01: Keine Daten") : Return True
If dt.Rows.Count = 0 Then MsgBox("ERR02: Keine Daten") : Return True
If Not CHECK_SR_SQLDT(dt) Then MsgBox("ERR03: Es wurden Rechnungen mit einem 0-Betrag gefunden. Bitte prüfen Sie die Eingaben und starten Sie die Sammelabrechnung erneut.") : Return True
+ If Not CHECK_SR_GESSUM_SQLDT(dt) Then MsgBox("ERR04: Summe der REchnungen in Sammelrechnung ist '0'. Bitte prüfen Sie die Eingaben und starten Sie die Sammelabrechnung erneut.") : Return True
+ 'Rechnungsart prüfen, ob Sammelrechnung oder unvollständige SRG /
+ If Not CHECK_SR_RU_RK_SQLDT(dt) Then MsgBox("ERR05: Bei Kopf-Sammelrechnung müssen Kopfdaten und unvollständige Rg-Einträge vorhanden sein. Bitte prüfen Sie die Eingaben und starten Sie die Sammelabrechnung erneut.") : Return True
Dim Buchungsjahr = cRKSV.getGJ(Rechnungsdatum, Firma_ID) 'IIf(Rechnungsdatum.Month = 1, Rechnungsdatum.Year - 1, Rechnungsdatum.Year)
diff --git a/SDL/Fakturierung/usrCntlFaktAbrechnung.Designer.vb b/SDL/Fakturierung/usrCntlFaktAbrechnung.Designer.vb
index 6f819edd..7c5f2213 100644
--- a/SDL/Fakturierung/usrCntlFaktAbrechnung.Designer.vb
+++ b/SDL/Fakturierung/usrCntlFaktAbrechnung.Designer.vb
@@ -286,6 +286,8 @@ Partial Class usrCntlFaktAbrechnung
Me.GutschriftAnVeragToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem()
Me.VeragAGToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem()
Me.VeragCSToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem()
+ Me.cboRgArt = New VERAG_PROG_ALLGEMEIN.MyComboBox()
+ Me.Label57 = New System.Windows.Forms.Label()
Me.pnlTop.SuspendLayout()
Me.Panel3.SuspendLayout()
Me.Panel1.SuspendLayout()
@@ -2020,6 +2022,8 @@ Partial Class usrCntlFaktAbrechnung
'
Me.pnlRechnungAn.BackColor = System.Drawing.Color.PapayaWhip
Me.pnlRechnungAn.BorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
+ Me.pnlRechnungAn.Controls.Add(Me.cboRgArt)
+ Me.pnlRechnungAn.Controls.Add(Me.Label57)
Me.pnlRechnungAn.Controls.Add(Me.cboVorauskasse)
Me.pnlRechnungAn.Controls.Add(Me.Label56)
Me.pnlRechnungAn.Controls.Add(Me.txtRechnungAnZusatz)
@@ -2104,7 +2108,7 @@ Partial Class usrCntlFaktAbrechnung
'
Me.Button15.Enabled = False
Me.Button15.FlatStyle = System.Windows.Forms.FlatStyle.Flat
- Me.Button15.Location = New System.Drawing.Point(518, 105)
+ Me.Button15.Location = New System.Drawing.Point(518, 85)
Me.Button15.Name = "Button15"
Me.Button15.Size = New System.Drawing.Size(57, 23)
Me.Button15.TabIndex = 241
@@ -2177,7 +2181,7 @@ Partial Class usrCntlFaktAbrechnung
Me.lblUIDOK.AutoSize = True
Me.lblUIDOK.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.0!, System.Drawing.FontStyle.Bold)
Me.lblUIDOK.ForeColor = System.Drawing.Color.Green
- Me.lblUIDOK.Location = New System.Drawing.Point(431, 131)
+ Me.lblUIDOK.Location = New System.Drawing.Point(431, 111)
Me.lblUIDOK.Name = "lblUIDOK"
Me.lblUIDOK.Size = New System.Drawing.Size(104, 13)
Me.lblUIDOK.TabIndex = 21
@@ -2189,7 +2193,7 @@ Partial Class usrCntlFaktAbrechnung
Me.lblUIDErr.AutoSize = True
Me.lblUIDErr.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.0!, System.Drawing.FontStyle.Bold)
Me.lblUIDErr.ForeColor = System.Drawing.Color.Red
- Me.lblUIDErr.Location = New System.Drawing.Point(431, 131)
+ Me.lblUIDErr.Location = New System.Drawing.Point(431, 111)
Me.lblUIDErr.Name = "lblUIDErr"
Me.lblUIDErr.Size = New System.Drawing.Size(122, 13)
Me.lblUIDErr.TabIndex = 8
@@ -2200,7 +2204,7 @@ Partial Class usrCntlFaktAbrechnung
'
Me.Button6.Enabled = False
Me.Button6.FlatStyle = System.Windows.Forms.FlatStyle.Flat
- Me.Button6.Location = New System.Drawing.Point(434, 105)
+ Me.Button6.Location = New System.Drawing.Point(434, 85)
Me.Button6.Name = "Button6"
Me.Button6.Size = New System.Drawing.Size(85, 23)
Me.Button6.TabIndex = 15
@@ -2504,7 +2508,7 @@ Partial Class usrCntlFaktAbrechnung
'Label7
'
Me.Label7.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
- Me.Label7.Location = New System.Drawing.Point(408, 85)
+ Me.Label7.Location = New System.Drawing.Point(408, 65)
Me.Label7.Name = "Label7"
Me.Label7.Size = New System.Drawing.Size(167, 13)
Me.Label7.TabIndex = 16
@@ -4031,6 +4035,27 @@ Partial Class usrCntlFaktAbrechnung
Me.VeragCSToolStripMenuItem.Size = New System.Drawing.Size(122, 22)
Me.VeragCSToolStripMenuItem.Text = "Verag CS"
'
+ 'cboRgArt
+ '
+ Me.cboRgArt._allowedValuesFreiText = Nothing
+ Me.cboRgArt._allowFreiText = False
+ Me.cboRgArt._value = ""
+ Me.cboRgArt.FormattingEnabled = True
+ Me.cboRgArt.Location = New System.Drawing.Point(478, 127)
+ Me.cboRgArt.Name = "cboRgArt"
+ Me.cboRgArt.Size = New System.Drawing.Size(97, 21)
+ Me.cboRgArt.TabIndex = 246
+ '
+ 'Label57
+ '
+ Me.Label57.AutoSize = True
+ Me.Label57.Location = New System.Drawing.Point(431, 130)
+ Me.Label57.Name = "Label57"
+ Me.Label57.Size = New System.Drawing.Size(42, 13)
+ Me.Label57.TabIndex = 245
+ Me.Label57.Text = "RG-Art:"
+ Me.Label57.TextAlign = System.Drawing.ContentAlignment.TopRight
+ '
'usrCntlFaktAbrechnung
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -4323,4 +4348,6 @@ Partial Class usrCntlFaktAbrechnung
Friend WithEvents VeragCSToolStripMenuItem As ToolStripMenuItem
Friend WithEvents lblOFgesperrt As Label
Friend WithEvents cboVorauskasse As VERAG_PROG_ALLGEMEIN.MyComboBox
+ Friend WithEvents cboRgArt As VERAG_PROG_ALLGEMEIN.MyComboBox
+ Friend WithEvents Label57 As Label
End Class
diff --git a/SDL/Fakturierung/usrCntlFaktAbrechnung.vb b/SDL/Fakturierung/usrCntlFaktAbrechnung.vb
index b66cb8c2..97995090 100644
--- a/SDL/Fakturierung/usrCntlFaktAbrechnung.vb
+++ b/SDL/Fakturierung/usrCntlFaktAbrechnung.vb
@@ -295,6 +295,9 @@ Public Class usrCntlFaktAbrechnung
txtErfassungsnummer.Text = If(RECHNUNG.ErfassungsNr, "")
cboRechnungNotiz.Text = If(RECHNUNG.Notiz, "")
+
+ initRgArt()
+ cboRgArt._value = RECHNUNG.Rechnungsart
'txtRohmasse.Text = If(RECHNUNG., "")
cboAnlage1.Text = If(RECHNUNG.Anlage_1, "")
@@ -555,6 +558,16 @@ Public Class usrCntlFaktAbrechnung
If FirmaTmp = "VERAG360" Then cboRechnungSprache.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Rumänisch", "RO"))
cboRechnungSprache.changeItem(0)
+ cboRgArt.Items.Clear()
+ If SPEDBUCH IsNot Nothing AndAlso SPEDBUCH.Abfertigungsart = 100 Then
+ cboRgArt.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("RG-Kopf", "RK"))
+ Else
+ cboRgArt.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Standard", "RG"))
+ cboRgArt.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Unvollständig", "RU"))
+ End If
+ cboRgArt.changeItem(0)
+
+
'cboSteuerschlüssel.fillWithSQL("SELECT tblSteuersätze.Nr, tblSteuersätze.Beschreibung FROM tblSteuersätze ORDER BY tblSteuersätze.Nr; ", False, "FMZOLL", True)
cboSteuerschlüssel.fillWithSQL("SELECT [Steuerschlüssel],isnull([AuswahlSteuerbezeichnung],'') as Steuerbezeichnung FROM [Steuertabelle] ORDER BY [Steuerschlüssel]", False, "FMZOLL", True)
@@ -1020,6 +1033,8 @@ Public Class usrCntlFaktAbrechnung
Case Else
End Select
+ initRgArt()
+
initKdAtrNr()
initPkSt()
End Sub
@@ -1757,6 +1772,9 @@ Public Class usrCntlFaktAbrechnung
End If
End If
+ initRgArt()
+
+
initDGVAnhaenge()
cboRechnungAn.Focus()
@@ -1767,7 +1785,33 @@ Public Class usrCntlFaktAbrechnung
initFirma() ' wegen EV-VZ
End Sub
+ Sub initRgArt()
+ cboRgArt.Items.Clear()
+ If SPEDBUCH IsNot Nothing Then
+ If SPEDBUCH.Abfertigungsart = 100 Then
+ cboRgArt.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("RG-Kopf", "RK"))
+ Else
+ cboRgArt.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Standard", "RG"))
+ cboRgArt.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Unvollständig", "RU"))
+ End If
+ Else
+ cboRgArt.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("RG-Kopf", "RK"))
+ cboRgArt.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Standard", "RG"))
+ cboRgArt.Items.Add(New VERAG_PROG_ALLGEMEIN.MyListItem("Unvollständig", "RU"))
+ End If
+
+ cboRgArt.SelectedIndex = 0
+ If txtkdNrRechnungAn.Text <> "" Then
+ Dim KDE As New cKundenErweitert(txtkdNrRechnungAn.Text)
+ If KDE IsNot Nothing Then
+
+ If KDE.kde_Kopfsammelrechnung Then
+ If cboRgArt.Items.Count > 1 Then cboRgArt.changeItem("RU")
+ End If
+ End If
+ End If
+ End Sub
Sub initDGVAnhaenge()
With dgvAnhaenge
@@ -2338,6 +2382,7 @@ Public Class usrCntlFaktAbrechnung
RECHNUNG.RefAbfertigungsNr = cProgramFunctions.isLeerNothing(txtAbfertigungsnummerRef.Text) '????????
RECHNUNG.RefUnterNr = cProgramFunctions.isLeerNothing(txtUnterNrRef.Text) '????????
RECHNUNG.Notiz = cProgramFunctions.isLeerNothing(cboRechnungNotiz.Text)
+ RECHNUNG.Rechnungsart = cProgramFunctions.isLeerNothing(cboRgArt._value)
' RECHNUNG.Zucker_MRN_Nr = cProgramFunctions.isLeerNothing(XXXXXXXXX.text)
' RECHNUNG.Zucker_MRN_Datum = cProgramFunctions.isLeerNothing(XXXXXXXXX.text)
' RECHNUNG.Zucker_Aufschub = cProgramFunctions.isLeerNothing(XXXXXXXXX.text)
diff --git a/SDL/kunden/usrcntlKundeBearbeitenFull.Designer.vb b/SDL/kunden/usrcntlKundeBearbeitenFull.Designer.vb
index fd099f4d..02a2ef68 100644
--- a/SDL/kunden/usrcntlKundeBearbeitenFull.Designer.vb
+++ b/SDL/kunden/usrcntlKundeBearbeitenFull.Designer.vb
@@ -404,6 +404,7 @@ Partial Class usrcntlKundeBearbeitenFull
Me.cboFirma = New VERAG_PROG_ALLGEMEIN.MyComboBox()
Me.cboAuswahl = New VERAG_PROG_ALLGEMEIN.MyComboBox()
Me.DataGridViewTextBoxColumn2 = New System.Windows.Forms.DataGridViewTextBoxColumn()
+ Me.cbpKopfsammelrechnung = New System.Windows.Forms.CheckBox()
Me.tbcntrDetails.SuspendLayout()
Me.tbAbfertigung.SuspendLayout()
Me.tbcntrAbf.SuspendLayout()
@@ -1134,6 +1135,7 @@ Partial Class usrcntlKundeBearbeitenFull
'
'tbVerrechnung
'
+ Me.tbVerrechnung.Controls.Add(Me.cbpKopfsammelrechnung)
Me.tbVerrechnung.Controls.Add(Me.pnlverag360)
Me.tbVerrechnung.Controls.Add(Me.cbxKapitalWaehrung)
Me.tbVerrechnung.Controls.Add(Me.Label103)
@@ -1201,7 +1203,7 @@ Partial Class usrcntlKundeBearbeitenFull
Me.pnlverag360.Controls.Add(Me.gbMWSTAntraege)
Me.pnlverag360.Controls.Add(Me.txtVorauszahlung)
Me.pnlverag360.Controls.Add(Me.cbxVorauszahlung)
- Me.pnlverag360.Location = New System.Drawing.Point(417, 247)
+ Me.pnlverag360.Location = New System.Drawing.Point(417, 288)
Me.pnlverag360.Name = "pnlverag360"
Me.pnlverag360.Size = New System.Drawing.Size(252, 204)
Me.pnlverag360.TabIndex = 49
@@ -5514,6 +5516,17 @@ Partial Class usrcntlKundeBearbeitenFull
Me.DataGridViewTextBoxColumn2.HeaderText = "E-Mail"
Me.DataGridViewTextBoxColumn2.Name = "DataGridViewTextBoxColumn2"
'
+ 'cbpKopfsammelrechnung
+ '
+ Me.cbpKopfsammelrechnung.AutoSize = True
+ Me.cbpKopfsammelrechnung.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
+ Me.cbpKopfsammelrechnung.Location = New System.Drawing.Point(417, 244)
+ Me.cbpKopfsammelrechnung.Name = "cbpKopfsammelrechnung"
+ Me.cbpKopfsammelrechnung.Size = New System.Drawing.Size(202, 30)
+ Me.cbpKopfsammelrechnung.TabIndex = 50
+ Me.cbpKopfsammelrechnung.Text = "Kopf-Sammelrechnung" & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "(Abr. mit unvollst. Rg+ Kopfrechnung)"
+ Me.cbpKopfsammelrechnung.UseVisualStyleBackColor = True
+ '
'usrcntlKundeBearbeitenFull
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -5971,4 +5984,5 @@ Partial Class usrcntlKundeBearbeitenFull
Friend WithEvents Label112 As Label
Friend WithEvents Label111 As Label
Friend WithEvents cbxErstattungsart As VERAG_PROG_ALLGEMEIN.MyComboBox
+ Friend WithEvents cbpKopfsammelrechnung As CheckBox
End Class
diff --git a/SDL/kunden/usrcntlKundeBearbeitenFull.vb b/SDL/kunden/usrcntlKundeBearbeitenFull.vb
index abde09ee..9300cd39 100644
--- a/SDL/kunden/usrcntlKundeBearbeitenFull.vb
+++ b/SDL/kunden/usrcntlKundeBearbeitenFull.vb
@@ -213,6 +213,7 @@
txtVorauszahlung.Text = loadValue(KUNDE_ERW.kde_AnmerkungVZ, "")
cbxFR.Checked = loadValue(KUNDE_ERW.kde_FR, False)
txtFR.Text = loadValue(KUNDE_ERW.kde_AnmerkungFR, "")
+ cbpKopfsammelrechnung.Checked = KUNDE_ERW.kde_Kopfsammelrechnung
txtAnmerkungAntraege.Text = loadValue(KUNDE_ERW.kde_AnmerkungAntrag, "")
txtEORI.Text = If(KUNDE.EORITIN, "")
@@ -633,6 +634,7 @@
KUNDE_ERW.kde_AnmerkungAntrag = txtAnmerkungAntraege.Text
KUNDE_ERW.kde_FR = cbxFR.Checked
KUNDE_ERW.kde_AnmerkungFR = txtFR.Text
+ KUNDE_ERW.kde_Kopfsammelrechnung = cbpKopfsammelrechnung.Checked
If isLeerNothing(txtGruendungsDatum.Text) IsNot Nothing AndAlso IsDate(txtGruendungsDatum.Text) Then
KUNDE_ERW.kde_GruendungsDatum = CDate(txtGruendungsDatum.Text)
diff --git a/VERAG_PROG_ALLGEMEIN/Classes/cKundenErweitert.vb b/VERAG_PROG_ALLGEMEIN/Classes/cKundenErweitert.vb
index c178f54b..911525cf 100644
--- a/VERAG_PROG_ALLGEMEIN/Classes/cKundenErweitert.vb
+++ b/VERAG_PROG_ALLGEMEIN/Classes/cKundenErweitert.vb
@@ -97,6 +97,7 @@ Public Class cKundenErweitert
Property kde_AnmerkungAntrag As Object = Nothing
Property kde_Erstattungsart As Object = Nothing
Property kde_BezFIBU As Object = Nothing
+ Property kde_Kopfsammelrechnung As Boolean = False
@@ -198,6 +199,7 @@ Public Class cKundenErweitert
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kde_FR", kde_FR))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kde_Erstattungsart", kde_Erstattungsart))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kde_BezFIBU", kde_BezFIBU))
+ list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kde_Kopfsammelrechnung", kde_Kopfsammelrechnung))
Return list
End Function
diff --git a/VERAG_PROG_ALLGEMEIN/Classes/cRechnungsausgang.vb b/VERAG_PROG_ALLGEMEIN/Classes/cRechnungsausgang.vb
index b3307dd1..22da1c8d 100644
--- a/VERAG_PROG_ALLGEMEIN/Classes/cRechnungsausgang.vb
+++ b/VERAG_PROG_ALLGEMEIN/Classes/cRechnungsausgang.vb
@@ -119,6 +119,7 @@ Public Class cRechnungsausgang
Property ForceSteuerschlüssel As Object = Nothing
Property Automailversand As Boolean = False
+ Property Rechnungsart As String = "RG" ' RG=Rechnung; RU=Rechnung Unvollständig; RK=RechnungKopf -> bei unvollständiger Rechnung ein Kopf benötigt (zB Staffelabrechnung)
' FROM [VERAG as object=nothing.[dbo as object=nothing.[Rechnungsausgang as object=nothing
@@ -362,6 +363,7 @@ Public Class cRechnungsausgang
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("TextZZ", TextZZ))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ForceSteuerschlüssel", ForceSteuerschlüssel))
list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("Automailversand", Automailversand))
+ list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("Rechnungsart", Rechnungsart))
Return list
End Function
@@ -499,10 +501,11 @@ Public Class cRechnungsausgang
End If
End If
+
If dgv Is Nothing Then
- errMsg = "ERROR: Keine Positionen angegeben!" : Return False
+ If Rechnungsart <> "RU" Then errMsg = "ERROR: Keine Positionen angegeben!" : Return False
ElseIf dgv.Rows.Count = 0 Then
- errMsg = "ERROR: Keine Positionen angegeben!" : Return False
+ If Rechnungsart <> "RU" Then errMsg = "ERROR: Keine Positionen angegeben!" : Return False
Else
If dgv.Rows.Count > 1 Then
'Prüfung für doppelte Positionen mit PK: Bezeichnung und LeistungNr!
@@ -522,39 +525,39 @@ Public Class cRechnungsausgang
End If
End If
- End If
-
- If dgv Is Nothing Then
- errMsg = "ERROR: Keine Positionen angegeben!" : Return False
- ElseIf dgv.Rows.Count = 0 Then
- errMsg = "ERROR: Keine Positionen angegeben!" : Return False
- Else
- If dgv.Rows.Count > 1 Then
- 'Prüfung für doppelte Positionen mit PK: Bezeichnung und LeistungNr!
- Dim dt As New DataTable
- dt.Columns.Add("name", GetType(String))
-
- For Each row As DataGridViewRow In dgv.Rows
- Dim R As DataRow = dt.NewRow
- R("name") = row.Cells(0).Value
- dt.Rows.Add(R)
- Next
- Dim dv As New DataView(dt)
- Dim distinct As DataTable = dv.ToTable(True, New String() {"name"})
-
- If distinct.Rows.Count <> dt.Rows.Count Then
- errMsg = "ERROR: Doppelte Positionen vorhanden!" : Return False
- End If
-
End If
- End If
+
+ If dgv Is Nothing Then
+ errMsg = "ERROR: Keine Positionen angegeben!" : Return False
+ ElseIf dgv.Rows.Count = 0 Then
+ errMsg = "ERROR: Keine Positionen angegeben!" : Return False
+ Else
+ If dgv.Rows.Count > 1 Then
+ 'Prüfung für doppelte Positionen mit PK: Bezeichnung und LeistungNr!
+ Dim dt As New DataTable
+ dt.Columns.Add("name", GetType(String))
+
+ For Each row As DataGridViewRow In dgv.Rows
+ Dim R As DataRow = dt.NewRow
+ R("name") = row.Cells(0).Value
+ dt.Rows.Add(R)
+ Next
+ Dim dv As New DataView(dt)
+ Dim distinct As DataTable = dv.ToTable(True, New String() {"name"})
+
+ If distinct.Rows.Count <> dt.Rows.Count Then
+ errMsg = "ERROR: Doppelte Positionen vorhanden!" : Return False
+ End If
+
+ End If
+ End If
- 'checkFirmen
+ 'checkFirmen
- Return True
- End Function
+ Return True
+ End Function
Public Function SAVE_POSITIONEN(RK_ID) As Boolean
If DELETE_POSITIONEN() Then ' zuerst Einträge löschen...
diff --git a/VERAG_PROG_ALLGEMEIN/Schnittstellen/ATEZ/GREENPULSE/cATEZ_Greenpulse_KafkaDecs.vb b/VERAG_PROG_ALLGEMEIN/Schnittstellen/ATEZ/GREENPULSE/cATEZ_Greenpulse_KafkaDecs.vb
new file mode 100644
index 00000000..70686560
--- /dev/null
+++ b/VERAG_PROG_ALLGEMEIN/Schnittstellen/ATEZ/GREENPULSE/cATEZ_Greenpulse_KafkaDecs.vb
@@ -0,0 +1,311 @@
+
+
+
+' Requires NuGet:
+' - Confluent.Kafka
+' - Newtonsoft.Json
+' Target framework: .NET Framework 4.8 oder .NET 6/8 (passt beides)
+
+Imports System.Threading
+ Imports System.Threading.Tasks
+ Imports Confluent.Kafka
+ Imports Newtonsoft.Json
+
+Namespace Verag.Udm
+
+ '''
+ ''' UDM-Record inkl. Beispielbefüllung und Kafka-Producer.
+ ''' Datenschema gemäß bereitgestellter JSON-Struktur. :contentReference[oaicite:1]{index=1}
+ '''
+ Public Class cATEZ_Greenpulse_KafkaDecs
+
+ '========================
+ '== Kafka: Konfiguration (Klassenebene)
+ '========================
+ Public Shared BootstrapServers As String = "192.168.85.250:8888" 'http://192.168.85.250:8888
+ Public Shared TopicName As String = "greenpulse.declarationdata.v1"
+ ' Falls SASL/TLS benötigt:
+ Public Shared UseSasl As Boolean = False
+ Public Shared SaslUsername As String = ""
+ Public Shared SaslPassword As String = ""
+ Public Shared SecurityProtocolSetting As SecurityProtocol = SecurityProtocol.Plaintext
+ Public Shared SaslMechanismSetting As SaslMechanism = SaslMechanism.Plain
+
+ '========================
+ '== Datenobjekte lt. UDM-Schema
+ '========================
+
+
+ Public Property Declaration As DeclarationNode
+
+
+ Public Property Parties As PartiesNode
+
+
+ Public Property Commercial As CommercialNode
+
+
+ Public Property ExporterDetails As ExporterDetailsNode
+
+
+ Public Property ImporterDetails As ImporterDetailsNode
+
+ '--- declaration ---
+ Public Class DeclarationNode
+
+ Public Property DeclarationSourceId As String
+
+
+ Public Property DeclarationNo As String
+
+
+ Public Property DeclarationDate As String
+
+
+ Public Property RequestedProcedure As String
+
+
+ Public Property PreviousProcedure As String
+
+
+ Public Property Goods As List(Of GoodItem)
+ End Class
+
+ Public Class GoodItem
+
+ Public Property CommodityCode As String
+
+
+ Public Property OriginCountryCode As String
+
+
+ Public Property NetMass As String
+
+
+ Public Property TypeOfMeasurementUnit As String
+
+
+ Public Property SpecialProcedures As SpecialProceduresNode
+ End Class
+
+ Public Class SpecialProceduresNode
+
+ Public Property MemberStateAutharization As String
+
+
+ Public Property DischargeBillWaiver As String
+
+
+ Public Property Authorisation As String
+
+
+ Public Property StartTime As String
+
+
+ Public Property EndTime As String
+
+
+ Public Property Deadline As String
+ End Class
+
+ '--- parties ---
+ Public Class PartiesNode
+
+ Public Property ImporterIdentificationNumber As String
+
+
+ Public Property ExporterIdentificationNumber As String
+
+
+ Public Property ReportingDeclarantEORINumber As String
+
+
+ Public Property TypeOfRepresentation As String
+ End Class
+
+ '--- commercial ---
+ Public Class CommercialNode
+
+ Public Property InvoiceNumbers As String
+
+
+ Public Property InvoiceDate As String
+ End Class
+
+ '--- exporterDetails ---
+ Public Class ExporterDetailsNode
+
+ Public Property ExporterTitle As String
+
+
+ Public Property ExporterEmail As String
+
+
+ Public Property ExporterPhone As String
+ End Class
+
+ '--- importerDetails ---
+ Public Class ImporterDetailsNode
+
+ Public Property ImporterTitle As String
+
+
+ Public Property ImporterEmail As String
+
+
+ Public Property ImporterPhone As String
+
+
+ Public Property ImporterCountryCodeOrMemberState As String
+
+
+ Public Property ImporterSubdivision As String
+
+
+ Public Property ImporterCity As String
+
+
+ Public Property ImporterStreet As String
+
+
+ Public Property ImporterStreetAdditional As String
+
+
+ Public Property ImporterAddressNumber As String
+
+
+ Public Property ImporterPostCode As String
+
+
+ Public Property ImporterPoBox As String
+
+
+ Public Property ImporterCoordinateLongitudeX As String
+
+
+ Public Property ImporterCoordinateLatitudeY As String
+ End Class
+
+ '========================
+ '== Serialisierung
+ '========================
+ Public Function ToJson(Optional pretty As Boolean = True) As String
+ Dim format = If(pretty, Formatting.Indented, Formatting.None)
+ Return JsonConvert.SerializeObject(Me, format)
+ End Function
+
+ '========================
+ '== Beispielbefüllung
+ '========================
+ Public Shared Function BuildDemo() As cATEZ_Greenpulse_KafkaDecs
+ Return New cATEZ_Greenpulse_KafkaDecs() With {
+ .Declaration = New DeclarationNode() With {
+ .DeclarationSourceId = "xx123",
+ .DeclarationNo = "24AT000000INL0JD01",
+ .DeclarationDate = "2024-11-22",
+ .RequestedProcedure = "40",
+ .PreviousProcedure = "00",
+ .Goods = New List(Of GoodItem) From {
+ New GoodItem() With {
+ .CommodityCode = "72072710",
+ .OriginCountryCode = "TR",
+ .NetMass = "150",
+ .TypeOfMeasurementUnit = "Tonnes",
+ .SpecialProcedures = New SpecialProceduresNode() With {
+ .MemberStateAutharization = "AT",
+ .DischargeBillWaiver = "01",
+ .Authorisation = "Name of authorisation",
+ .StartTime = "2024-10-22",
+ .EndTime = "2024-11-22",
+ .Deadline = "2024-12-22"
+ }
+ }
+ }
+ },
+ .Parties = New PartiesNode() With {
+ .ImporterIdentificationNumber = "ATEOS1000000001",
+ .ExporterIdentificationNumber = "FR123456789000",
+ .ReportingDeclarantEORINumber = "ATEOS1000000002",
+ .TypeOfRepresentation = "01"
+ },
+ .Commercial = New CommercialNode() With {
+ .InvoiceNumbers = "123456789",
+ .InvoiceDate = "2024-11-22"
+ },
+ .ExporterDetails = New ExporterDetailsNode() With {
+ .ExporterTitle = "",
+ .ExporterEmail = "",
+ .ExporterPhone = ""
+ },
+ .ImporterDetails = New ImporterDetailsNode() With {
+ .ImporterTitle = "Importer name",
+ .ImporterEmail = "info@test.com",
+ .ImporterPhone = "123456789",
+ .ImporterCountryCodeOrMemberState = "DE",
+ .ImporterSubdivision = "Sub-division",
+ .ImporterCity = "City name",
+ .ImporterStreet = "Street Name",
+ .ImporterStreetAdditional = "Street additonal name",
+ .ImporterAddressNumber = "10",
+ .ImporterPostCode = "DCL-123",
+ .ImporterPoBox = "PO DCL-123",
+ .ImporterCoordinateLongitudeX = "41.0091982",
+ .ImporterCoordinateLatitudeY = "28.9662187"
+ }
+ }
+ End Function
+
+ '========================
+ '== Unique-Key-Ermittlung (leer gelassen – später definieren)
+ '========================
+ Public Shared Function GetUniqueKey(ByVal record As cATEZ_Greenpulse_KafkaDecs) As String
+ ' TODO: Hier Logik zur Schlüsselbildung implementieren (z.B. declarationsourceId + declarationNo)
+ Return ""
+ End Function
+
+ '========================
+ '== Kafka: Insert/Update (per Message-Key)
+ '========================
+ Public Shared Async Function InsertOrUpdateToKafkaAsync(ByVal record As cATEZ_Greenpulse_KafkaDecs,
+ Optional ct As CancellationToken = Nothing) As Task(Of DeliveryResult(Of String, String))
+
+ Dim cfg As New ProducerConfig() With {
+ .BootstrapServers = BootstrapServers,
+ .Acks = Acks.All,
+ .EnableIdempotence = True,
+ .MessageTimeoutMs = 30000
+ }
+
+ If UseSasl Then
+ cfg.SecurityProtocol = SecurityProtocolSetting
+ cfg.SaslMechanism = SaslMechanismSetting
+ cfg.SaslUsername = SaslUsername
+ cfg.SaslPassword = SaslPassword
+ ' Optional: cfg.SslCaLocation = "path\to\ca.pem"
+ End If
+
+ Dim key As String = GetUniqueKey(record) ' bleibt leer bis du definierst
+ Dim payload As String = record.ToJson(False)
+
+ Using producer As IProducer(Of String, String) = New ProducerBuilder(Of String, String)(cfg).Build()
+ Dim msg As New Message(Of String, String) With {
+ .key = key,
+ .Value = payload
+ }
+ Dim result = Await producer.ProduceAsync(TopicName, msg, ct)
+ ' Flush ist bei Await ProduceAsync nicht zwingend nötig, hier dennoch zur Sicherheit:
+ producer.Flush(TimeSpan.FromSeconds(5))
+ Return result
+ End Using
+ End Function
+
+ '========================
+ '== Sync-Wrapper (falls bevorzugt)
+ '========================
+ Public Shared Function InsertOrUpdateToKafka(ByVal record As cATEZ_Greenpulse_KafkaDecs) As DeliveryResult(Of String, String)
+ Return InsertOrUpdateToKafkaAsync(record).GetAwaiter().GetResult()
+ End Function
+
+ End Class
+
+End Namespace
diff --git a/VERAG_PROG_ALLGEMEIN/Schnittstellen/ATEZ/RELAYHUB/cRelayHub.vb b/VERAG_PROG_ALLGEMEIN/Schnittstellen/ATEZ/RELAYHUB/cRelayHub.vb
index d8100ade..c9392957 100644
--- a/VERAG_PROG_ALLGEMEIN/Schnittstellen/ATEZ/RELAYHUB/cRelayHub.vb
+++ b/VERAG_PROG_ALLGEMEIN/Schnittstellen/ATEZ/RELAYHUB/cRelayHub.vb
@@ -21,7 +21,6 @@ Public Class cRelayHub
Public Property declarationType As String
Public Property referenceNumberOverlay As String ' <--- NEU
Public Property username As String ' <--- NEU
-
End Class
Public Class cRelayHubDv1CostAllocation
@@ -110,57 +109,68 @@ Public Class cRelayHub
Public Class cRelayHub_sendToRelayHub_JobOrderRequest
- 'Shared API_KEY = "2a6fe6bf-6547-4d56-b14a-8a18f94f9e94"
- 'Shared API_URL = "dev-relayhub.singlewindow.io/api"
- Shared API_URL = "https://dev-relayhub.singlewindow.io/api/v1-0"
+ Shared API_URL As String = "https://dev-relayhub.singlewindow.io/api/v1-0"
+ ' Low-level Sender: holt Access-Token aus cRelayHubToken und sendet JSON
+ Private Shared Function SendJobOrder(jsonPayload As String) As Chilkat.HttpResponse
+ Dim http As New Chilkat.Http
+ http.SetRequestHeader("Accept", "application/json")
+
+ ' *** Token aus der separaten Token-Klasse beziehen ***
+ Dim token As String = cRelayHubToken.GetValidAccessToken()
+ http.AuthToken = token ' -> setzt Authorization: Bearer
+
+ Return http.PostJson2(API_URL & "/job-orders/init", "application/json", jsonPayload)
+ End Function
+
+ ' Public API: erstellt Job-Order mit 401-Retry
Public Shared Function query_declarations(request As cRelayHubJobOrderRequest) As cRelayHubApiResult
Dim result As New cRelayHubApiResult()
Try
- ' This example assumes the Chilkat API to have been previously unlocked.
- ' See Global Unlock Sample for sample code.
VERAG_PROG_ALLGEMEIN.cChilkat_Helper.UnlockCilkat()
- Dim success As Boolean
-
-
- ' HTTP-Client initialisieren
- Dim http As New Chilkat.Http
- ' JSON vorbereiten
-
- ' Request-Objekt in JSON-String umwandeln
Dim jsonPayload As String = JsonConvert.SerializeObject(request)
- ' MsgBox(jsonPayload)
-
- ' Größe in Bytes
- Dim payloadSizeBytes As Integer = System.Text.Encoding.UTF8.GetByteCount(jsonPayload)
-
- ' Größe in Kilobytes (1 KB = 1024 Bytes)
- Dim payloadSizeKb As Double = payloadSizeBytes / 1024.0
-
- Console.WriteLine("📦 Größe des JSON-Payload:")
- Console.WriteLine(payloadSizeBytes & " Bytes (" & Math.Round(payloadSizeKb, 2) & " KB)")
-
- ' Anfrage senden
- Dim response As Chilkat.HttpResponse = http.PostJson2(API_URL & "/job-orders/init", "application/json", jsonPayload)
- MsgBox(jsonPayload)
-
- Console.WriteLine(jsonPayload)
- If http.LastMethodSuccess <> True Then
- result.Success = False
- result.StatusCode = 0
- result.Message = "Verbindungsfehler"
- result.Details = http.LastErrorText
- Return result
+ ' 1. Versuch
+ Dim response As Chilkat.HttpResponse = SendJobOrder(jsonPayload)
+ If response Is Nothing Then
+ Return New cRelayHubApiResult With {
+ .Success = False, .StatusCode = 0, .Message = "Verbindungsfehler",
+ .Details = "Keine Antwort erhalten."
+ }
End If
- result.StatusCode = response.StatusCode
+ ' 401 → Token-Cache invalidieren und genau 1x erneut probieren
+ If response.StatusCode = 401 Then
+ ' WICHTIG:
+ ' Diese Methode sollte in cRelayHubToken als Public verfügbar sein:
+ ' Public Shared Sub ResetTokenCache() : ClearToken() : End Sub
+ ' → Falls noch nicht vorhanden, bitte dort ergänzen.
+ Try
+ cRelayHubToken.ResetTokenCache()
+ Catch
+ ' Falls die Methode (noch) nicht existiert, kann man als Fallback
+ ' hier eine kurze Wartezeit einbauen und anschließend erneut GetValidAccessToken() aufrufen.
+ ' Threading.Thread.Sleep(100)
+ End Try
+ ' Retry
+ response = SendJobOrder(jsonPayload)
+ If response Is Nothing Then
+ Return New cRelayHubApiResult With {
+ .Success = False, .StatusCode = 0, .Message = "Verbindungsfehler (nach Refresh)",
+ .Details = "Keine Antwort erhalten."
+ }
+ End If
+ End If
+
+ ' Auswertung
+ result.StatusCode = response.StatusCode
Select Case response.StatusCode
Case 201
Try
- Dim jobResponse As cRelayHubJobOrderResponse = JsonConvert.DeserializeObject(Of cRelayHubJobOrderResponse)(response.BodyStr)
+ Dim jobResponse As cRelayHubJobOrderResponse =
+ JsonConvert.DeserializeObject(Of cRelayHubJobOrderResponse)(response.BodyStr)
result.Success = True
result.Message = "Job Order erfolgreich erstellt"
result.Data = jobResponse
@@ -175,18 +185,12 @@ Public Class cRelayHub
Case 400 To 499
result.Success = False
result.Message = "Client-Fehler"
- result.Message = "StatusCode: " & response.StatusCode
- result.Details = "StatusLine: " & response.StatusLine
- result.Details = "StatusText: " & response.StatusText
- result.Details = "BodyStr: " & response.BodyStr
+ result.Details = response.BodyStr
Case 500 To 599
result.Success = False
result.Message = "Server-Fehler"
- result.Message = "StatusCode: " & response.StatusCode
- result.Details = "StatusLine: " & response.StatusLine
- result.Details = "StatusText: " & response.StatusText
- result.Details = "BodyStr: " & response.BodyStr
+ result.Details = response.BodyStr
Case Else
result.Success = False
@@ -194,19 +198,15 @@ Public Class cRelayHub
result.Details = response.BodyStr
End Select
- Console.WriteLine(result.Message)
- Console.WriteLine(result.Details)
-
Return result
-
Catch ex As Exception
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name)
-
+ Return New cRelayHubApiResult With {.Success = False, .StatusCode = 0, .Message = "Exception", .Details = ex.ToString()}
End Try
- Return Nothing
End Function
+ ' Beispielfall
Function CreateSampleJobOrderRequest() As cRelayHubJobOrderRequest
Dim request As New cRelayHubJobOrderRequest With {
.referenceNo = "1001K",
@@ -262,9 +262,8 @@ Public Class cRelayHub
}
}
}
-
Return request
End Function
End Class
-End Class
+End Class
\ No newline at end of file
diff --git a/VERAG_PROG_ALLGEMEIN/Schnittstellen/ATEZ/RELAYHUB/cRelayHubToken.vb b/VERAG_PROG_ALLGEMEIN/Schnittstellen/ATEZ/RELAYHUB/cRelayHubToken.vb
new file mode 100644
index 00000000..abfcd998
--- /dev/null
+++ b/VERAG_PROG_ALLGEMEIN/Schnittstellen/ATEZ/RELAYHUB/cRelayHubToken.vb
@@ -0,0 +1,245 @@
+Imports Newtonsoft.Json
+Imports System.IO
+Imports System.Text
+
+Public Class cRelayHubToken
+
+ ' === Token-Datenmodell ===
+ Private Class TokenState
+ Public AccessToken As String
+ Public RefreshToken As String
+ Public AccessExpiryUtc As DateTime
+ Public RefreshExpiryUtc As DateTime
+ End Class
+
+ ' === Keycloak-Config ===
+ Private Shared ReadOnly KC_BASE As String = "https://dev-kc.singlewindow.io"
+ Private Shared ReadOnly KC_TOKEN_PATH As String = "/auth/realms/agsw/protocol/openid-connect/token"
+ Private Shared ReadOnly KC_CLIENT_ID As String = "agsw-admin"
+ Private Shared ReadOnly KC_USERNAME As String = "andreas.test@test.com"
+ Private Shared ReadOnly KC_PASSWORD As String = "Password.123"
+ Private Shared ReadOnly SKEW As TimeSpan = TimeSpan.FromSeconds(30)
+
+ ' === Cache/Persistenz ===
+ Private Shared _ts As TokenState = Nothing
+ Private Shared ReadOnly TOKEN_FILE As String = Path.Combine(
+ Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData),
+ "RelayHub", "token.cache"
+ )
+ Private Shared ReadOnly _lockObj As New Object()
+
+ ' -------------- DPAPI via Reflection (keine Compile-Abhängigkeit!) --------------
+ Private Shared Function TryProtect(plain As Byte()) As Byte()
+ Try
+ ' Versuche: Typen aus Assembly "System.Security" oder aus aktuellen Laufzeit-Assemblys laden
+ Dim dpType As Type = Type.GetType("System.Security.Cryptography.ProtectedData, System.Security", throwOnError:=False)
+ If dpType Is Nothing Then
+ dpType = Type.GetType("System.Security.Cryptography.ProtectedData", throwOnError:=False)
+ End If
+ Dim scopeType As Type = Type.GetType("System.Security.Cryptography.DataProtectionScope, System.Security", throwOnError:=False)
+ If dpType Is Nothing OrElse scopeType Is Nothing Then Return Nothing
+
+ Dim scopeObj As Object = [Enum].Parse(scopeType, "CurrentUser")
+ Dim mi = dpType.GetMethod("Protect", New Type() {GetType(Byte()), GetType(Byte()), scopeType})
+ If mi Is Nothing Then Return Nothing
+
+ Dim res = mi.Invoke(Nothing, New Object() {plain, Nothing, scopeObj})
+ Return TryCast(res, Byte())
+ Catch
+ Return Nothing
+ End Try
+ End Function
+
+ Private Shared Function TryUnprotect(protectedBytes As Byte()) As Byte()
+ Try
+ Dim dpType As Type = Type.GetType("System.Security.Cryptography.ProtectedData, System.Security", throwOnError:=False)
+ If dpType Is Nothing Then
+ dpType = Type.GetType("System.Security.Cryptography.ProtectedData", throwOnError:=False)
+ End If
+ Dim scopeType As Type = Type.GetType("System.Security.Cryptography.DataProtectionScope, System.Security", throwOnError:=False)
+ If dpType Is Nothing OrElse scopeType Is Nothing Then Return Nothing
+
+ Dim scopeObj As Object = [Enum].Parse(scopeType, "CurrentUser")
+ Dim mi = dpType.GetMethod("Unprotect", New Type() {GetType(Byte()), GetType(Byte()), scopeType})
+ If mi Is Nothing Then Return Nothing
+
+ Dim res = mi.Invoke(Nothing, New Object() {protectedBytes, Nothing, scopeObj})
+ Return TryCast(res, Byte())
+ Catch
+ Return Nothing
+ End Try
+ End Function
+
+ ' -------------- Persistenz: bevorzugt DPAPI, Fallback Plain-File --------------
+ Private Shared Sub SaveTokenSecure(ts As TokenState)
+ Try
+ Dim dir = Path.GetDirectoryName(TOKEN_FILE)
+ If Not Directory.Exists(dir) Then Directory.CreateDirectory(dir)
+
+ Dim payload As String = String.Join(vbLf, {
+ ts.AccessToken,
+ ts.RefreshToken,
+ ts.AccessExpiryUtc.Ticks.ToString(),
+ ts.RefreshExpiryUtc.Ticks.ToString()
+ })
+ Dim plain = Encoding.UTF8.GetBytes(payload)
+
+ Dim protectedBytes = TryProtect(plain)
+ If protectedBytes IsNot Nothing Then
+ File.WriteAllBytes(TOKEN_FILE, protectedBytes)
+ Else
+ ' Fallback (nur zu Testzwecken!)
+ File.WriteAllText(TOKEN_FILE, payload, Encoding.UTF8)
+ End If
+ Catch
+ ' optional loggen
+ End Try
+ End Sub
+
+ Private Shared Function LoadTokenSecure() As TokenState
+ Try
+ If Not File.Exists(TOKEN_FILE) Then Return Nothing
+
+ ' Zuerst versuchen wir, als DPAPI-Bytes zu lesen und zu entschlüsseln
+ Dim raw = File.ReadAllBytes(TOKEN_FILE)
+ Dim plain = TryUnprotect(raw)
+
+ Dim content As String
+ If plain Is Nothing Then
+ ' Fallback: als Text lesen (falls zuvor ohne DPAPI gespeichert)
+ content = File.ReadAllText(TOKEN_FILE, Encoding.UTF8)
+ Else
+ content = Encoding.UTF8.GetString(plain)
+ End If
+
+ Dim s = content.Split({vbLf}, StringSplitOptions.None)
+ If s.Length < 4 Then Return Nothing
+ Return New TokenState With {
+ .AccessToken = s(0),
+ .RefreshToken = s(1),
+ .AccessExpiryUtc = New DateTime(Long.Parse(s(2)), DateTimeKind.Utc),
+ .RefreshExpiryUtc = New DateTime(Long.Parse(s(3)), DateTimeKind.Utc)
+ }
+ Catch
+ Return Nothing
+ End Try
+ End Function
+
+ Private Shared Sub ClearToken()
+ SyncLock _lockObj
+ _ts = Nothing
+ Try
+ If File.Exists(TOKEN_FILE) Then File.Delete(TOKEN_FILE)
+ Catch
+ End Try
+ End SyncLock
+ End Sub
+
+ ' -------------- Utilities --------------
+ Private Shared Function UtcNow() As DateTime
+ Return DateTime.UtcNow
+ End Function
+
+ Private Shared Function IsAccessValid(ts As TokenState) As Boolean
+ Return ts IsNot Nothing AndAlso Not String.IsNullOrEmpty(ts.AccessToken) AndAlso UtcNow() < ts.AccessExpiryUtc - SKEW
+ End Function
+
+ Private Shared Function IsRefreshValid(ts As TokenState) As Boolean
+ Return ts IsNot Nothing AndAlso Not String.IsNullOrEmpty(ts.RefreshToken) AndAlso UtcNow() < ts.RefreshExpiryUtc - SKEW
+ End Function
+
+ ' -------------- OAuth Flows --------------
+ Private Shared Function PasswordLogin() As TokenState
+ Dim http As New Chilkat.Http
+ Dim req As New Chilkat.HttpRequest
+ req.HttpVerb = "POST"
+ req.Path = KC_TOKEN_PATH
+ req.AddParam("grant_type", "password")
+ req.AddParam("username", KC_USERNAME)
+ req.AddParam("password", KC_PASSWORD)
+ req.AddParam("client_id", KC_CLIENT_ID)
+ req.AddParam("scope", "openid offline_access")
+ req.AddHeader("Content-Type", "application/x-www-form-urlencoded")
+
+ Dim resp = http.PostUrlEncoded(KC_BASE, req)
+ If resp Is Nothing Then Throw New Exception("Token-Request fehlgeschlagen: " & http.LastErrorText)
+ If resp.StatusCode <> 200 Then Throw New Exception("Password-Grant fehlgeschlagen: " & resp.StatusCode & " - " & resp.BodyStr)
+
+ Dim json As New Chilkat.JsonObject : json.Load(resp.BodyStr)
+ Dim access = json.StringOf("access_token")
+ Dim refresh = json.StringOf("refresh_token")
+ Dim exp = Math.Max(60, json.IntOf("expires_in"))
+ Dim rexp = Math.Max(300, json.IntOf("refresh_expires_in"))
+
+ Dim ts = New TokenState With {
+ .AccessToken = access,
+ .RefreshToken = refresh,
+ .AccessExpiryUtc = UtcNow().AddSeconds(exp),
+ .RefreshExpiryUtc = UtcNow().AddSeconds(rexp)
+ }
+ SaveTokenSecure(ts)
+ Return ts
+ End Function
+
+ Private Shared Function RefreshLogin(oldTs As TokenState) As TokenState
+ If oldTs Is Nothing OrElse String.IsNullOrEmpty(oldTs.RefreshToken) Then
+ Throw New Exception("Kein gültiger Refresh-Token vorhanden.")
+ End If
+
+ Dim http As New Chilkat.Http
+ Dim req As New Chilkat.HttpRequest
+ req.HttpVerb = "POST"
+ req.Path = KC_TOKEN_PATH
+ req.AddParam("grant_type", "refresh_token")
+ req.AddParam("refresh_token", oldTs.RefreshToken)
+ req.AddParam("client_id", KC_CLIENT_ID)
+ req.AddHeader("Content-Type", "application/x-www-form-urlencoded")
+
+ Dim resp = http.PostUrlEncoded(KC_BASE, req)
+ If resp Is Nothing Then Throw New Exception("Refresh-Request fehlgeschlagen: " & http.LastErrorText)
+ If resp.StatusCode <> 200 Then Throw New Exception("Refresh fehlgeschlagen: " & resp.StatusCode & " - " & resp.BodyStr)
+
+ Dim json As New Chilkat.JsonObject : json.Load(resp.BodyStr)
+ Dim access = json.StringOf("access_token")
+ Dim refresh = json.StringOf("refresh_token") ' Rotation beachten
+ Dim exp = Math.Max(60, json.IntOf("expires_in"))
+ Dim rexp = Math.Max(300, json.IntOf("refresh_expires_in"))
+
+ Dim ts = New TokenState With {
+ .AccessToken = access,
+ .RefreshToken = refresh,
+ .AccessExpiryUtc = UtcNow().AddSeconds(exp),
+ .RefreshExpiryUtc = UtcNow().AddSeconds(rexp)
+ }
+ SaveTokenSecure(ts)
+ Return ts
+ End Function
+
+ ' -------------- Public API --------------
+ Public Shared Function GetValidAccessToken() As String
+ SyncLock _lockObj
+ If _ts Is Nothing Then _ts = LoadTokenSecure()
+
+ If IsAccessValid(_ts) Then
+ Return _ts.AccessToken
+ End If
+
+ If IsRefreshValid(_ts) Then
+ Try
+ _ts = RefreshLogin(_ts)
+ Return _ts.AccessToken
+ Catch
+ ' fällt durch auf PasswordLogin
+ End Try
+ End If
+
+ _ts = PasswordLogin()
+ Return _ts.AccessToken
+ End SyncLock
+ End Function
+
+ Public Shared Sub ResetTokenCache()
+ ClearToken()
+ End Sub
+
+End Class
\ No newline at end of file
diff --git a/VERAG_PROG_ALLGEMEIN/VERAG_PROG_ALLGEMEIN.vbproj b/VERAG_PROG_ALLGEMEIN/VERAG_PROG_ALLGEMEIN.vbproj
index 7f3feeb3..05d0a2f3 100644
--- a/VERAG_PROG_ALLGEMEIN/VERAG_PROG_ALLGEMEIN.vbproj
+++ b/VERAG_PROG_ALLGEMEIN/VERAG_PROG_ALLGEMEIN.vbproj
@@ -392,6 +392,7 @@
Form
+