Imports System.Data.SqlClient Imports System.IO Imports System.Net Imports System.Reflection Imports System.Text.RegularExpressions Imports System.Threading Public Class cCreditSafeAPI Shared API_STRING As String Shared API As New DataTable Shared token As String = "" Public dataTable As New DataTable() Public dataTablecs As New DataTable() Shared SQL As New SQL Shared apiSettingsloaded As Boolean = False Shared rest As New Chilkat.Rest Sub New(program As String) API = SQL.loadDgvBySql("SELECT top(1) * FROM tblAPIEinstellungen WHERE api_program='" & program & "' and api_productive ='" & IIf(VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM, "0", "1") & "'", "ADMIN") dataTablecs = API If API.Rows.Count = 0 Then MsgBox("keine gültigen API-Einstellungen für " & program & " gefunden!") Else apiSettingsloaded = True API_STRING = API.Rows(0).Item("api_url") If Not IsDBNull(API.Rows(0).Item("api_debugpath")) AndAlso API.Rows(0).Item("api_debugpath") <> "" Then rest.VerboseLogging = True rest.DebugLogFilePath = API.Rows(0).Item("api_debugpath") & program & IIf(VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM, "_Test", "") & ".txt" Else rest.VerboseLogging = False End If End If End Sub Shared Function SendRequestAuthentificationToken(myuri As String, contentType As String, method As String, Optional csUser As CreditSafeUser = Nothing) As String Try VERAG_PROG_ALLGEMEIN.cChilkat_Helper.UnlockCilkat() If apiSettingsloaded = False Then Return "400" Dim success As Boolean Dim bTls As Boolean = True Dim port As Integer = 443 Dim bAutoReconnect As Boolean = True success = rest.Connect(API_STRING, port, bTls, bAutoReconnect) If (success <> True) Then Debug.WriteLine("ConnectFailReason: " & rest.ConnectFailReason) Debug.WriteLine(rest.LastErrorText) Return rest.LastErrorText End If Dim json As New Chilkat.JsonObject If csUser IsNot Nothing Then json.UpdateString("username", csUser.username) json.UpdateString("password", csUser.password) Else json.UpdateString("username", API.Rows(0).Item("api_user")) json.UpdateString("password", API.Rows(0).Item("api_password")) End If rest.AddHeader("Content-Type", contentType) Dim sbRequestBody As New Chilkat.StringBuilder json.EmitSb(sbRequestBody) Dim sbResponseBody As New Chilkat.StringBuilder Dim ResponseStr = rest.FullRequestSb(method, myuri, sbRequestBody, sbResponseBody) If (rest.ResponseStatusCode <> 200) Then Return rest.ResponseStatusCode End If Dim jsonResp = New Chilkat.JsonObject() jsonResp.LoadSb(sbResponseBody) token = jsonResp.StringOf("token") Return rest.ResponseStatusCode Catch ex As WebException VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try End Function 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 VERAG_PROG_ALLGEMEIN.cChilkat_Helper.UnlockCilkat() Dim success As Boolean Dim bTls As Boolean = True Dim port As Integer = 443 Dim bAutoReconnect As Boolean = True success = rest.Connect(API_STRING, port, bTls, bAutoReconnect) If (success <> True) Then Debug.WriteLine("ConnectFailReason: " & rest.ConnectFailReason) Debug.WriteLine(rest.LastErrorText) failureDesc = rest.LastErrorText Return failureDesc End If '----------------------------------- 'aktuelle aufrufe '----------------------------------- '"getCompanyEvents" '"getCompanyEventsDetails" '"addCompanyToPortfolio" '"addCompanyToPortfolio_CSV" '"getCompaniesFromPortfolio" '"searchCompanies" '"getReport" '"getPDF" '"checkDateOfLastRequest" '"getSubscriptionCountries" '----------------------------------- setSearchParam(rest, company, page, type) If type = "addCompanyToPortfolio_CSV" Then rest.PartSelector = "0" rest.AddHeader("Content-Type", "multipart/form-data") rest.AddHeader("Expect", "100-continue") Else rest.AddHeader("Content-Type", "application/json") rest.AddHeader("Accept", acceptContentType) End If rest.AddHeader("Authorization", "Bearer " & authenticationToken) Dim responseJson As String Dim pdfData As New Chilkat.BinData If type = "addCompanyToPortfolio_CSV" Then Dim fileInfo As New FileInfo(csvFile) Dim content As String = File.ReadAllText(csvFile) Dim fileStream As New Chilkat.Stream fileStream.SourceFile = csvFile rest.PartSelector = "1" rest.AddHeader("Content-Disposition", "form-data; name=""importcsv""; filename=""importcsv.csv""") rest.AddHeader("Content-Type", "text/csv") rest.SetMultipartBodyStream(fileStream) rest.PartSelector = "2" rest.AddHeader("Content-Disposition", "form-data; name=""email""") rest.AddHeader("Content-Type", "text") rest.SetMultipartBodyString("d.breimaier@verag.ag") ';as@verag.ag;Viktoria.Leirich@imex-group.at rest.PartSelector = "0" 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 Else If (rest.ResponseStatusCode <> 200) Then failureDesc = rest.ResponseStatusText & IIf(responseJson <> "", vbNewLine & responseJson, "") Return failureDesc Else Return responseJson End If End If ElseIf type = "addCompanyToPortfolio" Then Dim json As New Chilkat.JsonObject success = json.UpdateString("id", company.creditSafeId) success = json.UpdateString("personalReference", "VERAG AG") success = json.UpdateString("freeText", "hinzugefügt am " & Today.ToShortDateString) success = json.UpdateString("personalLimit", "") Debug.WriteLine(json.Emit()) Dim sbRequestBody As New Chilkat.StringBuilder json.EmitSb(sbRequestBody) Dim sbResponseBody As New Chilkat.StringBuilder success = rest.FullRequestSb(method, url, sbRequestBody, sbResponseBody) If (success <> True) Then Debug.WriteLine(rest.LastErrorText) failureDesc = rest.LastErrorText Return failureDesc Else If (rest.ResponseStatusCode <> 200) Then failureDesc = rest.ResponseStatusText & IIf(responseJson <> "", vbNewLine & responseJson, "") Return failureDesc Else Return responseJson End If End If End If If acceptContentType.Contains("application/pdf") AndAlso (type = "getReport" Or type = "getPDF") Then 'If acceptContentType.Contains("application/json+pdf") Or acceptContentType.Contains("application/json") Then responseJson = rest.FullRequestNoBodyBd(method, url, pdfData) If (rest.LastMethodSuccess <> True) Then Debug.WriteLine(rest.LastErrorText) MsgBox(rest.LastErrorText) failureDesc = rest.LastErrorText Return failureDesc Else If (rest.ResponseStatusCode <> 200) Then For i = 0 To 15 'Versuche das PDF 16x abzufragen (funktioniert ab und zu nicht). responseJson = rest.FullRequestNoBodyBd(method, url, pdfData) If rest.ResponseStatusCode = 200 Then Exit For Thread.Sleep(500) i = i + 1 Next If rest.ResponseStatusCode <> 200 Then Dim sbErrorText As New Chilkat.StringBuilder sbErrorText.AppendBd(pdfData, "utf-8", 0, 0) failureDesc = sbErrorText.GetAsString() Return failureDesc End If Else Return pdfData.GetEncoded("base64") End If End If Else responseJson = rest.FullRequestNoBody(method, url) If (rest.LastMethodSuccess <> True) Then Debug.WriteLine(rest.LastErrorText) failureDesc = rest.LastErrorText Return failureDesc Else If (rest.ResponseStatusCode <> 200) Then failureDesc = rest.ResponseStatusText & IIf(responseJson <> "", vbNewLine & responseJson, "") Return failureDesc Else Return responseJson End If End If End If Catch ex As WebException VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try 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 Shared Function authenticate(Optional username As String = "", Optional password As String = "") As String Dim myUri As String = API_STRING & "/v1/authenticate" Dim csUser If username <> "" AndAlso password <> "" Then csUser = New CreditSafeUser(username, password) End If Dim response = SendRequestAuthentificationToken(myUri, "application/json", "POST", csUser) Return response End Function 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 jsonRespString = SendGetRequestWithAuthHeader(myUri, company, "application/json", "POST", token, "",,, "addCompanyToPortfolio") Return jsonRespString End Function Shared Function AddCompaniesCSVToPortfolio(csvFilePath As String, sync As Boolean, Optional PortfolioID As String = "1662419") As String Dim myUri As String = API_STRING & "/v1/monitoring/portfolios/" & PortfolioID & IIf(sync, "/sync", "/import") 'Default Dim jsonRespString = SendGetRequestWithAuthHeader(myUri, Nothing, "application/json", "POST", token, "", csvFilePath,, "addCompanyToPortfolio_CSV") Return jsonRespString 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, "",,, "getCompaniesFromPortfolio") 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 VERAG_PROG_ALLGEMEIN.cChilkat_Helper.UnlockCilkat() Dim failureDesc As String Dim myUrl As String = API_STRING & "/v1/companies" Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, company, "application/json", "GET", token, failureDesc,,, "searchCompanies") Dim json As New Chilkat.JsonObject Dim success As Boolean = json.Load(jsonRespString) If (success <> True) Then Debug.WriteLine(json.LastErrorText) Return "Verbindungsfehler" End If Dim num As Integer = json.SizeOfArray("companies") If num = 0 Then Return json.StringOf("messages[0].text") End If Dim companies As Chilkat.JsonArray = json.ArrayOf("companies") If (json.LastMethodSuccess = False) Then Return "companies member not found." End If Dim numCompanies As Integer = companies.Size For i = 0 To 1 Dim j As Integer = 0 While j < numCompanies Dim compObj As Chilkat.JsonObject = companies.ObjectAt(j) Dim index = companies.FindString("address", False) Dim adressObj As Chilkat.JsonObject = compObj.ObjectOf("address") Dim dateTime As New Chilkat.CkDateTime Dim dt As New Chilkat.DtObj Dim getAsLocal As Boolean = False success = compObj.DateOf("dateOfLatestChange", dateTime) Debug.WriteLine(dateTime.GetAsTimestamp(getAsLocal)) 'Debug.WriteLine(adressObj.StringOf("simpleValue")) 'Debug.WriteLine(compObj.StringOf("id") & " " & compObj.StringOf("phoneNo") & " " & compObj.StringOf("phoneNumbers[0]")) Dim R As DataRow = dataTable.NewRow R("id") = compObj.StringOf("id") R("name") = compObj.StringOf("name") R("country") = compObj.StringOf("country") R("safeNo") = compObj.StringOf("safeNo") R("vatNo") = compObj.StringOf("vatNo[0]") R("regNo") = compObj.StringOf("regNo") R("status") = compObj.StringOf("status") R("dateOfLatestChange") = dateTime.GetAsTimestamp(getAsLocal) R("phoneNo") = compObj.StringOf("phoneNumbers[0]") If adressObj IsNot Nothing Then R("street") = adressObj.StringOf("street") R("city") = adressObj.StringOf("city") R("street") = adressObj.StringOf("street") R("postCode") = adressObj.StringOf("postCode") Else R("street") = "" R("city") = "" R("street") = "" R("postCode") = "" End If 'Zuerst aktive Firmen, dann inaktive.. Select Case i Case 0 If R("status").ToString.ToLower = "active" Then dataTable.Rows.Add(R) End If Case Else If R("status").ToString.ToLower <> "active" Then dataTable.Rows.Add(R) End If End Select j = j + 1 End While Next Return "Anzahl gefundener Datensätze: " & numCompanies End Function Shared Function getCompanyEventsDetails(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, Optional firma As String = "VERAG") As String '------------------------------- PRO KUNDE '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(-365).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=" & checkDate, "") Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, company, "application/json", "GET", token, failureDesc, ,, "getCompanyEventsDetails") If failureDesc <> "" Then If showError Then MsgBox(failureDesc) Return "Error" & vbNewLine & failureDesc & vbNewLine & myUrl End If Dim json As New Chilkat.JsonObject Dim success As Boolean = json.Load(jsonRespString) If (success <> True) Then Debug.WriteLine(json.LastErrorText) Return "Verbindungsfehler" & vbNewLine & json.LastErrorText End If If dtEvents.Columns.Count = 0 Then dtEvents.Columns.Add("eventId", GetType(String)) dtEvents.Columns.Add("companyId", GetType(String)) dtEvents.Columns.Add("portfolioId", GetType(String)) dtEvents.Columns.Add("ruleName", GetType(String)) dtEvents.Columns.Add("localEventCode", GetType(String)) dtEvents.Columns.Add("globalEventCode", GetType(String)) dtEvents.Columns.Add("newValue", GetType(String)) dtEvents.Columns.Add("oldValue", GetType(String)) dtEvents.Columns.Add("eventDate", GetType(DateTime)) dtEvents.Columns.Add("createdDate", GetType(DateTime)) End If dtEvents.Rows.Clear() Dim num As Integer = json.SizeOfArray("data") If num = 0 OrElse getTotalNr Then Return json.StringOf("totalCount") End If Dim companieData As Chilkat.JsonArray = json.ArrayOf("data") If (json.LastMethodSuccess = False) Then Return "data not found." End If Dim numCompanies As Integer = companieData.Size Dim defaultCL As Double = -10000000 Dim defaultCR As Integer = -10000000 Dim CL As Double = defaultCL Dim CR As Integer = defaultCR Dim CL_Datum As Date = company.lastChecked Dim CR_Datum As Date = company.lastChecked ' For i = 0 To 1 Dim j As Integer = 0 While j < numCompanies Dim compObj As Chilkat.JsonObject = companieData.ObjectAt(j) Dim index = companieData.FindString("eventId", False) Dim dateTime As New Chilkat.CkDateTime Dim dt As New Chilkat.DtObj Dim getAsLocal As Boolean = False success = compObj.DateOf("eventDate", dateTime) success = compObj.DateOf("createdDate", dateTime) Debug.WriteLine(dateTime.GetAsTimestamp(getAsLocal)) Dim R As DataRow = dtEvents.NewRow R("eventId") = compObj.StringOf("eventId") R("companyId") = compObj.StringOf("companyId") R("portfolioId") = compObj.StringOf("portfolioId") R("ruleName") = compObj.StringOf("ruleName") R("localEventCode") = compObj.StringOf("localEventCode") R("globalEventCode") = compObj.StringOf("globalEventCode") R("oldValue") = compObj.StringOf("oldValue") R("newValue") = compObj.StringOf("newValue") R("eventDate") = dateTime.GetAsTimestamp(getAsLocal) R("createdDate") = dateTime.GetAsTimestamp(getAsLocal) dtEvents.Rows.Add(R) createEvents(R, company.kdNr, company, CL, CR, CL_Datum, CR_Datum, "ED") j = j + 1 End While 'Next If dtEvents.Rows.Count > 1 Then dtEvents.DefaultView.Sort = "eventDate ASC" dtEvents = dtEvents.DefaultView.ToTable 'viewEvents = New DataView(dtEvents, "localEventCode IN ('CL','CR') or e.globalEventCode IN ('CL','CR')", "", DataViewRowState.CurrentRows) End If Dim triggerMail As Boolean = False Dim KUNDE As New cKunde(company.kdNr) Dim Mailtext As String = "" updateKundenWithEvent(KUNDE, company, CL, CR, CL_Datum, CR_Datum, setzeKundenbesonderheiten, defaultCR, defaultCL, updateKunden, sendMail, triggerMail, Mailtext, firma) '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 ' Dim ADR As New cAdressen(KUNDE.KundenNr) ' Dim riskClass As String = "" ' Dim riskClassChanged As Boolean = False ' Dim KUNDE_ERW As New cKundenErweitert(KUNDE.KundenNr) ' 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)) ' Else ' 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 ' 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 ' 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 ' If updateKunden Then KUNDE_ERW.SAVE() ' End If ' If updateKunden Then KUNDE.SAVE() If triggerMail AndAlso sendMail Then Dim ADR As New cAdressen(KUNDE.KundenNr) Dim empfanegerMail As String = "" Select Case firma Case "VERAG" : empfanegerMail = "as@verag.ag" Case "IMEX" : empfanegerMail = "Viktoria.Leirich@imex-group.at" 'Case "AMBAR" : empfanegerMail = "Buchhaltung@ambarlog.com" 'Case "UNISPED" : empfanegerMail = "sabine.muehlboeck@unisped.at" End Select If VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM Then empfanegerMail = "d.breimaier@verag.ag" If empfanegerMail <> "" Then VERAG_PROG_ALLGEMEIN.cProgramFunctions.sendMail(empfanegerMail, IIf(VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM, "TEST-", "") & "CREDITSAFE " & KUNDE.KundenNr, "Änderungen der Creditsafe-Daten von Kunden " & KUNDE.KundenNr & " " & ADR.Ordnungsbegriff & Mailtext.ToString & "

" & "*Automatic generated e-mail*",,,,, "d.breimaier@verag.ag") End If 'End if Return "Anzahl gefundener Datensätze: " & numCompanies End Function Shared Function getCompanyEvents(company As Company, ByRef dtEvents As DataTable, ByRef companyDetailEvents As Boolean, ByRef maxPages As Integer, 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, Optional firma As String = "VERAG", Optional page As Integer = 0) As String '------------------------------- ALLE KUNDEN 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/portfolios/1662419/notificationEvents" Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, company, "application/json", "GET", token, failureDesc,, page, "getCompanyEvents") If failureDesc <> "" Then If showError Then MsgBox(failureDesc) Return "Error" & vbNewLine & failureDesc & vbNewLine & myUrl End If Dim json As New Chilkat.JsonObject Dim success As Boolean = json.Load(jsonRespString) If (success <> True) Then Debug.WriteLine(json.LastErrorText) Return "Verbindungsfehler" & vbNewLine & json.LastErrorText End If If dtEvents.Columns.Count = 0 Then dtEvents.Columns.Add("eventId", GetType(String)) dtEvents.Columns.Add("companyId", GetType(String)) dtEvents.Columns.Add("portfolioId", GetType(String)) dtEvents.Columns.Add("ruleName", GetType(String)) dtEvents.Columns.Add("localEventCode", GetType(String)) dtEvents.Columns.Add("globalEventCode", GetType(String)) dtEvents.Columns.Add("newValue", GetType(String)) dtEvents.Columns.Add("oldValue", GetType(String)) dtEvents.Columns.Add("eventDate", GetType(DateTime)) dtEvents.Columns.Add("createdDate", GetType(DateTime)) End If dtEvents.Rows.Clear() Dim num As Integer = json.SizeOfArray("data") If num = 0 OrElse getTotalNr Then Return json.StringOf("totalCount") End If Dim companieData As Chilkat.JsonArray = json.ArrayOf("data") If (json.LastMethodSuccess = False) Then Return "data not found." End If Dim pagination As Chilkat.JsonObject = json.ObjectOf("paging") If Not (json.LastMethodSuccess = False) Then Dim Lastpage As String = pagination.StringOf("last") If IsNumeric(Lastpage) Then maxPages = Lastpage End If Dim numCompanies As Integer = companieData.Size Dim defaultCL As Double = -10000000 Dim defaultCR As Integer = -10000000 Dim CL As Double = defaultCL Dim CR As Integer = defaultCR Dim CL_Datum As Date = company.lastChecked Dim CR_Datum As Date = company.lastChecked Dim j As Integer = 0 Dim lastcompanyID As String = "" Dim Mailtext As String = "" Dim triggerMail As Boolean = False Dim triggerMailEnd As Boolean = False Dim MailtextEnd As String = "" While j < numCompanies Dim compObj As Chilkat.JsonObject = companieData.ObjectAt(j) Dim compObjNext As Chilkat.JsonObject = Nothing If (j + 1) < numCompanies Then compObjNext = companieData.ObjectAt(j + 1) Else compObjNext = companieData.ObjectAt(j) End If Dim companychanges As Boolean = False Dim index = companieData.FindString("eventId", False) Dim dateTime As New Chilkat.CkDateTime Dim dt As New Chilkat.DtObj Dim getAsLocal As Boolean = False success = compObj.DateOf("eventDate", dateTime) success = compObj.DateOf("createdDate", dateTime) Debug.WriteLine(dateTime.GetAsTimestamp(getAsLocal)) Dim R As DataRow = dtEvents.NewRow R("eventId") = compObj.StringOf("eventId") R("companyId") = compObj.StringOf("companyId") R("portfolioId") = compObj.StringOf("portfolioId") R("ruleName") = compObj.StringOf("ruleName") R("localEventCode") = compObj.StringOf("localEventCode") R("globalEventCode") = compObj.StringOf("globalEventCode") R("oldValue") = compObj.StringOf("oldValue") R("newValue") = compObj.StringOf("newValue") R("eventDate") = dateTime.GetAsTimestamp(getAsLocal) R("createdDate") = dateTime.GetAsTimestamp(getAsLocal) If IsDBNull(R("companyId")) Then Dim compObjHead As Chilkat.JsonObject = compObj.ObjectOf("company") R("companyId") = compObjHead.StringOf("id") If IsDBNull(R("portfolioId")) Then R("portfolioId") = compObjHead.StringOf("portfolioId") End If Dim nextcompid = "" If compObjNext IsNot Nothing Then Dim nextcompObjHead As Chilkat.JsonObject = compObjNext.ObjectOf("company") nextcompid = nextcompObjHead.StringOf("id") If nextcompid <> R("companyId") Then companychanges = True Else companychanges = False End If End If 'dtEvents.Rows.Add(R) Dim dtKundenNr As New DataTable 'If company.kdNr = 0 Then dtKundenNr = SQL.loadDgvBySql("select distinct(ba_KundenNr),f.Firma from Kunden inner join tblKundenErweitert on Kunden.KundenNr = kde_KundenNr inner join Filialen as f on f.FilialenNr = Kunden.FilialenNr inner join tblBonitaetsauskunft on ba_KundenNr = kde_KundenNr where isnull(tblKundenErweitert.kde_CreditSaveId,'') ='" & R("companyId") & "'", "FMZOLL") 'End If Dim dtFirmen As New DataTable() If dtFirmen.Columns.Count = 0 Then dtFirmen.Columns.Add("Firma", GetType(String)) If dtKundenNr.Rows.Count > 0 Then For Each row As DataRow In dtKundenNr.Rows company.kdNr = row("ba_KundenNr") company.creditSafeId = R("companyId") firma = row("Firma") Dim firmRow As DataRow = dtFirmen.NewRow firmRow("Firma") = firma dtFirmen.Rows.Add(firmRow) Dim currentBonID As String = (New SQL).getValueTxtBySql("Select Top(1) isnull(ba_id, -1) FROM [tblBonitaetsauskunft] where ba_KundenNr = " & company.kdNr & " AND [ba_Pruefungstool] = 'creditsafe API' ORDER BY ba_Datum DESC", "FMZOLL") If currentBonID <> "" AndAlso IsNumeric(currentBonID) AndAlso currentBonID > 0 Then company.csBonID = currentBonID End If createEvents(R, company.kdNr, company, CL, CR, CL_Datum, CR_Datum, "E") Next End If '-------------------------------------------------------------------- If companychanges Then If dtKundenNr.Rows.Count > 0 Then For Each row As DataRow In dtKundenNr.Rows Dim KUNDE As New cKunde(row("ba_KundenNr")) company.kdNr = row("ba_KundenNr") company.creditSafeId = R("companyId") firma = row("Firma") updateKundenWithEvent(KUNDE, company, CL, CR, CL_Datum, CR_Datum, setzeKundenbesonderheiten, defaultCR, defaultCL, updateKunden, sendMail, triggerMail, Mailtext, firma) If company.kdNr <> 0 Then If triggerMail AndAlso sendMail AndAlso Mailtext <> "" Then Dim ADR As New cAdressen(company.kdNr) Dim empfanegerMail = "" For Each firmRowTemp As DataRow In dtFirmen.Rows Select Case firmRowTemp("Firma") Case "VERAG" : empfanegerMail = "as@verag.ag" Case "IMEX" : empfanegerMail = "Viktoria.Leirich@imex-group.at" 'Case "AMBAR" : empfanegerMail = "Buchhaltung@ambarlog.com" 'Case "UNISPED" : empfanegerMail = "sabine.muehlboeck@unisped.at" End Select If VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM Then empfanegerMail = "d.breimaier@verag.ag" If empfanegerMail <> "" Then VERAG_PROG_ALLGEMEIN.cProgramFunctions.sendMail(empfanegerMail, IIf(VERAG_PROG_ALLGEMEIN.cAllgemein.TESTSYSTEM, "TEST-", "") & "CREDITSAFE " & KUNDE.KundenNr & " (" & firmRowTemp("Firma") & ")", "Änderungen der Creditsafe-Daten von Kunden " & KUNDE.KundenNr & " " & ADR.Ordnungsbegriff & Mailtext.ToString & "

" & "*Automatic generated e-mail*",,,,, "d.breimaier@verag.ag") Next Mailtext = "" End If End If Next End If 'wichtig, alles wieder zurücksetzen!!!!! CL = defaultCL CR = defaultCR CL_Datum = company.lastChecked CR_Datum = company.lastChecked company.kdNr = 0 triggerMail = False Mailtext = "" company.BANKRUPT_REGISTERED = False End If '-------------------------------------------------------------------- j = j + 1 End While Return "Anzahl gefundener Datensätze: " & numCompanies End Function Private Shared Sub resetValues(com As Company) End Sub Private Shared Sub updateKundenWithEvent(KUNDE As cKunde, company As Company, CL As Integer, CR As Integer, CL_Datum As Date, CR_Datum As Date, setzeKundenbesonderheiten As Boolean, defaultCR As Integer, defaultCL As Integer, updateKunden As Boolean, sendMail As Boolean, ByRef triggerMail As Boolean, ByRef MailText As String, Optional firma As String = "VERAG") If company.kdNr > 0 AndAlso (CR <> -1000000 Or CL <> -1000000) Then If KUNDE.Bonitätsdatum <= CL_Datum Or KUNDE.Bonitätsdatum <= CR_Datum Then Dim Index As Double = -1 Dim ADR As New cAdressen(KUNDE.KundenNr) Dim riskClass As String = "" Dim riskClassChanged As Boolean = False Dim KUNDE_ERW As New cKundenErweitert(KUNDE.KundenNr) 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)) Else 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 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 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 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 If updateKunden Then KUNDE.SAVE() End If End Sub Private Shared Sub createEvents(R As DataRow, KundeNr As Integer, company As Company, ByRef CL As Integer, ByRef CR As Integer, ByRef CL_Datum As Date, ByRef CR_Datum As Date, ByRef Importtype As String) Dim cEvent As New cCreditsafeEvent(CLng(R("eventId")), KundeNr) Dim globaleventcode As String = "" If Not IsDBNull(R("globalEventCode")) Then globaleventcode = R("globalEventCode").trim() ElseIf Not IsDBNull(R("localEventCode")) Then Select Case R("localEventCode").trim() Case "DECREASE_LIMIT", "INCREASE_LIMIT", "CL" : globaleventcode = "CL" Case "DECREASE_RATING", "INCREASE_RATING", "CR" : globaleventcode = "CR" Case "55" : If R("companyId").ToString.StartsWith("NL") Then globaleventcode = "CR" 'nur Holland! Case "56" : If R("companyId").ToString.StartsWith("NL") Then globaleventcode = "CL" 'nur Holland! End Select End If If globaleventcode = "" Then If Not IsDBNull(R("ruleName")) AndAlso R("ruleName").ToString.Contains("Limit") Then globaleventcode = "CL" If Not IsDBNull(R("ruleName")) AndAlso R("ruleName").ToString.Contains("International Score") Then globaleventcode = "CR" End If cEvent.eventId = R("eventId") cEvent.companyId = R("companyId") cEvent.portfolioId = R("portfolioId") cEvent.ruleName = R("ruleName") cEvent.localEventCode = R("localEventCode").trim() cEvent.globalEventCode = globaleventcode cEvent.eventDate = R("eventDate") cEvent.createdDate = R("createdDate") cEvent.importDate = Now() cEvent.Sachbearbeiter = IIf(VERAG_PROG_ALLGEMEIN.cAllgemein.USRKURZNAME Is Nothing, "AUTO", VERAG_PROG_ALLGEMEIN.cAllgemein.USRKURZNAME) cEvent.oldValue = R("oldValue") cEvent.newValue = R("newValue") 'OLD-VALUES If cEvent.oldValue IsNot Nothing AndAlso IsNumeric(cEvent.oldValue) AndAlso Not cEvent.oldValue.ToString.Contains("€") Then If cEvent.localEventCode = "CL" Or cEvent.globalEventCode = "CL" Then cEvent.oldValueCL = cEvent.oldValue ElseIf cEvent.localEventCode = "CR" Or cEvent.globalEventCode = "CR" Then cEvent.oldValueCR = cEvent.oldValue cEvent.oldValueCRIndex = calculatedBonIndexFromBonScore(cEvent.oldValue, cEvent.oldRiskClass) End If Else If cEvent.localEventCode = "CL" Or cEvent.globalEventCode = "CL" Then cEvent.oldValue = Regex.Replace(cEvent.oldValue, "\s+", "") cEvent.oldValue = Regex.Replace(cEvent.oldValue, "[^\d]", "") cEvent.oldValueCL = cEvent.oldValue ElseIf cEvent.localEventCode = "CR" Or cEvent.globalEventCode = "CR" Then cEvent.oldValue = Regex.Replace(cEvent.oldValue, "\s+", "") cEvent.oldValue = Regex.Replace(cEvent.oldValue, "[^\d]", "") cEvent.oldValueCR = cEvent.oldValue cEvent.oldValueCRIndex = calculatedBonIndexFromBonScore(cEvent.oldValue, cEvent.oldRiskClass) End If End If 'NEW-VALUES If cEvent.newValue IsNot Nothing AndAlso IsNumeric(cEvent.newValue) AndAlso Not cEvent.newValue.ToString.Contains("€") Then If cEvent.localEventCode = "CL" Or cEvent.globalEventCode = "CL" Then cEvent.newValueCL = cEvent.newValue setCL_CR_Entry(CDate(cEvent.eventDate), "CL", cEvent.newValueCL, CL, CR, CL_Datum, CR_Datum) ElseIf cEvent.localEventCode = "CR" Or cEvent.globalEventCode = "CR" Then cEvent.newValueCR = cEvent.newValue cEvent.newValueCRIndex = calculatedBonIndexFromBonScore(cEvent.newValue, cEvent.newRiskClass) setCL_CR_Entry(CDate(cEvent.eventDate), "CR", cEvent.newValueCR, CL, CR, CL_Datum, CR_Datum) End If Else If cEvent.localEventCode = "CL" Or cEvent.globalEventCode = "CL" Then cEvent.newValue = Regex.Replace(cEvent.newValue, "\s+", "") cEvent.newValue = Regex.Replace(cEvent.newValue, "[^\d]", "") cEvent.newValueCL = cEvent.newValue setCL_CR_Entry(CDate(cEvent.eventDate), "CL", cEvent.newValueCL, CL, CR, CL_Datum, CR_Datum) ElseIf cEvent.localEventCode = "CR" Or cEvent.globalEventCode = "CR" Then cEvent.newValue = Regex.Replace(cEvent.newValue, "\s+", "") cEvent.newValue = Regex.Replace(cEvent.newValue, "[^\d]", "") cEvent.newValueCR = cEvent.newValue cEvent.newValueCRIndex = calculatedBonIndexFromBonScore(cEvent.newValue, cEvent.newRiskClass) setCL_CR_Entry(CDate(cEvent.eventDate), "CR", cEvent.newValueCR, CL, CR, CL_Datum, CR_Datum) End If End If If cEvent.localEventCode = "BANKRUPT_REGISTERED" Or cEvent.globalEventCode = "PR" Then setBANCKRUPT_Entry(company, cEvent.eventDate) End If If cEvent.bonId Is Nothing AndAlso company.csBonID > 0 Then cEvent.bonId = company.csBonID End If 'cEvent.kundenNr = company.kdNr 'die Events sind besser strukturiert als die EventDetails, somit soll ein bereits bestehender Eintrag der über die Events importiert werden nicht von einem Eventdetail überschrieben werden!!! If Not (cEvent.hasEntry AndAlso Importtype = "ED") Then cEvent.SAVE() End If End Sub Private Shared Sub setCL_CR_Entry(ByVal cs_date As Date, ByVal type As String, ByRef value As Object, ByRef CL As Double, ByRef CR As Integer, ByRef CL_Datum As Date, ByRef CR_Datum As Date) Select Case type Case "CR" Dim saveCR As Boolean = False If CR_Datum <= cs_date Then CR_Datum = cs_date saveCR = True End If If saveCR AndAlso IsNumeric(value) Then CR = value End If Case "CL" Dim saveCL As Boolean = False If CL_Datum <= cs_date Then CL_Datum = cs_date saveCL = True End If If saveCL AndAlso IsNumeric(value) Then CL = value End If End Select End Sub Private Shared Sub setBANCKRUPT_Entry(company As Company, ByVal BK_date As Date) If company.kdNr > 0 Then company.BANKRUPT_REGISTERED = True company.BANKRUPT_REGISTERED_DATE = BK_date End If End Sub Shared Function getReport(ByRef company As Company, withPDF As Boolean) As String 'Shared Function getReport(ByRef company As Company, withPDF As Boolean, ByRef bytes As Byte()) As String Dim failureDesc As String = "" Dim myUrl As String = API_STRING & "/v1/companies/" & company.creditSafeId & "/" If company.country = "DE" Then 'Abfragen für DE benötigen einen Reason-Code myUrl &= "?customData=de_reason_code::3" myUrl &= "&?language=DE" ElseIf company.country = "AT" Then myUrl &= "?language=DE" Else myUrl &= "?language=EN" End If Dim acceptContentType = "application/json" 'If withPDF Then ' acceptContentType &= "+pdf" 'End If Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, Nothing, acceptContentType, "GET", token, failureDesc,,, "getReport") If failureDesc <> "" Then Return failureDesc Dim json As New Chilkat.JsonObject Dim success As Boolean = json.Load(jsonRespString) If (success <> True) Then Return "Verbindungsfehler" Dim reportObj As Chilkat.JsonObject = json.ObjectOf("report") If (json.LastMethodSuccess = True) Then 'If company.country = "DE" Then ' nur bei DE ausführen! Dim companyAddInformObj As Chilkat.JsonObject = reportObj.ObjectOf("additionalInformation") If (reportObj.LastMethodSuccess = True) And companyAddInformObj IsNot Nothing Then Dim turnoverArray As Chilkat.JsonArray = companyAddInformObj.ArrayOf("turnoverRanges") If (companyAddInformObj.LastMethodSuccess = True) And turnoverArray IsNot Nothing Then Dim turnover As Chilkat.JsonObject = turnoverArray.ObjectAt(0) company.csTurnover = turnover.StringOf("range") & " (" & turnover.StringOf("year") & ")" Else Debug.WriteLine("additionalInformationObject object not found.") End If End If If (reportObj.LastMethodSuccess = True) And companyAddInformObj IsNot Nothing Then Dim companyMiscObj As Chilkat.JsonObject = companyAddInformObj.ObjectOf("misc") If companyMiscObj IsNot Nothing AndAlso companyMiscObj.LastMethodSuccess = True Then company.csBusinessPurpose = companyMiscObj.StringOf("businessPurpose") If (companyAddInformObj.LastMethodSuccess = True) Then Dim deCurrentRatingObj As Chilkat.JsonObject = companyMiscObj.ObjectOf("deCurrentRating") If (companyAddInformObj.LastMethodSuccess = True) And deCurrentRatingObj IsNot Nothing Then If (deCurrentRatingObj.LastMethodSuccess = True) Then company.csIndex = deCurrentRatingObj.StringOf("value") Else Debug.WriteLine("deCurrentRatingObj.value not found.") End If Debug.WriteLine("deCurrentRatingObj object not found.") End If Debug.WriteLine("businessPurpose object not found.") End If Debug.WriteLine("companyMiscObj object not found.") End If Debug.WriteLine("reportObj object not found.") End If 'End If Dim companyIDObj As Chilkat.JsonObject = reportObj.ObjectOf("companyIdentification") If (reportObj.LastMethodSuccess = True) And companyIDObj IsNot Nothing Then Dim basicInfoObj As Chilkat.JsonObject = companyIDObj.ObjectOf("basicInformation") If (companyIDObj.LastMethodSuccess = True) And basicInfoObj IsNot Nothing Then Dim dateTime As New Chilkat.CkDateTime Dim getAsLocal As Boolean = False basicInfoObj.DateOf("companyRegistrationDate", dateTime) company.csDFoundingDate = dateTime.GetAsTimestamp(getAsLocal) Debug.WriteLine(dateTime) company.vatNo = basicInfoObj.StringOf("vatRegistrationNumber") Dim principalActivityObj As Chilkat.JsonObject = basicInfoObj.ObjectOf("principalActivity") If (basicInfoObj.LastMethodSuccess = True) And company.csBusinessPurpose = "" Then company.csBusinessPurpose = principalActivityObj.StringOf("industrySector") & " - " & principalActivityObj.StringOf("description") Else Debug.WriteLine("principalActivityObj object not found.") End If Else Debug.WriteLine("basicInfoObj object not found.") End If Else Debug.WriteLine("companyIDObj object not found.") End If Dim otherInformationObject As Chilkat.JsonObject = reportObj.ObjectOf("otherInformation") Dim creditScoreObj As Chilkat.JsonObject = reportObj.ObjectOf("creditScore") If (reportObj.LastMethodSuccess = True) Then If otherInformationObject IsNot Nothing Then Dim employeesInformationsArray As Chilkat.JsonArray = otherInformationObject.ArrayOf("employeesInformation") If (otherInformationObject.LastMethodSuccess = True) And employeesInformationsArray IsNot Nothing Then Dim employees As Chilkat.JsonObject = employeesInformationsArray.ObjectAt(0) company.csSumEmployees = employees.StringOf("numberOfEmployees") Else Debug.WriteLine("otherInformationObject object not found.") End If Dim bankersArray As Chilkat.JsonArray = otherInformationObject.ArrayOf("bankers") If (otherInformationObject.LastMethodSuccess = True) And bankersArray IsNot Nothing Then Dim bankers As Chilkat.JsonObject = bankersArray.ObjectAt(0) company.csBank = bankers.StringOf("name") & " - " & bankers.StringOf("bankCode") Else Debug.WriteLine("otherInformationObject object not found.") End If End If Dim creditRatingObj As Chilkat.JsonObject = creditScoreObj.ObjectOf("currentCreditRating") If (creditScoreObj.LastMethodSuccess = True) And creditRatingObj IsNot Nothing Then company.csRiskclass = creditRatingObj.StringOf("commonValue") Dim creditLimitObj As Chilkat.JsonObject = creditRatingObj.ObjectOf("creditLimit") If (creditRatingObj.LastMethodSuccess = True) And creditLimitObj IsNot Nothing Then company.csMaxCreditAmount = creditLimitObj.StringOf("value") Else Debug.WriteLine("creditRating object not found.") End If Dim providerValueObj As Chilkat.JsonObject = creditRatingObj.ObjectOf("providerValue") If (creditRatingObj.LastMethodSuccess = True) And providerValueObj IsNot Nothing Then company.csScore = providerValueObj.StringOf("value") Else Debug.WriteLine("providerValue object not found.") End If Else Debug.WriteLine("currentCreditRating object not found.") End If Dim directorsObj As Chilkat.JsonObject = reportObj.ObjectOf("directors") ' Dim currentDirectorsArray As Chilkat.JsonArray = directorsObj.ArrayOf("currentDirectors") Dim currentDirectorsArray As Chilkat.JsonArray = json.ArrayOf("report.directors.currentDirectors") If currentDirectorsArray IsNot Nothing AndAlso (directorsObj IsNot Nothing AndAlso directorsObj.LastMethodSuccess = True) Then Dim i = 0 Dim count_i = json.SizeOfArray("report.directors.currentDirectors") While i < count_i json.I = i company.csCEO = json.StringOf("report.directors.currentDirectors[i].name") company.csCEO &= "( " & json.StringOf("report.directors.currentDirectors[i].directorType") & ") " i = i + 1 End While End If Else Debug.WriteLine("creditScore object not found.") Return "creditScore object not found" End If Else company.csFailure = json.StringOf("details") End If Return failureDesc End Function Shared Function getPDF(ByVal company As Company, ByRef failure As String) As Byte() Dim myUrl As String = API_STRING & "/v1/companies/" & company.creditSafeId & "/" If company.country = "DE" Then 'Abfragen für DE benötigen einen Reason-Code myUrl &= "?customData=de_reason_code::3" myUrl &= "&?language=DE" Else myUrl &= "?language=EN" End If Dim acceptContentType = "application/pdf" Dim pdfData2 As New Chilkat.BinData Dim failureDesc As String = "" Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, Nothing, acceptContentType, "GET", token, failureDesc,,, "getPDF") If failureDesc <> "" Then Dim jsonFailure As New Chilkat.JsonObject Dim success As Boolean = jsonFailure.Load(jsonRespString) If (success <> True) Then failure = jsonFailure.LastErrorText Return Nothing End If failure = jsonFailure.StringOf("details") Return Nothing End If If jsonRespString IsNot Nothing Then Dim success = pdfData2.AppendEncoded(jsonRespString, "base64") If success Then Return pdfData2.GetBinary End If Return Nothing End If Return Nothing End Function Public Function getSubscriptionCountries(dtSunscriptions As DataTable) As String VERAG_PROG_ALLGEMEIN.cChilkat_Helper.UnlockCilkat() If apiSettingsloaded = False Then Return "400" Dim rest As New Chilkat.Rest Dim success As Boolean Dim company Dim failureDesc As String Dim myUrl As String = API_STRING & "/v1/access" Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, company, "application/json", "GET", token, failureDesc,,, "getSubscriptionCountries") Dim json As New Chilkat.JsonObject success = json.Load(jsonRespString) If dtSunscriptions.Columns.Count = 0 Then dtSunscriptions.Columns.Add("countryName", GetType(String)) dtSunscriptions.Columns.Add("templateName", GetType(String)) dtSunscriptions.Columns.Add("countryIso2", GetType(String)) dtSunscriptions.Columns.Add("startDate", GetType(DateTime)) dtSunscriptions.Columns.Add("expireDate", GetType(DateTime)) dtSunscriptions.Columns.Add("paid", GetType(Integer)) dtSunscriptions.Columns.Add("used", GetType(Integer)) End If dtSunscriptions.Rows.Clear() Dim correlationId As String = json.StringOf("correlationId") Dim i As Integer = 0 Dim count_i As Integer = json.SizeOfArray("countryAccess.creditsafeConnectOnlineReports") While i < count_i json.I = i Dim R As DataRow = dtSunscriptions.NewRow R("countryName") = json.StringOf("countryAccess.creditsafeConnectOnlineReports[i].countryName") R("templateName") = json.StringOf("countryAccess.creditsafeConnectOnlineReports[i].templateName") R("countryIso2") = json.StringOf("countryAccess.creditsafeConnectOnlineReports[i].countryIso2") R("startDate") = json.StringOf("countryAccess.creditsafeConnectOnlineReports[i].startDate") R("expireDate") = json.StringOf("countryAccess.creditsafeConnectOnlineReports[i].expireDate") R("paid") = json.IntOf("countryAccess.creditsafeConnectOnlineReports[i].paid") R("used") = json.IntOf("countryAccess.creditsafeConnectOnlineReports[i].used") dtSunscriptions.Rows.Add(R) i = i + 1 End While Return "Anzahl gefundener Datensätze: " & i End Function 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 Select Case type Case "getCompanyEvents" rest.AddQueryParam("sortBy", "companyName") rest.AddQueryParam("sortDir", "asc") If company.lastChecked >= Today.AddYears(-50) Then rest.AddQueryParam("startDate", company.lastChecked.ToString("yyyy-MM-ddTHH:mm:ss")) rest.AddQueryParam("endDate", Now().ToString("yyyy-MM-ddTHH:mm:ss")) rest.AddQueryParam("filterByCreatedDate", "true") rest.AddQueryParam("pageSize", "1000") 'maximum rest.AddQueryParam("page", page) 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 If setCompanyQueryParam Then rest.AddQueryParam("countries", company.country) If company.creditsafeNo <> "" Then 'Eindeutiger Schlüssel rest.AddQueryParam("safeNo", company.creditsafeNo) Else If company.language <> "" Then rest.AddQueryParam("language", company.language) If company.vatNo <> "" Then rest.AddQueryParam("vatNo", company.vatNo) Else If company.name <> "" Then rest.AddQueryParam("name", company.name) If company.Street <> "" Then rest.AddQueryParam("street", company.Street) If company.Postalcode <> "" Then rest.AddQueryParam("postCode", company.Postalcode) If company.City <> "" Then rest.AddQueryParam("city", company.City) End If End If End If End If End Sub Shared Function checkDateOfLastRequest(company As Company) As Date Dim failureDesc As String Dim myUrl As String = API_STRING & "/v1/companies" Dim jsonRespString = SendGetRequestWithAuthHeader(myUrl, company, "application/json", "GET", token, failureDesc,,, "checkDateOfLastRequest") Dim json As New Chilkat.JsonObject Dim success As Boolean = json.Load(jsonRespString) If (success <> True) Then Debug.WriteLine(json.LastErrorText) Return New Date() End If Dim companies As Chilkat.JsonArray = json.ArrayOf("companies") If companies IsNot Nothing Then Dim compObj As Chilkat.JsonObject = companies.ObjectAt(0) Dim dateTime As New Chilkat.CkDateTime Dim dt As New Chilkat.DtObj Dim getAsLocal As Boolean = False success = compObj.DateOf("dateOfLatestChange", dateTime) Debug.WriteLine(dateTime.GetAsTimestamp(getAsLocal)) Return dateTime.GetAsTimestamp(getAsLocal) Else Return New Date("01.01.1900") End If End Function Shared Function calculatedBonIndexFromBonScore(score As Object, ByRef riskClass As String) As Double If score Is Nothing OrElse Not IsNumeric(score) Then Return -1 Select Case score Case 91 To 100 riskClass = "A" Case 81 To 90 riskClass = "A" Case 71 To 80 riskClass = "B" Case 61 To 70 riskClass = "B" Case 51 To 60 riskClass = "C" Case 35 To 50 riskClass = "C" Case 25 To 34 riskClass = "D" Case 15 To 24 riskClass = "D" Case 1 To 14 riskClass = "D" Case -10000000 riskClass = "" Case Else riskClass = "E" End Select Select Case score Case 0 Return 6 Case 1 To 10 Return 5 Case 11 To 12 Return 4.9 Case 13 To 14 Return 4.8 Case 15 To 16 Return 4.7 Case 17 To 18 Return 4.6 Case 19 To 20 Return 4.5 Case 21 To 22 Return 4.4 Case 23 To 25 Return 4.3 Case 26 To 28 Return 4.2 Case 29 To 31 Return 4.1 Case 32 To 34 Return 4 Case 35 To 38 Return 3.9 Case 39 To 41 Return 3.8 Case 42 To 44 Return 3.7 Case 45 To 47 Return 3.6 Case 48 To 50 Return 3.5 Case 51 To 52 Return 3.4 Case 53 To 54 Return 3.3 Case 55 To 56 Return 3.2 Case 57 To 58 Return 3.1 Case 59 To 60 Return 3 Case 61 To 62 Return 2.9 Case 63 To 64 Return 2.8 Case 65 To 66 Return 2.7 Case 67 To 68 Return 2.6 Case 69 To 70 Return 2.5 Case 71 To 72 Return 2.4 Case 73 To 74 Return 2.3 Case 75 To 76 Return 2.2 Case 77 To 78 Return 2.1 Case 79 To 80 Return 2 Case 81 To 82 Return 1.9 Case 83 To 84 Return 1.8 Case 85 To 86 Return 1.7 Case 87 To 88 Return 1.6 Case 89 To 90 Return 1.5 Case 91 To 92 Return 1.4 Case 93 To 94 Return 1.3 Case 95 To 96 Return 1.2 Case 97 To 98 Return 1.1 Case 99 To 100 Return 1 Case -10000000 Return -1 Case Else Return 6 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, Optional company As Company = Nothing) 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 'Index höher ist schlechter!!! 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 "B-SCORE" oldValue = kundeErw.kde_CreditSaveBonitaetsScore 'LIMITs DEFINIEREN 'Score höher ist besser If Not (oldValue = defaultOldValue) Then changedInProzent = calcChange(oldValue, newValue) End If If changedInProzent > infoAbxProzentVerschlechertung AndAlso oldValue > newValue Or risikoklasse = "E" Then createInfo = True If changedInProzent > infoAbxProzentVerschlechertungMailInfo AndAlso oldValue > newValue Or risikoklasse = "E" 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 Or changedInProzent > infoAbxProzentVerschlechertung Then createInfo = True If newValue = 0 Or changedInProzent > infoAbxProzentVerschlechertungMailInfo Then triggerMail = True Case "BANKRUPT_REGISTERED" createInfo = True triggerMail = True End Select If Not createInfo Then Exit Sub Dim Risk As String = "" If oldRiksClass <> "" Then Risk = " Risikoklasse: " & oldRiksClass & " -> " & risikoklasse End If Dim textVermerk As String = "" Select Case typ Case "B-INDEX", "B-SCORE" : textVermerk &= "ACHTUNG, Veränderung des " & typ & " von " & oldValue.ToString & " auf " & newValue.ToString & " ( um " & changedInProzent.ToString("F2") & "% ) " & Risk Case "KREDITLIMIT" : textVermerk &= "ACHTUNG, Veränderung des " & typ & " auf " & newValue.ToString & " ( um " & changedInProzent.ToString("F2") & "% ) " Case "BANKRUPT_REGISTERED" : textVermerk &= " KUNDE WURDE LAUT CREDITSAFE " & IIf(company IsNot Nothing, " AM " & company.BANKRUPT_REGISTERED_DATE.ToShortDateString, "") & " FÜR INSOLVENT ERKLÄRT " & Risk End Select 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 Public Class CreditSafeUser Public Property username As String Public Property password As String Public Property token As String Public Sub New(_username As String, _password As String) username = _username password = _password End Sub Public Sub New(_username As String, _password As String, _token As String) username = _username password = _password End Sub End Class Public Class Company Public Property creditSafeId As String Public Property name As String Public Property kdNr As Integer Public Property vatNo As String Public Property country As String Public Property creditsafeNo As String Public Property lastChecked As Date Public Property City As String Public Property Postalcode As String Public Property Street As String Public Property csIndex As String Public Property csScore As String Public Property csRiskclass As String Public Property csMaxCreditAmount As String Public Property csDFoundingDate As Date Public Property csPDF As String Public Property csFailure As String Public Property csSumEmployees As String Public Property csBusinessPurpose As String Public Property csShareholder As String Public Property csCEO As String Public Property csTurnover As String Public Property language As String Public Property csBank As String Public Property csBonID As Integer = -1 Public Property BANKRUPT_REGISTERED As Boolean = False Public Property BANKRUPT_REGISTERED_DATE As Date Public Sub New(_language As String, _name As String, _vatNo As String, _country As String, _creditsafeNo As String, _creditSafeId As String, _lastChecked As Date, _street As String, _postalCode As String, _city As String, _sumEmployees As String, _businessPurpose As String, _shareholder As String, _ceo As String, _bank As String, _csTurnover As String, _kdNr As Integer) creditSafeId = _creditSafeId name = _name vatNo = _vatNo country = _country creditsafeNo = _creditsafeNo lastChecked = _lastChecked Street = _street Postalcode = _postalCode City = _city csSumEmployees = _sumEmployees csBusinessPurpose = _businessPurpose csShareholder = _shareholder csCEO = _ceo csBank = _bank language = _language csTurnover = _csTurnover kdNr = _kdNr End Sub Public Sub New() End Sub End Class Public Class cCreditsafeEvent Property eventId As Long Property companyId As Object = Nothing Property portfolioId As Object = Nothing Property ruleName As Object = Nothing Property localEventCode As Object = Nothing Property globalEventCode As Object = Nothing Property oldValue As Object = Nothing Property newValue As Object = Nothing Property eventDate As Object = Nothing Property createdDate As Object = Nothing Property importDate As Object = Nothing Property bonId As Object = Nothing Property Sachbearbeiter As Object = Nothing Property oldValueCR As Object = Nothing Property newValueCR As Object = Nothing Property oldValueCL As Object = Nothing Property newValueCL As Object = Nothing Property kundenNr As Integer Property newValueCRIndex As Object = Nothing Property oldValueCRIndex As Object = Nothing Property oldRiskClass As String Property newRiskClass As String Public hasEntry = False Sub New(eventId) Me.eventId = eventId LOAD() End Sub Sub New(eventId_, kundenNr_) 'zwei unterschiedliche KundenNr können dieselbe eventID besitzen (weil bei uns alles tlw. doppelt angelegt ist!!!!!) Me.eventId = eventId_ kundenNr = kundenNr_ LOADKDNR() End Sub Function getParameterList() As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) Dim list As New List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) 'list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("eventId", eventId,, True)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("eventId", eventId)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("companyId", companyId)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("portfolioId", portfolioId)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("ruleName", ruleName)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("localEventCode", localEventCode)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("globalEventCode", globalEventCode)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("oldValue", oldValue)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("newValue", newValue)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("eventDate", eventDate)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("createdDate", createdDate)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("importDate", importDate)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("bonId", bonId)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("Sachbearbeiter", Sachbearbeiter)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("oldValueCR", oldValueCR)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("newValueCR", newValueCR)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("oldValueCL", oldValueCL)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("newValueCL", newValueCL)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("kundenNr", kundenNr)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("newValueCRIndex", newValueCRIndex)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("oldValueCRIndex", oldValueCRIndex)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("oldRiskClass", oldRiskClass)) list.Add(New VERAG_PROG_ALLGEMEIN.SQLVariable("newRiskClass", newRiskClass)) Return list End Function Public Function SAVE() As Boolean Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList() Dim sqlstr = " BEGIN TRAN IF EXISTS(SELECT * FROM tblCreditsafeEvents WHERE eventId=@eventId AND kundenNr=@kundenNr) " & " BEGIN " & getUpdateCmd() & " END " & " Else " & " BEGIN " & getInsertCmd() & " END " & " commit tran " Return SQL.doSQLVarList(sqlstr, "FMZOLL", , list) End Function Public Sub LOAD() Try hasEntry = False Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL() Using cmd As New SqlCommand("SELECT * FROM tblCreditsafeEvents WHERE eventId=@eventId ", conn) cmd.Parameters.AddWithValue("@eventId", eventId) Dim dr = cmd.ExecuteReader() If dr.Read Then For Each li In getParameterList() Dim propInfo As PropertyInfo = Me.GetType.GetProperty(li.Scalarvariable) If dr.Item(li.Text) Is DBNull.Value Then propInfo.SetValue(Me, Nothing) Else propInfo.SetValue(Me, dr.Item(li.Text)) End If Next hasEntry = True End If dr.Close() End Using End Using Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try End Sub Public Sub LOADKDNR() Try hasEntry = False Using conn As SqlConnection = SQL.GetNewOpenConnectionFMZOLL() Using cmd As New SqlCommand("SELECT * FROM tblCreditsafeEvents WHERE eventId=@eventId AND kundenNr=@kundenNr ", conn) cmd.Parameters.AddWithValue("@eventId", eventId) cmd.Parameters.AddWithValue("@kundenNr", kundenNr) Dim dr = cmd.ExecuteReader() If dr.Read Then For Each li In getParameterList() Dim propInfo As PropertyInfo = Me.GetType.GetProperty(li.Scalarvariable) If dr.Item(li.Text) Is DBNull.Value Then propInfo.SetValue(Me, Nothing) Else propInfo.SetValue(Me, dr.Item(li.Text)) End If Next hasEntry = True End If dr.Close() End Using End Using Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try End Sub Public Function getUpdateCmd() As String Try Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList() Dim str As String = "" For Each i In list If Not i.isPrimaryParam Then str &= "[" & i.Text & "] = @" & i.Scalarvariable & "," '.Replace("-", "").Replace(" ", "") & "," End If Next str = str.Substring(0, str.Length - 1) 'wg. ',' Return (" UPDATE tblCreditsafeEvents SET " & str & " WHERE eventId=@eventId AND kundenNr=@kundenNr") Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Return "" End Function Public Function getInsertCmd() As String Try Dim list As List(Of VERAG_PROG_ALLGEMEIN.SQLVariable) = getParameterList() Dim str As String = "" Dim values As String = "" For Each i In list 'If Not i.isPrimaryParam Then str &= "[" & i.Text & "]," values &= "@" & i.Scalarvariable & "," '.Replace("-", "").Replace(" ", "") & "," 'End If Next str = str.Substring(0, str.Length - 1) 'wg. ',' values = values.Substring(0, values.Length - 1) 'wg. ',' Return (" INSERT INTO tblCreditsafeEvents (" & str & ") VALUES(" & values & ") ") Catch ex As Exception VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodInfo.GetCurrentMethod.Name) End Try Return "" End Function End Class End Class