Imports System.Net Imports System.Threading Imports Chilkat 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 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") 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 rest As New Chilkat.Rest 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) As String Try VERAG_PROG_ALLGEMEIN.cChilkat_Helper.UnlockCilkat() Dim rest As New Chilkat.Rest 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 rest.ClearAllQueryParams() If company IsNot Nothing Then setSearchParam(rest, company) End If rest.AddHeader("Content-Type", "application/json") rest.AddHeader("Authorization", "Bearer " & authenticationToken) rest.AddHeader("Accept", acceptContentType) Dim responseJson As String Dim pdfData As New Chilkat.BinData If acceptContentType.Contains("application/pdf") 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 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 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) 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 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) 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) 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() As String VERAG_PROG_ALLGEMEIN.cChilkat_Helper.UnlockCilkat() If apiSettingsloaded = False Then Return "400" Dim rest As New Chilkat.Rest Dim success As Boolean rest.AddHeader("Authorization", "Bearer ") Dim sbResponseBody As New Chilkat.StringBuilder success = rest.FullRequestNoBodySb("GET", "/v1/access", sbResponseBody) If (success <> True) Then Return 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(sbResponseBody.GetAsString()) Return respStatusCode & " " & sbResponseBody.GetAsString() End If Dim jsonResponse As New Chilkat.JsonObject jsonResponse.LoadSb(sbResponseBody) jsonResponse.EmitCompact = False Debug.WriteLine(jsonResponse.Emit()) End Function Shared Sub setSearchParam(ByRef rest As Chilkat.Rest, ByRef company As Company) 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 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) 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 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 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 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) 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 End Sub Public Sub New() End Sub End Class End Class