From e4e8f1e46ca16d6800471f1b3a06ad13c843c7f2 Mon Sep 17 00:00:00 2001 From: "d.breimaier" Date: Fri, 5 Sep 2025 16:53:39 +0200 Subject: [PATCH] creditsafe-API --- .../Creditsafe/cCreditSafeAPI.vb | 202 ++++++++++++++++-- 1 file changed, 188 insertions(+), 14 deletions(-) diff --git a/VERAG_PROG_ALLGEMEIN/Schnittstellen/Creditsafe/cCreditSafeAPI.vb b/VERAG_PROG_ALLGEMEIN/Schnittstellen/Creditsafe/cCreditSafeAPI.vb index 8d03854c..3e276e57 100644 --- a/VERAG_PROG_ALLGEMEIN/Schnittstellen/Creditsafe/cCreditSafeAPI.vb +++ b/VERAG_PROG_ALLGEMEIN/Schnittstellen/Creditsafe/cCreditSafeAPI.vb @@ -8,6 +8,8 @@ Imports System.Runtime.InteropServices.ComTypes Imports System.Text.RegularExpressions Imports System.Threading Imports System.Web.UI +Imports com.sun.org.apache.xalan.internal.xsltc +Imports com.sun.source.tree Imports Microsoft.VisualBasic.ApplicationServices Imports Org.BouncyCastle.Ocsp @@ -144,23 +146,21 @@ Public Class cCreditSafeAPI Dim responseJson As String Dim pdfData As New Chilkat.BinData + rest.VerboseLogging = 1 + If isMonitoring Then If csvImport Then + Dim fileInfo As New FileInfo(csvFile) Dim content As String = File.ReadAllText(csvFile) - 'content = content.Replace(";", ",") - 'File.WriteAllText(csvFile, content) - Dim fileStream As New Chilkat.Stream fileStream.SourceFile = csvFile rest.PartSelector = "1" - - rest.AddHeader("Content-Disposition", "form-data; name=""importcsv""") - rest.AddHeader("Content-Type", "file") - 'rest.SetMultipartBodyString(content) + rest.AddHeader("Content-Disposition", "form-data; name=""importcsv""; filename=""importcsv.csv""") + rest.AddHeader("Content-Type", "text/csv") rest.SetMultipartBodyStream(fileStream) rest.PartSelector = "0" @@ -265,7 +265,6 @@ Public Class cCreditSafeAPI failureDesc = rest.ResponseStatusText & IIf(responseJson <> "", vbNewLine & responseJson, "") Return failureDesc Else - Return responseJson End If End If @@ -281,6 +280,44 @@ Public Class cCreditSafeAPI End Function + Shared Sub test(csvFile As String) + + + + ' Note: The above code does not need to be repeatedly called for each REST request. + ' The rest object can be setup once, and then many requests can be sent. Chilkat will automatically + ' reconnect within a FullRequest* method as needed. It is only the very first connection that is explicitly + ' made via the Connect method. + + rest.PartSelector = "1" + Dim fileStream1 As New Chilkat.Stream + fileStream1.SourceFile = csvFile + rest.AddHeader("Content-Disposition", "form-data; name=""importcsv""; filename=" & csvFile & "") + rest.AddHeader("Content-Type", "text/csv") + rest.SetMultipartBodyStream(fileStream1) + + rest.PartSelector = "0" + rest.AddHeader("Content-Type", "multipart/form-data") + + Dim strResponseBody As String = rest.FullRequestMultipart("POST", "/v1/monitoring/portfolios/1662419/import") + If (rest.LastMethodSuccess <> True) Then + Debug.WriteLine(rest.LastErrorText) + + End If + + Dim respStatusCode As Integer = rest.ResponseStatusCode + Debug.WriteLine("response status code = " & respStatusCode) + If (respStatusCode >= 400) Then + Debug.WriteLine("Response Status Code = " & respStatusCode) + Debug.WriteLine("Response Header:") + Debug.WriteLine(rest.ResponseHeader) + Debug.WriteLine("Response Body:") + Debug.WriteLine(strResponseBody) + + End If + + + End Sub @@ -321,6 +358,27 @@ Public Class cCreditSafeAPI End Function + Shared Function GetCompaniesFromPortfolio(ByRef totalCount As Integer, Optional PortfolioID As String = "1662419") As String + + Dim myUri As String = API_STRING & "/v1/monitoring/portfolios/" & PortfolioID & "/companies" 'Default + + Dim jsonRespString = SendGetRequestWithAuthHeader(myUri, Nothing, "application/json", "GET", token, "", False) + + Dim json As New Chilkat.JsonObject + Dim success As Boolean = json.Load(jsonRespString) + + + If IsNumeric(json.StringOf("totalCount")) Then + totalCount = CInt(json.StringOf("totalCount")) + Else + totalCount = -1 + End If + + + Return jsonRespString + + End Function + Shared Function searchCompanies(company As Company, ByRef dataTable As DataTable) As String @@ -420,14 +478,22 @@ Public Class cCreditSafeAPI End Function - Shared Function getCompanyEvents(company As Company, ByRef dtEvents As DataTable, Optional checklastChecked As Boolean = False, Optional updateKunden As Boolean = False, Optional showError As Boolean = False) As String + Shared Function getCompanyEvents(company As Company, ByRef dtEvents As DataTable, Optional checklastChecked As Boolean = False, Optional updateKunden As Boolean = False, Optional showError As Boolean = False, Optional getTotalNr As Boolean = False, Optional setzeKundenbesonderheiten As Boolean = False, Optional sendMail As Boolean = False) As String VERAG_PROG_ALLGEMEIN.cChilkat_Helper.UnlockCilkat() 'rest.AddQueryParam("from", Today().AddDays(-1)) + Dim checkDate As String = "" + + If company IsNot Nothing AndAlso IsDate(company.lastChecked) Then + checkDate = company.lastChecked.ToString("yyyy-MM-ddTHH:mm:ss") + Else + checkDate = Today().AddDays(-30).ToString("yyyy-MM-ddTHH:mm:ss") + End If + Dim failureDesc As String - Dim myUrl As String = API_STRING & "/v1/monitoring/companies/" & company.creditSafeId & "/events" & IIf(checklastChecked, "?startDate=" & company.lastChecked.ToString("yyyy-MM-ddTHH:mm:ss"), "") + Dim myUrl As String = API_STRING & "/v1/monitoring/companies/" & company.creditSafeId & "/events" & IIf(checklastChecked, "?startDate=" & checkDate, "") Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, company, "application/json", "GET", token, failureDesc) If failureDesc <> "" Then @@ -458,7 +524,7 @@ Public Class cCreditSafeAPI dtEvents.Rows.Clear() Dim num As Integer = json.SizeOfArray("data") - If num = 0 Then + If num = 0 OrElse getTotalNr Then Return json.StringOf("totalCount") End If @@ -596,9 +662,13 @@ Public Class cCreditSafeAPI 'viewEvents = New DataView(dtEvents, "localEventCode IN ('CL','CR') or e.globalEventCode IN ('CL','CR')", "", DataViewRowState.CurrentRows) End If - If company.kdNr > 0 AndAlso updateKunden AndAlso (CR <> -1000000 Or CL <> -1000000) Then + Dim triggerMail As Boolean = False + + If company.kdNr > 0 AndAlso (CR <> -1000000 Or CL <> -1000000) Then Dim KUNDE As New cKunde(company.kdNr) + Dim Mailtext As String = "" + If KUNDE.Bonitätsdatum <= CL_Datum Or KUNDE.Bonitätsdatum <= CR_Datum Then Dim Index As Double = -1 @@ -615,12 +685,14 @@ Public Class cCreditSafeAPI If Index <> -1 Then If KUNDE_ERW.kde_CreditSaveBonitaetsIndex <> Index Then + createInfo("B-INDEX", KUNDE_ERW, KUNDE, Index, riskClass, Mailtext, triggerMail, setzeKundenbesonderheiten) KUNDE_ERW.kde_CreditSaveBonitaetsIndex = Index KUNDE_ERW.kde_CreditSaveBonitaetsklasse = riskClass KUNDE.Bonitätsdatum = Today() End If Else If KUNDE_ERW.kde_CreditSaveBonitaetsScore <> CR AndAlso CR <> defaultCR Then + createInfo("B-SCORE", KUNDE_ERW, KUNDE, CR, riskClass, Mailtext, triggerMail, setzeKundenbesonderheiten) KUNDE_ERW.kde_CreditSaveBonitaetsScore = CR KUNDE_ERW.kde_CreditSaveBonitaetsklasse = riskClass KUNDE.Bonitätsdatum = Today() @@ -628,16 +700,21 @@ Public Class cCreditSafeAPI End If If KUNDE.Höchstkredit <> CL AndAlso CL <> defaultCL Then + createInfo("KREDITLIMIT", KUNDE_ERW, KUNDE, CL, riskClass, Mailtext, triggerMail, setzeKundenbesonderheiten) KUNDE.Höchstkredit = CL If KUNDE.Bonitätsdatum <= CDate(CL_Datum) Then KUNDE.Bonitätsdatum = Today() End If End If - KUNDE_ERW.SAVE() + If updateKunden Then KUNDE_ERW.SAVE() End If - KUNDE.SAVE() + If updateKunden Then KUNDE.SAVE() + + If triggerMail AndAlso sendMail Then + VERAG_PROG_ALLGEMEIN.cProgramFunctions.sendMail("as@verag.ag", IIf(VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM, "TEST-", "") & "CREDITSAFE " & KUNDE.KundenNr, "Änderungen der Creditsafe-Daten" & vbNewLine & vbNewLine & vbNewLine & Mailtext.ToString & vbNewLine & vbNewLine & vbNewLine & "*Automatic generated e-mail*",,,,, "d.breimaier@verag.ag") + End If End If @@ -1126,6 +1203,103 @@ Public Class cCreditSafeAPI End Select End Function + Shared Sub createInfo(typ As String, kundeErw As cKundenErweitert, kunde As cKunde, newValue As Object, risikoklasse As String, ByRef mailText As String, ByRef triggerMail As Boolean, setzeKundeninfo As Boolean) + + Dim createInfo As Boolean = False + + If newValue Is Nothing OrElse Not IsNumeric(newValue) Then + Exit Sub + End If + Dim defaultOldValue As Double = -1000000 + Dim oldValue As Double = defaultOldValue + Dim oldRiksClass = IIf(Not kundeErw.kde_CreditSaveBonitaetsklasse Is Nothing, kundeErw.kde_CreditSaveBonitaetsklasse, "") + + Dim infoAbxProzentVerschlechertung As Double = -25 + Dim infoAbxProzentVerschlechertungMailInfo As Double = -50 + + Dim changedInProzent As Double = 0 + + + + Select Case typ + Case "B-INDEX" + oldValue = kundeErw.kde_CreditSaveBonitaetsIndex + 'LIMITs DEFINIEREN + + If Not (oldValue = defaultOldValue) Then + changedInProzent = calcChange(oldValue, newValue) + End If + + If changedInProzent < Math.Abs(infoAbxProzentVerschlechertung) Or risikoklasse = "E" Or newValue >= 5 Then createInfo = True + If changedInProzent < Math.Abs(infoAbxProzentVerschlechertungMailInfo) Or risikoklasse = "E" Or newValue >= 5 Then triggerMail = True + + Case "B-SCORE" + oldValue = kundeErw.kde_CreditSaveBonitaetsScore + 'LIMITs DEFINIEREN + + If Not (oldValue = defaultOldValue) Then + changedInProzent = calcChange(oldValue, newValue) + End If + + If changedInProzent < infoAbxProzentVerschlechertung Or risikoklasse = "E" Or newValue >= 5 Then createInfo = True + If changedInProzent < infoAbxProzentVerschlechertungMailInfo Or risikoklasse = "E" Or newValue >= 5 Then triggerMail = True + + Case "KREDITLIMIT" + oldValue = kunde.Höchstkredit + + If Not (oldValue = defaultOldValue) Then + changedInProzent = calcChange(oldValue, newValue) + End If + + 'LIMITs DEFINIEREN + If newValue = 0 Then + createInfo = True + triggerMail = True + End If + End Select + + If Not createInfo Then Exit Sub + + + Dim textVermerk As String = "ACHTUNG, Änderung des " & typ & " von " & oldValue.ToString & " um " & changedInProzent.ToString("F2") & "% " & " auf " & newValue.ToString + + mailText &= "

" & textVermerk + + If setzeKundeninfo Then + + + If kundeErw.kde_BesonderheitenNeu Then + + Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL + If SQL.doSQL("INSERT INTO tblKundenBesonderheiten (kdb_KundenNr,kdb_kategorie,kdb_text,kdb_mitId,kdb_mitName,kdb_EingetragenAm,kdb_visible,kdb_hervorheben,kdb_history) " & + " VALUES(" & kunde.KundenNr & ",'ALLG' ,'" & textVermerk & "'," & "4" & ",'" & "AUTO" & "','" & Now() & "',1,1,0)", "FMZOLL") Then + End If + + Else + + If kunde.Besonderheiten <> "" Then kunde.Besonderheiten &= vbNewLine + kunde.Besonderheiten &= textVermerk + + + End If + End If + + End Sub + + + Shared Function calcChange(oldValue As Double, newValue As Double) + + + If oldValue <> 0 Then + Return ((newValue - oldValue) / oldValue) * 100 + Else + Return 100 + End If + + + + End Function +