Fiskaltrust, Automailversand, etc.

This commit is contained in:
2026-06-19 17:13:38 +02:00
parent cb02f2ac14
commit 123f06f3b1
11 changed files with 1029 additions and 96 deletions

View File

@@ -702,7 +702,7 @@ Public Class cFiskaltrustClient
End Function
Public Function getVersion(Terminal_ID) As String
Private Function getVersion(Terminal_ID) As String
Return Terminal_ID & "_" & Application.ProductVersion

View File

@@ -0,0 +1,402 @@

Imports System.Data.SqlClient
Imports System.Reflection
Imports Chilkat
Imports Newtonsoft.Json
Public Class cFiskaltrustClient_chilkat
Private ReadOnly _baseUrl As String
Private ReadOnly _cashboxId As String
Private ReadOnly _accessToken As String
Private ReadOnly _country As String
Public Sub New(baseUrl As String, cashboxId As String, accessToken As String, country As String)
_baseUrl = baseUrl.TrimEnd("/"c)
_cashboxId = cashboxId
_accessToken = accessToken
_country = country
End Sub
Public Function SignReceipt(amount As Decimal, vat As Decimal, POS As List(Of EABelegPositionen), kindOfPayment As String, posSystemId As String) As String
Dim payload As JsonObject = BuildPayloadReceipt(amount, vat, POS, kindOfPayment, posSystemId)
Return SendChilkat(GetEndpoint("payment"), payload.Emit())
End Function
Public Function SignReceipt_test(posSystemId As String) As String
Dim LIST = New List(Of EABelegPositionen)
Dim p = New EABelegPositionen
p.Mandant = "VERA"
p.Niederlassung = "SUB"
p.Benutzer = 74
p.BelegDat = Now
p.BelegNr = 1
p.PreislistenNr = 1
p.PreislistenPos = 1
p.LeistungsNr = 300
p.LeistungsBez = "TEST"
p.Preis = 10
p.Anzahl = 1
LIST.Add(p)
Dim amount = 100
Dim vat = 0
Dim POS = LIST
Dim kindOfPayment = "Cash"
Dim payload As JsonObject = BuildPayloadReceipt(amount, vat, POS, kindOfPayment, posSystemId)
Return SendChilkat(GetEndpoint("payment"), payload.Emit())
End Function
Public Function SignNullReceipt(posSystemId As String) As String
Return SendChilkat(GetEndpoint("payment"), BuildPayloadNullReceipt(posSystemId, _country).Emit())
End Function
Public Function SignClosingReceipt(receiptType As String, posSystemId As String) As String
Return SendChilkat(GetEndpoint("payment"), BuildPayloadClosingReceipt(receiptType, posSystemId).Emit())
End Function
Public Function Echo(kassenName As String) As String
Dim json As New JsonObject()
json.UpdateString("Message", kassenName & " - VERBINDUNG OK")
Return SendChilkat(GetEndpoint("test"), json.Emit())
End Function
Public Function Journal(Optional typ As String = "") As String
Dim endpoint = GetEndpoint("journal")
If typ <> "" Then endpoint &= "?type=" & typ
Return SendChilkat(endpoint, "", True)
End Function
Private Function SendChilkat(endpoint As String, payload As String, Optional isGet As Boolean = False) As String
Dim retries As Integer = 3
Dim lastEx As Exception = Nothing
VERAG_PROG_ALLGEMEIN.cChilkat_Helper.UnlockCilkat()
Dim rest As New Chilkat.Rest
Dim failureDesc As String
rest.VerboseLogging = True
For i As Integer = 1 To retries
Try
Dim uri As New Uri(_baseUrl)
If Not rest.Connect(uri.Host, uri.Port, uri.Scheme = "https", True) Then
Throw New Exception(rest.LastErrorText)
failureDesc = rest.LastErrorText
Return failureDesc
End If
rest.AddHeader("cashboxid", _cashboxId)
rest.AddHeader("accesstoken", _accessToken)
Dim response As String
If isGet Then
response = rest.FullRequestNoBody("GET", uri.AbsoluteUri & endpoint)
Else
If _country = "AT" Then
rest.AddHeader("Content-Type", "text/plain")
response = rest.FullRequestString("POST", uri.AbsoluteUri & endpoint, payload)
Else
rest.AddHeader("Content-Type", "application/json")
response = rest.FullRequestString("POST", uri.AbsoluteUri & endpoint, payload)
End If
End If
If rest.ResponseStatusCode >= 200 AndAlso rest.ResponseStatusCode < 300 Then
Return response
Else
failureDesc = rest.LastErrorText
End If
Throw New Exception("HTTP " & rest.ResponseStatusCode & ": " & response)
Catch ex As Exception
lastEx = ex
Threading.Thread.Sleep(500)
End Try
Next
Throw lastEx
End Function
Private Function BuildPayloadReceipt(amount As Decimal, vat As Decimal, POS As List(Of EABelegPositionen), kindOfPayment As String, posSystemId As String) As JsonObject
Dim json As New JsonObject()
json.UpdateString("ftCashBoxID", _cashboxId)
json.UpdateString("ftPosSystemId", getVersion(posSystemId))
json.UpdateString("cbTerminalID", posSystemId)
json.UpdateString("cbReceiptReference", Guid.NewGuid().ToString())
json.UpdateString("cbReceiptMoment", DateTime.UtcNow.ToString("o"))
json.UpdateString("ftReceiptCase", 4919338172267102209)
Dim chargeItems = json.AppendArray("cbChargeItems")
For Each p In POS
If chargeItems.AddObjectAt(-1) Then
Dim item As Chilkat.JsonObject = chargeItems.ObjectAt(chargeItems.Size - 1)
item.UpdateInt("Quantity", p.Anzahl)
item.UpdateNumber("Amount", p.Preis.ToString().Replace(",", "."))
item.UpdateNumber("VATRate", vat.ToString().Replace(",", "."))
item.UpdateString("Description", p.LeistungsBez)
item.UpdateString("ftChargeItemCase", 4919338167972134929)
End If
Next
Dim payItems = json.AppendArray("cbPayItems")
payItems.AddObjectAt(-1)
Dim pay As Chilkat.JsonObject = payItems.ObjectAt(payItems.Size - 1)
pay.UpdateInt("Quantity", 1)
pay.UpdateNumber("Amount", amount.ToString().Replace(",", "."))
pay.UpdateString("Description", kindOfPayment)
pay.UpdateString("ftPayItemCase", 4919338167972134913)
Return json
End Function
Private Function BuildPayloadNullReceipt(posSystemId As String, country As String) As JsonObject
Dim json As New JsonObject()
json.UpdateString("ftCashBoxID", _cashboxId)
json.UpdateString("ftPosSystemId", getVersion(posSystemId))
json.UpdateString("cbTerminalID", posSystemId)
json.UpdateString("cbReceiptMoment", DateTime.UtcNow.ToString("o"))
Return json
End Function
Private Function BuildPayloadClosingReceipt(receiptType As String, posSystemId As String) As JsonObject
Dim json As New JsonObject()
json.UpdateString("ftCashBoxID", _cashboxId)
json.UpdateString("ftPosSystemId", getVersion(posSystemId))
json.UpdateString("cbTerminalID", posSystemId)
Return json
End Function
Private Function GetEndpoint(type As String) As String
Select Case type
Case "payment"
Select Case _country
Case "DE" : Return "/json/v1/Sign"
Case "AT" : Return "/json/Sign"
End Select
Case "test"
Select Case _country
Case "DE" : Return "/json/v1/Echo"
Case "AT" : Return "/json/Echo"
End Select
Case "journal"
Select Case _country
Case "DE" : Return "/json/v0/Journal"
Case "AT" : Return "/json/Journal"
End Select
End Select
Throw New Exception("Unsupported country")
End Function
Private Function getVersion(Terminal_ID As String) As String
Return Terminal_ID & "_" & Application.ProductVersion
End Function
Public Function saveRKSV_FT(ByRef result_zahlung As String, ByRef QR_CodeString As String) As Boolean
If result_zahlung <> "" Then
Dim json As New Chilkat.JsonObject
Dim success As Boolean = json.Load(result_zahlung)
If (success <> True) Then
Debug.WriteLine(json.LastErrorText)
Return False
End If
Dim saved As Boolean = False
Dim ftSig As New cFiskaltrustSignatures()
Dim ftReceiptMoment As New Chilkat.CkDateTime
Dim dt As New Chilkat.DtObj
Dim getAsLocal As Boolean = False
Dim ftID As Integer = -1
success = json.DateOf("ftReceiptMoment", ftReceiptMoment)
Debug.WriteLine(ftReceiptMoment.GetAsTimestamp(getAsLocal))
With ftSig
.ftCashBoxID = json.StringOf("ftCashBoxID")
.ftQueueID = json.StringOf("ftQueueID")
.ftQueueItemID = json.StringOf("ftQueueItemID")
.ftQueueRow = json.IntOf("ftQueueRow")
.cbTerminalID = json.StringOf("cbTerminalID")
.cbReceiptReference = json.StringOf("cbReceiptReference")
.ftCashBoxIdentification = json.StringOf("ftCashBoxIdentification")
.ftReceiptIdentification = json.StringOf("ftReceiptIdentification")
.ftReceiptMoment = ftReceiptMoment.GetAsTimestamp(getAsLocal)
.ftState = json.StringOf("ftState")
saved = .SAVE()
End With
Dim num As Integer = json.SizeOfArray("ftSignatures")
If num = 0 Then
Return False
End If
Dim Signatures As Chilkat.JsonArray = json.ArrayOf("ftSignatures")
If (json.LastMethodSuccess = False) Then
Return False
End If
Dim numSignatures As Integer = Signatures.Size
For i = 0 To numSignatures - 1
Dim SignObj As Chilkat.JsonObject = Signatures.ObjectAt(i)
Dim ftSigPos As New cFiskaltrustSignaturPositions()
With ftSigPos
.ftSignatures = ftSig.ft_id
.ftData = SignObj.StringOf("Data")
.ftSignatureFormat = SignObj.StringOf("ftSignatureFormat")
.ftSignatureType = SignObj.StringOf("ftSignatureType")
saved = .SAVE()
If IsNumeric(.ftSignatureType) AndAlso CInt(.ftSignatureType) = IIf(VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM = True, 0, 3) Then
'QR_CodeString = .ftData
End If
End With
Next
Return saved
End If
End Function
Public Function exportJournal(ByRef result_Journal As String) As Boolean
If result_Journal <> "" Then
Dim jsonArr As New Chilkat.JsonArray
Dim success As Boolean = jsonArr.Load(result_Journal)
If (success <> True) Then
Debug.WriteLine(jsonArr.LastErrorText)
Return False
End If
Dim dt As New DataTable
dt.Columns.Add("ftReceiptJournalId", GetType(String))
dt.Columns.Add("ftReceiptMoment", GetType(String))
dt.Columns.Add("ftReceiptNumber", GetType(String))
dt.Columns.Add("ftReceiptTotal", GetType(String))
dt.Columns.Add("ftQueueId", GetType(String))
dt.Columns.Add("ftReceiptHash", GetType(String))
dt.Columns.Add("ftQueueItemId", GetType(String))
dt.Columns.Add("TimeStamp", GetType(String))
Dim i = 0
Dim num As Integer = jsonArr.Size
If num = 0 Then
Return False
End If
Dim tmstmp As New Chilkat.CkDateTime
Dim getAsLocal As Boolean = False
While i < num
Dim SignObj As Chilkat.JsonObject = jsonArr.ObjectAt(i)
Dim R As DataRow = dt.NewRow
With SignObj
R("ftReceiptJournalId") = .StringOf("ftReceiptJournalId")
R("ftReceiptMoment") = .StringOf("ftReceiptMoment")
R("ftReceiptNumber") = .IntOf("ftReceiptNumber")
R("ftReceiptTotal") = .StringOf("ftReceiptTotal")
R("ftQueueId") = .StringOf("ftQueueId")
R("ftQueueItemId") = .StringOf("ftQueueItemId")
R("ftReceiptHash") = .StringOf("ftReceiptHash")
R("TimeStamp") = tmstmp.GetAsTimestamp(getAsLocal)
End With
dt.Rows.Add(R)
i = i + 1
End While
If dt.Rows.Count > 0 Then
Dim Path = VERAG_PROG_ALLGEMEIN.cProgramFunctions.genExcelFromDT_NEW(dt)
End If
End If
End Function
Private Sub Log(message As String)
Console.WriteLine(message)
End Sub
End Class

View File

@@ -92,7 +92,7 @@ Public Class cRKSV
End Function
Shared Async Function insertRKSVFiskaltrustAsync(ByVal kasse As cRKSV_Kasse, CompanyGUID As String, ByVal umsatzZaehler As Double, ByVal belegDat As DateTime, ByVal steuerSchluessel As Integer, ByVal RKSV_Beleg_Id As Integer, ByVal summeBRUTTO As Double, TEST As Boolean, POS As List(Of EABelegPositionen), QR_CodeString As String, LastJWS As String) As Task(Of Boolean)
Shared Function insertRKSVFiskaltrustAsync(ByVal kasse As cRKSV_Kasse, CompanyGUID As String, ByVal umsatzZaehler As Double, ByVal belegDat As DateTime, ByVal steuerSchluessel As Integer, ByVal RKSV_Beleg_Id As Integer, ByVal summeBRUTTO As Double, TEST As Boolean, POS As List(Of EABelegPositionen), ByRef QR_CodeString As String, ByRef LastJWS As String) As Boolean
Try
@@ -123,21 +123,35 @@ Public Class cRKSV
Dim BetragSatzBesonders = IIf(steuersatz = 0.19, summeBRUTTO, 0.0)
Dim StandUmsatzzaehler = umsatzZaehler 'KASSE.rksv_Umsatzzaehler
Dim client As New cFiskaltrustClient(kasse.rksv_FT_RestServiceURL, kasse.rksv_FT_CashboxID, kasse.rksv_FT_AccessToken, kasse.rksv_FT_Country)
If False Then
'Dim client As New cFiskaltrustClient(kasse.rksv_FT_RestServiceURL, kasse.rksv_FT_CashboxID, kasse.rksv_FT_AccessToken, kasse.rksv_FT_Country)
Dim result = Await client.SignReceiptAsync(summeBRUTTO, steuersatz, POS, "Cash", kasse.rksv_id)
If result <> "" Then
Return client.saveRKSV_FT(result, QR_CodeString)
'Dim result = Await client.SignReceiptAsync(summeBRUTTO, steuersatz, POS, "Cash", kasse.rksv_id)
'If result <> "" Then
' Return client.saveRKSV_FT(result, QR_CodeString)
'Else
' Return False
'End If
Else
Return False
Dim client As New cFiskaltrustClient_chilkat(kasse.rksv_FT_RestServiceURL, kasse.rksv_FT_CashboxID, kasse.rksv_FT_AccessToken, kasse.rksv_FT_Country)
Dim result = client.SignReceipt(summeBRUTTO, steuersatz, POS, "Cash", kasse.rksv_id)
If result <> "" Then
Return client.saveRKSV_FT(result, QR_CodeString)
Else
Return False
End If
End If
Catch ex As Exception
MsgBox("Es ist ein Fehler bei der Signatur aufgetreten (insertRKSV): " & vbNewLine & ex.Message & ex.StackTrace)
Return False
Return False
End Try
End Function