edv/SDL
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
357af8ab51fb13e5cf34b0b5b863dac378805424
SDL/VERAG_PROG_ALLGEMEIN/Schnittstellen/Creditsafe/cCreditSafeAPI.vb

1983 lines
80 KiB
VB.net
Raw Blame History

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") 'nicht notwendig!!! - wird automatisch gesetzt
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.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 & "<br><br>" & "*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 & "<br><br>" & "*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 &= "<br><br>" & 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
Reference in New Issue View Git Blame Copy Permalink