kundenuebersicht, creditsafe-API

This commit is contained in:
2025-09-30 09:03:15 +02:00
parent 76f020a09b
commit 2cd1a9df80
2 changed files with 139 additions and 116 deletions

View File

@@ -3380,7 +3380,7 @@ Public Class usrCntlKundenuebersicht
If currentBonID > 0 Then company.csBonID = currentBonID If currentBonID > 0 Then company.csBonID = currentBonID
Dim dt As New DataTable() Dim dt As New DataTable()
If cs.getCompanyEvents(company, dt, True, 0, checklastDate, True) = "Error" Then If cs.getCompanyEventsDetails(company, dt, checklastDate, True, False) = "Error" Then
Exit Sub Exit Sub
End If End If

View File

@@ -5,6 +5,7 @@ Imports System.Net
Imports System.Reflection Imports System.Reflection
Imports System.Text.RegularExpressions Imports System.Text.RegularExpressions
Imports System.Threading Imports System.Threading
Imports com.sun.source.tree
Public Class cCreditSafeAPI Public Class cCreditSafeAPI
@@ -97,7 +98,7 @@ Public Class cCreditSafeAPI
Shared Function SendGetRequestWithAuthHeader(url As String, company As Company, acceptContentType As String, method As String, authenticationToken As String, ByRef failureDesc As String, Optional isMonitoring As Boolean = False, Optional csvImport As Boolean = False, Optional csvFile As String = "", Optional notifEvents As Boolean = False, Optional page As Integer = 0) As String Shared Function SendGetRequestWithAuthHeader(url As String, company As Company, acceptContentType As String, method As String, authenticationToken As String, ByRef failureDesc As String, Optional csvFile As String = "", Optional page As Integer = 0, Optional type As String = "") As String
Try Try
VERAG_PROG_ALLGEMEIN.cChilkat_Helper.UnlockCilkat() VERAG_PROG_ALLGEMEIN.cChilkat_Helper.UnlockCilkat()
@@ -116,15 +117,25 @@ Public Class cCreditSafeAPI
Return failureDesc Return failureDesc
End If End If
rest.ClearAllQueryParams() '-----------------------------------
'aktuelle aufrufe
'-----------------------------------
'"getCompanyEvents"
'"getCompanyEventsDetails"
'"addCompanyToPortfolio"
'"addCompanyToPortfolio_CSV"
'"getCompaniesFromPortfolio"
'"searchCompanies"
'"getReport"
'"getPDF"
'"checkDateOfLastRequest"
'"getSubscriptionCountries"
'-----------------------------------
If company IsNot Nothing Then
setSearchParam(rest, company, isMonitoring, notifEvents, page) setSearchParam(rest, company, page, type)
End If If type = "addCompanyToPortfolio_CSV" Then
If isMonitoring AndAlso csvFile <> "" Then
rest.PartSelector = "0" rest.PartSelector = "0"
rest.AddHeader("Content-Type", "multipart/form-data") rest.AddHeader("Content-Type", "multipart/form-data")
rest.AddHeader("Expect", "100-continue") rest.AddHeader("Expect", "100-continue")
@@ -135,84 +146,80 @@ Public Class cCreditSafeAPI
rest.AddHeader("Authorization", "Bearer " & authenticationToken) rest.AddHeader("Authorization", "Bearer " & authenticationToken)
Dim responseJson As String Dim responseJson As String
Dim pdfData As New Chilkat.BinData Dim pdfData As New Chilkat.BinData
rest.VerboseLogging = 1 If type = "addCompanyToPortfolio_CSV" Then
If isMonitoring Then Dim fileInfo As New FileInfo(csvFile)
If csvImport Then Dim content As String = File.ReadAllText(csvFile)
Dim fileStream As New Chilkat.Stream
fileStream.SourceFile = csvFile
Dim fileInfo As New FileInfo(csvFile) rest.PartSelector = "1"
rest.AddHeader("Content-Disposition", "form-data; name=""importcsv""; filename=""importcsv.csv""")
rest.AddHeader("Content-Type", "text/csv")
rest.SetMultipartBodyString("d.breimaier@verag.ag")
rest.SetMultipartBodyStream(fileStream)
Dim content As String = File.ReadAllText(csvFile) rest.PartSelector = "0"
Dim fileStream As New Chilkat.Stream
fileStream.SourceFile = csvFile
rest.PartSelector = "1" Dim strResponseBody As String = rest.FullRequestMultipart(method, url.Replace(API_STRING, ""))
rest.AddHeader("Content-Disposition", "form-data; name=""importcsv""; filename=""importcsv.csv""") If (rest.LastMethodSuccess <> True) Then
rest.AddHeader("Content-Type", "text/csv") Debug.WriteLine(rest.LastErrorText)
rest.SetMultipartBodyStream(fileStream) failureDesc = rest.LastErrorText
Return failureDesc
Else
rest.PartSelector = "0" If (rest.ResponseStatusCode <> 200) Then
failureDesc = rest.ResponseStatusText & IIf(responseJson <> "", vbNewLine & responseJson, "")
Dim strResponseBody As String = rest.FullRequestMultipart(method, url.Replace(API_STRING, ""))
If (rest.LastMethodSuccess <> True) Then
Debug.WriteLine(rest.LastErrorText)
failureDesc = rest.LastErrorText
Return failureDesc Return failureDesc
Else Else
If (rest.ResponseStatusCode <> 200) Then Return responseJson
failureDesc = rest.ResponseStatusText & IIf(responseJson <> "", vbNewLine & responseJson, "")
Return failureDesc
Else
Return responseJson
End If
End If End If
End If
ElseIf Not notifEvents Then ElseIf type = "addCompanyToPortfolio" Then
Dim json As New Chilkat.JsonObject Dim json As New Chilkat.JsonObject
success = json.UpdateString("id", company.creditSafeId) success = json.UpdateString("id", company.creditSafeId)
success = json.UpdateString("personalReference", "VERAG AG") success = json.UpdateString("personalReference", "VERAG AG")
success = json.UpdateString("freeText", "hinzugefügt am " & Today.ToShortDateString) success = json.UpdateString("freeText", "hinzugefügt am " & Today.ToShortDateString)
success = json.UpdateString("personalLimit", "") success = json.UpdateString("personalLimit", "")
Debug.WriteLine(json.Emit()) Debug.WriteLine(json.Emit())
Dim sbRequestBody As New Chilkat.StringBuilder Dim sbRequestBody As New Chilkat.StringBuilder
json.EmitSb(sbRequestBody) json.EmitSb(sbRequestBody)
Dim sbResponseBody As New Chilkat.StringBuilder Dim sbResponseBody As New Chilkat.StringBuilder
success = rest.FullRequestSb(method, url, sbRequestBody, sbResponseBody) success = rest.FullRequestSb(method, url, sbRequestBody, sbResponseBody)
If (success <> True) Then If (success <> True) Then
Debug.WriteLine(rest.LastErrorText) Debug.WriteLine(rest.LastErrorText)
failureDesc = rest.LastErrorText failureDesc = rest.LastErrorText
Return failureDesc
Else
If (rest.ResponseStatusCode <> 200) Then
failureDesc = rest.ResponseStatusText & IIf(responseJson <> "", vbNewLine & responseJson, "")
Return failureDesc Return failureDesc
Else Else
If (rest.ResponseStatusCode <> 200) Then Return responseJson
failureDesc = rest.ResponseStatusText & IIf(responseJson <> "", vbNewLine & responseJson, "")
Return failureDesc
Else
Return responseJson
End If
End If End If
End If End If
End If End If
If acceptContentType.Contains("application/pdf") Then
If acceptContentType.Contains("application/pdf") AndAlso (type = "getReport" Or type = "getPDF") Then
'If acceptContentType.Contains("application/json+pdf") Or acceptContentType.Contains("application/json") Then 'If acceptContentType.Contains("application/json+pdf") Or acceptContentType.Contains("application/json") Then
responseJson = rest.FullRequestNoBodyBd(method, url, pdfData) responseJson = rest.FullRequestNoBodyBd(method, url, pdfData)
@@ -313,9 +320,6 @@ Public Class cCreditSafeAPI
End Sub End Sub
Shared Function authenticate(Optional username As String = "", Optional password As String = "") As String Shared Function authenticate(Optional username As String = "", Optional password As String = "") As String
Dim myUri As String = API_STRING & "/v1/authenticate" Dim myUri As String = API_STRING & "/v1/authenticate"
@@ -328,14 +332,13 @@ Public Class cCreditSafeAPI
Return response Return response
End Function End Function
Shared Function AddCompanyToPortfolio(company As Company, Optional PortfolioID As String = "1662419") As String Shared Function AddCompanyToPortfolio(company As Company, Optional PortfolioID As String = "1662419") As String
Dim myUri As String = API_STRING & "/v1/monitoring/portfolios/" & PortfolioID & "/companies" 'Default Dim myUri As String = API_STRING & "/v1/monitoring/portfolios/" & PortfolioID & "/companies" 'Default
Dim jsonRespString = SendGetRequestWithAuthHeader(myUri, company, "application/json", "POST", token, "", True) Dim jsonRespString = SendGetRequestWithAuthHeader(myUri, company, "application/json", "POST", token, "",,, "addCompanyToPortfolio")
Return jsonRespString Return jsonRespString
@@ -345,7 +348,7 @@ Public Class cCreditSafeAPI
Dim myUri As String = API_STRING & "/v1/monitoring/portfolios/" & PortfolioID & IIf(sync, "/sync", "/import") 'Default Dim myUri As String = API_STRING & "/v1/monitoring/portfolios/" & PortfolioID & IIf(sync, "/sync", "/import") 'Default
Dim jsonRespString = SendGetRequestWithAuthHeader(myUri, Nothing, "application/json", "POST", token, "", True, True, csvFilePath) Dim jsonRespString = SendGetRequestWithAuthHeader(myUri, Nothing, "application/json", "POST", token, "", csvFilePath,, "addCompanyToPortfolio_CSV")
Return jsonRespString Return jsonRespString
@@ -355,7 +358,7 @@ Public Class cCreditSafeAPI
Dim myUri As String = API_STRING & "/v1/monitoring/portfolios/" & PortfolioID & "/companies" 'Default Dim myUri As String = API_STRING & "/v1/monitoring/portfolios/" & PortfolioID & "/companies" 'Default
Dim jsonRespString = SendGetRequestWithAuthHeader(myUri, Nothing, "application/json", "GET", token, "", False) Dim jsonRespString = SendGetRequestWithAuthHeader(myUri, Nothing, "application/json", "GET", token, "",,, "getCompaniesFromPortfolio")
Dim json As New Chilkat.JsonObject Dim json As New Chilkat.JsonObject
Dim success As Boolean = json.Load(jsonRespString) Dim success As Boolean = json.Load(jsonRespString)
@@ -367,7 +370,6 @@ Public Class cCreditSafeAPI
totalCount = -1 totalCount = -1
End If End If
Return jsonRespString Return jsonRespString
End Function End Function
@@ -379,7 +381,7 @@ Public Class cCreditSafeAPI
Dim failureDesc As String Dim failureDesc As String
Dim myUrl As String = API_STRING & "/v1/companies" Dim myUrl As String = API_STRING & "/v1/companies"
Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, company, "application/json", "GET", token, failureDesc) Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, company, "application/json", "GET", token, failureDesc,,, "searchCompanies")
Dim json As New Chilkat.JsonObject Dim json As New Chilkat.JsonObject
@@ -487,7 +489,7 @@ Public Class cCreditSafeAPI
Dim failureDesc As String Dim failureDesc As String
Dim myUrl As String = API_STRING & "/v1/monitoring/companies/" & company.creditSafeId & "/events" & IIf(checklastChecked, "?startDate=" & checkDate, "") 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, True) Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, company, "application/json", "GET", token, failureDesc, ,, "getCompanyEventsDetails")
If failureDesc <> "" Then If failureDesc <> "" Then
If showError Then MsgBox(failureDesc) If showError Then MsgBox(failureDesc)
@@ -679,7 +681,7 @@ Public Class cCreditSafeAPI
Dim myUrl As String = API_STRING & "/v1/monitoring/portfolios/1662419/notificationEvents" Dim myUrl As String = API_STRING & "/v1/monitoring/portfolios/1662419/notificationEvents"
Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, company, "application/json", "GET", token, failureDesc, True,,, True, page) Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, company, "application/json", "GET", token, failureDesc,, page, "getCompanyEvents")
If failureDesc <> "" Then If failureDesc <> "" Then
If showError Then MsgBox(failureDesc) If showError Then MsgBox(failureDesc)
@@ -915,45 +917,49 @@ Public Class cCreditSafeAPI
Dim riskClassChanged As Boolean = False Dim riskClassChanged As Boolean = False
Dim KUNDE_ERW As New cKundenErweitert(KUNDE.KundenNr) Dim KUNDE_ERW As New cKundenErweitert(KUNDE.KundenNr)
If company.kdNr = 762207 Then
MsgBox("Hier")
End If
If Not (ADR.LandKz = "AT" Or ADR.LandKz = "A") Then 'bei nicht österr. den Index nehmen, sonst den Score If Not (ADR.LandKz = "AT" Or ADR.LandKz = "A") Then 'bei nicht österr. den Index nehmen, sonst den Score
Index = IIf(CR = defaultCL, -1, calculatedBonIndexFromBonScore(CR, riskClass)) Index = IIf(CR = defaultCL, -1, calculatedBonIndexFromBonScore(CR, riskClass))
Else Else
If CR <> defaultCL Then calculatedBonIndexFromBonScore(CR, riskClass) If CR <> defaultCL Then calculatedBonIndexFromBonScore(CR, riskClass)
End If
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 End If
Else
If KUNDE_ERW.kde_CreditSaveBonitaetsScore <> CR AndAlso CR <> defaultCR Then If Index <> -1 Then
createInfo("B-SCORE", KUNDE_ERW, KUNDE, CR, riskClass, MailText, triggerMail, setzeKundenbesonderheiten) If KUNDE_ERW.kde_CreditSaveBonitaetsIndex <> Index Then
KUNDE_ERW.kde_CreditSaveBonitaetsScore = CR createInfo("B-INDEX", KUNDE_ERW, KUNDE, Index, riskClass, MailText, triggerMail, setzeKundenbesonderheiten)
KUNDE_ERW.kde_CreditSaveBonitaetsklasse = riskClass KUNDE_ERW.kde_CreditSaveBonitaetsIndex = Index
KUNDE.Bonitätsdatum = Today() 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()
End If
End If End If
End If
If KUNDE.Höchstkredit <> CL AndAlso CL <> defaultCL Then If KUNDE.Höchstkredit <> CL AndAlso CL <> defaultCL Then
createInfo("KREDITLIMIT", KUNDE_ERW, KUNDE, CL, riskClass, MailText, triggerMail, setzeKundenbesonderheiten) createInfo("KREDITLIMIT", KUNDE_ERW, KUNDE, CL, riskClass, MailText, triggerMail, setzeKundenbesonderheiten)
KUNDE.Höchstkredit = CL KUNDE.Höchstkredit = CL
If KUNDE.Bonitätsdatum <= CDate(CL_Datum) Then If KUNDE.Bonitätsdatum <= CDate(CL_Datum) Then
KUNDE.Bonitätsdatum = Today() KUNDE.Bonitätsdatum = Today()
End If
End If End If
If company.BANKRUPT_REGISTERED AndAlso Not MailText.Contains("FÜR INSOLVENT ERKLÄRT") Then
createInfo("BANKRUPT_REGISTERED", KUNDE_ERW, KUNDE, CL, riskClass, MailText, triggerMail, setzeKundenbesonderheiten, company)
KUNDE_ERW.kde_CSinsolventAm = company.BANKRUPT_REGISTERED_DATE
End If
If updateKunden Then KUNDE_ERW.SAVE()
End If End If
If company.BANKRUPT_REGISTERED AndAlso Not MailText.Contains("FÜR INSOLVENT ERKLÄRT") Then If updateKunden Then KUNDE.SAVE()
createInfo("BANKRUPT_REGISTERED", KUNDE_ERW, KUNDE, CL, riskClass, MailText, triggerMail, setzeKundenbesonderheiten, company)
KUNDE_ERW.kde_CSinsolventAm = company.BANKRUPT_REGISTERED_DATE
End If
If updateKunden Then KUNDE_ERW.SAVE()
End If
If updateKunden Then KUNDE.SAVE()
End If End If
@@ -1120,7 +1126,7 @@ Public Class cCreditSafeAPI
Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, Nothing, acceptContentType, "GET", token, failureDesc) Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, Nothing, acceptContentType, "GET", token, failureDesc,,, "getReport")
If failureDesc <> "" Then Return failureDesc If failureDesc <> "" Then Return failureDesc
Dim json As New Chilkat.JsonObject Dim json As New Chilkat.JsonObject
@@ -1294,7 +1300,7 @@ Public Class cCreditSafeAPI
Dim acceptContentType = "application/pdf" Dim acceptContentType = "application/pdf"
Dim pdfData2 As New Chilkat.BinData Dim pdfData2 As New Chilkat.BinData
Dim failureDesc As String = "" Dim failureDesc As String = ""
Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, Nothing, acceptContentType, "GET", token, failureDesc) Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, Nothing, acceptContentType, "GET", token, failureDesc,,, "getPDF")
If failureDesc <> "" Then If failureDesc <> "" Then
Dim jsonFailure As New Chilkat.JsonObject Dim jsonFailure As New Chilkat.JsonObject
@@ -1329,7 +1335,7 @@ Public Class cCreditSafeAPI
Dim company Dim company
Dim failureDesc As String Dim failureDesc As String
Dim myUrl As String = API_STRING & "/v1/access" Dim myUrl As String = API_STRING & "/v1/access"
Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, company, "application/json", "GET", token, failureDesc) Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, company, "application/json", "GET", token, failureDesc,,, "getSubscriptionCountries")
Dim json As New Chilkat.JsonObject Dim json As New Chilkat.JsonObject
success = json.Load(jsonRespString) success = json.Load(jsonRespString)
@@ -1375,34 +1381,45 @@ Public Class cCreditSafeAPI
End Function End Function
Shared Sub setSearchParam(ByRef rest As Chilkat.Rest, ByRef company As Company, ByRef isMonitoring As Boolean, isNotEvent As Boolean, Optional page As Integer = 0) Shared Sub setSearchParam(ByRef rest As Chilkat.Rest, ByRef company As Company, Optional page As Integer = 0, Optional type As String = "")
Dim setCompanyQueryParam As Boolean = False
rest.ClearAllQueryParams()
If company IsNot Nothing Then If company IsNot Nothing Then
If isMonitoring Then Select Case type
Case "getCompanyEvents"
If isNotEvent Then
rest.AddQueryParam("sortBy", "companyName") rest.AddQueryParam("sortBy", "companyName")
rest.AddQueryParam("sortDir", "asc") rest.AddQueryParam("sortDir", "asc")
If company.lastChecked >= Today.AddYears(-50) Then If company.lastChecked >= Today.AddYears(-50) Then
rest.AddQueryParam("startDate", company.lastChecked.ToString("yyyy-MM-ddTHH:mm:ss")) rest.AddQueryParam("startDate", company.lastChecked.ToString("yyyy-MM-ddTHH:mm:ss"))
rest.AddQueryParam("endDate", Now().ToString("yyyy-MM-ddTHH:mm:ss")) rest.AddQueryParam("endDate", Now().ToString("yyyy-MM-ddTHH:mm:ss"))
rest.AddQueryParam("filterByCreatedDate", "true") rest.AddQueryParam("filterByCreatedDate", "true")
rest.AddQueryParam("pageSize", "1000") 'maximum rest.AddQueryParam("pageSize", "1000") 'maximum
rest.AddQueryParam("page", page) rest.AddQueryParam("page", page)
End If End If
Case "getCompanyEventsDetails"
'Start and Enddate in URL!
Case "addCompanyToPortfolio"
'NIX
Case "addCompanyToPortfolio_CSV"
'NIX
Case "getCompaniesFromPortfolio" : setCompanyQueryParam = True
Case "searchCompanies" : setCompanyQueryParam = True
Case "getReport" : setCompanyQueryParam = True
Case "getPDF" : setCompanyQueryParam = True
Case "checkDateOfLastRequest" : setCompanyQueryParam = True
Case "getSubscriptionCountries" : setCompanyQueryParam = True
End Select
End If If setCompanyQueryParam Then
Else
rest.AddQueryParam("countries", company.country) rest.AddQueryParam("countries", company.country)
If company.creditsafeNo <> "" Then 'Eindeutiger Schlüssel If company.creditsafeNo <> "" Then 'Eindeutiger Schlüssel
rest.AddQueryParam("safeNo", company.creditsafeNo) rest.AddQueryParam("safeNo", company.creditsafeNo)
@@ -1424,16 +1441,18 @@ Public Class cCreditSafeAPI
End If End If
End If End If
End Sub End Sub
Shared Function checkDateOfLastRequest(company As Company) As Date Shared Function checkDateOfLastRequest(company As Company) As Date
Dim failureDesc As String Dim failureDesc As String
Dim myUrl As String = API_STRING & "/v1/companies" Dim myUrl As String = API_STRING & "/v1/companies"
Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, company, "application/json", "GET", token, failureDesc) Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, company, "application/json", "GET", token, failureDesc,,, "checkDateOfLastRequest")
Dim json As New Chilkat.JsonObject Dim json As New Chilkat.JsonObject
Dim success As Boolean = json.Load(jsonRespString) Dim success As Boolean = json.Load(jsonRespString)
@@ -1485,6 +1504,8 @@ Public Class cCreditSafeAPI
riskClass = "D" riskClass = "D"
Case 1 To 14 Case 1 To 14
riskClass = "D" riskClass = "D"
Case -10000000
riskClass = ""
Case Else Case Else
riskClass = "E" riskClass = "E"
End Select End Select
@@ -1575,6 +1596,8 @@ Public Class cCreditSafeAPI
Return 1.1 Return 1.1
Case 99 To 100 Case 99 To 100
Return 1 Return 1
Case -10000000
Return -1
Case Else Case Else
Return 6 Return 6
End Select End Select