From c126b4a064133f58eb8d87fe4f7009a1178d484b Mon Sep 17 00:00:00 2001 From: Andreas Luxbauer Date: Thu, 28 Aug 2025 13:20:16 +0200 Subject: [PATCH] Kopf-Sammelabrechnung --- SDL/Fakturierung/cFakturierung.vb | 54 ++- .../usrCntlFaktAbrechnung.Designer.vb | 37 ++- SDL/Fakturierung/usrCntlFaktAbrechnung.vb | 45 +++ .../usrcntlKundeBearbeitenFull.Designer.vb | 16 +- SDL/kunden/usrcntlKundeBearbeitenFull.vb | 2 + .../Classes/cKundenErweitert.vb | 2 + .../Classes/cRechnungsausgang.vb | 63 ++-- .../GREENPULSE/cATEZ_Greenpulse_KafkaDecs.vb | 311 ++++++++++++++++++ .../Schnittstellen/ATEZ/RELAYHUB/cRelayHub.vb | 107 +++--- .../ATEZ/RELAYHUB/cRelayHubToken.vb | 245 ++++++++++++++ .../VERAG_PROG_ALLGEMEIN.vbproj | 1 + 11 files changed, 788 insertions(+), 95 deletions(-) create mode 100644 VERAG_PROG_ALLGEMEIN/Schnittstellen/ATEZ/GREENPULSE/cATEZ_Greenpulse_KafkaDecs.vb create mode 100644 VERAG_PROG_ALLGEMEIN/Schnittstellen/ATEZ/RELAYHUB/cRelayHubToken.vb 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 +