DHF Artikel API; AuditFlow
This commit is contained in:
241
VERAG_PROG_ALLGEMEIN/Classes/cKundenMatchResult.vb
Normal file
241
VERAG_PROG_ALLGEMEIN/Classes/cKundenMatchResult.vb
Normal file
@@ -0,0 +1,241 @@
|
||||
Imports System.Data.SqlClient
|
||||
Imports System.Globalization
|
||||
Imports System.Text
|
||||
Imports System.Text.RegularExpressions
|
||||
Imports com.sun.org.apache.bcel.internal.generic
|
||||
|
||||
Public Class KundeMatchResult
|
||||
Public Property KundId As Integer?
|
||||
Public Property Score As Double
|
||||
Public Property MatchType As String ' "VAT", "EORI", "BOTH", "FUZZY", "NONE"
|
||||
Public Property Firma As String
|
||||
Public Property Strasse As String
|
||||
Public Property PLZ As String
|
||||
Public Property Ort As String
|
||||
Public Property LandKz As String
|
||||
Public Property VATNr As String
|
||||
Public Property EORINr As String
|
||||
End Class
|
||||
|
||||
Public Module KundenMatcher
|
||||
|
||||
' Haupteinstieg
|
||||
Public Function FindKunde(ByVal firma As String,
|
||||
ByVal strasse As String,
|
||||
ByVal plz As String,
|
||||
ByVal ort As String,
|
||||
ByVal landISO As String,
|
||||
Optional ByVal vatNr As String = Nothing,
|
||||
Optional ByVal eoriNr As String = Nothing,
|
||||
Optional ByVal minFuzzyScore As Double = 0.7) As KundeMatchResult
|
||||
|
||||
' 1) Harte (exakte) Matches über VAT/EORI — 100% required
|
||||
Dim exact = FindExactByVatEori(vatNr, eoriNr)
|
||||
If exact IsNot Nothing Then
|
||||
Return exact
|
||||
End If
|
||||
Dim LandKz = VERAG_PROG_ALLGEMEIN.cProgramFunctions.getISO1Land(landISO)
|
||||
|
||||
' 2) Fuzzy-Match auf Firma + Adresse
|
||||
Dim candidates = LoadFuzzyCandidates(firma, plz, ort, LandKz)
|
||||
If candidates.Count = 0 Then
|
||||
Return New KundeMatchResult With {.MatchType = "NONE", .Score = 0}
|
||||
End If
|
||||
|
||||
Dim normFirma = NormalizeForCompare(firma)
|
||||
Dim normStrasse = NormalizeForCompare(strasse)
|
||||
Dim normOrt = NormalizeForCompare(ort)
|
||||
Dim best As KundeMatchResult = Nothing
|
||||
|
||||
For Each c In candidates
|
||||
Dim fScore = Similarity(normFirma, NormalizeForCompare(c.Firma))
|
||||
Dim sScore = Similarity(normStrasse, NormalizeForCompare(c.Strasse))
|
||||
Dim oScore = Similarity(normOrt, NormalizeForCompare(c.Ort))
|
||||
|
||||
' Gewichtung nach Praxis: Name wichtiger als Straße, Ort mittel
|
||||
Dim score = 0.5 * fScore + 0.3 * sScore + 0.2 * oScore
|
||||
|
||||
' Bonus/Malus für PLZ/Land-Genauigkeit
|
||||
If SafeEquals(plz, c.PLZ) Then score += 0.05
|
||||
If SafeEquals(LandKz, c.LandKz) Then score += 0.05
|
||||
|
||||
If best Is Nothing OrElse score > best.Score Then
|
||||
best = New KundeMatchResult With {
|
||||
.KundId = c.KundId,
|
||||
.Score = Math.Min(score, 1.0),
|
||||
.MatchType = "FUZZY",
|
||||
.Firma = c.Firma,
|
||||
.Strasse = c.Strasse,
|
||||
.PLZ = c.PLZ,
|
||||
.Ort = c.Ort,
|
||||
.LandKz = c.LandKz,
|
||||
.VATNr = c.VATNr,
|
||||
.EORINr = c.EORINr
|
||||
}
|
||||
End If
|
||||
Next
|
||||
|
||||
If best IsNot Nothing AndAlso best.Score >= minFuzzyScore Then
|
||||
Return best
|
||||
Else
|
||||
Return New KundeMatchResult With {.MatchType = "NONE", .Score = If(best Is Nothing, 0, best.Score)}
|
||||
End If
|
||||
End Function
|
||||
|
||||
' ---------------------------
|
||||
' 1) Exakt über VAT/EORI
|
||||
' ---------------------------
|
||||
Private Function FindExactByVatEori(vatNr As String, eoriNr As String) As KundeMatchResult
|
||||
If String.IsNullOrWhiteSpace(vatNr) AndAlso String.IsNullOrWhiteSpace(eoriNr) Then
|
||||
Return Nothing
|
||||
End If
|
||||
|
||||
Dim sql As New StringBuilder("SELECT TOP 1 * FROM Adressen INNER JOIN Kunden on AdressenNr=KundenNr WHERE 1=1")
|
||||
If Not String.IsNullOrWhiteSpace(vatNr) Then
|
||||
sql.Append(" AND isnull(UstIdKz,'')+isnull(UstIdNr,'') = @vat")
|
||||
End If
|
||||
If Not String.IsNullOrWhiteSpace(eoriNr) Then
|
||||
sql.Append(" AND EORITIN = @eori")
|
||||
End If
|
||||
|
||||
Using con As SqlConnection = VERAG_PROG_ALLGEMEIN.SQL.GetNewOpenConnectionFMZOLL()
|
||||
Using cmd As New SqlCommand(sql.ToString(), con)
|
||||
If Not String.IsNullOrWhiteSpace(vatNr) Then cmd.Parameters.AddWithValue("@vat", vatNr)
|
||||
If Not String.IsNullOrWhiteSpace(eoriNr) Then cmd.Parameters.AddWithValue("@eori", eoriNr)
|
||||
con.Open()
|
||||
Using r = cmd.ExecuteReader()
|
||||
If r.Read() Then
|
||||
Dim mt As String = If(Not String.IsNullOrWhiteSpace(vatNr) AndAlso Not String.IsNullOrWhiteSpace(eoriNr), "BOTH",
|
||||
If(Not String.IsNullOrWhiteSpace(vatNr), "VAT", "EORI"))
|
||||
Return New KundeMatchResult With {
|
||||
.KundId = CInt(r("kundId")),
|
||||
.Score = 1.0,
|
||||
.MatchType = mt,
|
||||
.Firma = r("Firma").ToString(),
|
||||
.Strasse = r("Strasse").ToString(),
|
||||
.PLZ = r("PLZ").ToString(),
|
||||
.Ort = r("Ort").ToString(),
|
||||
.LandKz = r("LandKz").ToString(),
|
||||
.VATNr = r("VATNr").ToString(),
|
||||
.EORINr = r("EORINr").ToString()
|
||||
}
|
||||
End If
|
||||
End Using
|
||||
End Using
|
||||
End Using
|
||||
|
||||
Return Nothing
|
||||
End Function
|
||||
|
||||
' ---------------------------------
|
||||
' 2) Kandidaten für Fuzzy-Matching
|
||||
' ---------------------------------
|
||||
Private Function LoadFuzzyCandidates(firma As String, plz As String,
|
||||
ort As String, LandKz As String) As List(Of KundeMatchResult)
|
||||
|
||||
' Schneller Vorfilter, um nicht die ganze Tabelle zu ziehen:
|
||||
' - gleiches Land (wenn angegeben)
|
||||
' - PLZ/Ort (wenn angegeben)
|
||||
' - Firma LIKE (erste 3–5 Zeichen), um Suchraum zu verringern
|
||||
Dim whereClauses As New List(Of String)
|
||||
If Not String.IsNullOrWhiteSpace(LandKz) Then whereClauses.Add("landKz = @land")
|
||||
If Not String.IsNullOrWhiteSpace(plz) Then whereClauses.Add("PLZ = @plz")
|
||||
If Not String.IsNullOrWhiteSpace(ort) Then whereClauses.Add("Ort LIKE @ortLike")
|
||||
Dim firmaStart = Left(NormalizeForCompare(firma), Math.Min(5, Math.Max(0, firma.Length)))
|
||||
If firmaStart.Length >= 3 Then whereClauses.Add("([name 1]+' ' + isnull([Name 2],'')) LIKE @firmaLike")
|
||||
|
||||
Dim sql = "SELECT TOP 200 KundenNr, [name 1]+' ' + isnull([Name 2],'') as [name], strasse, PLZ, Ort, landKz,isnull(UstIdKz,'')+isnull(UstIdNr,'') VATNr, EORITIN FROM Adressen inner join Kunden on AdressenNr=KundenNr "
|
||||
If whereClauses.Count > 0 Then
|
||||
sql &= " WHERE " & String.Join(" AND ", whereClauses)
|
||||
End If
|
||||
|
||||
Dim list As New List(Of KundeMatchResult)
|
||||
Using con As SqlConnection = VERAG_PROG_ALLGEMEIN.SQL.GetNewOpenConnectionFMZOLL()
|
||||
Using cmd As New SqlCommand(sql, con)
|
||||
If Not String.IsNullOrWhiteSpace(LandKz) Then cmd.Parameters.AddWithValue("@land", LandKz)
|
||||
If Not String.IsNullOrWhiteSpace(plz) Then cmd.Parameters.AddWithValue("@plz", plz)
|
||||
If Not String.IsNullOrWhiteSpace(ort) Then cmd.Parameters.AddWithValue("@ortLike", ort & "%")
|
||||
If firmaStart.Length >= 3 Then cmd.Parameters.AddWithValue("@firmaLike", "%" & firmaStart & "%")
|
||||
con.Open()
|
||||
Using r = cmd.ExecuteReader()
|
||||
While r.Read()
|
||||
list.Add(New KundeMatchResult With {
|
||||
.KundId = CInt(r("kundId")),
|
||||
.Firma = r("Firma").ToString(),
|
||||
.Strasse = r("Strasse").ToString(),
|
||||
.PLZ = r("PLZ").ToString(),
|
||||
.Ort = r("Ort").ToString(),
|
||||
.LandKz = r("LandKz").ToString(),
|
||||
.VATNr = r("VATNr").ToString(),
|
||||
.EORINr = r("EORINr").ToString()
|
||||
})
|
||||
End While
|
||||
End Using
|
||||
End Using
|
||||
End Using
|
||||
Return list
|
||||
End Function
|
||||
|
||||
' -----------------------
|
||||
' Ähnlichkeit & Helpers
|
||||
' -----------------------
|
||||
' Levenshtein-Ähnlichkeit (0..1); robust bei Kürze
|
||||
Private Function Similarity(a As String, b As String) As Double
|
||||
If String.IsNullOrEmpty(a) AndAlso String.IsNullOrEmpty(b) Then Return 1
|
||||
If String.IsNullOrEmpty(a) OrElse String.IsNullOrEmpty(b) Then Return 0
|
||||
Dim dist = LevenshteinDistance(a, b)
|
||||
Dim maxLen = Math.Max(a.Length, b.Length)
|
||||
If maxLen = 0 Then Return 1
|
||||
Return 1.0 - (CDbl(dist) / maxLen)
|
||||
End Function
|
||||
|
||||
Private Function LevenshteinDistance(s As String, t As String) As Integer
|
||||
Dim n = If(s Is Nothing, 0, s.Length)
|
||||
Dim m = If(t Is Nothing, 0, t.Length)
|
||||
If n = 0 Then Return m
|
||||
If m = 0 Then Return n
|
||||
|
||||
Dim d(n, m) As Integer
|
||||
For i = 0 To n : d(i, 0) = i : Next
|
||||
For j = 0 To m : d(0, j) = j : Next
|
||||
|
||||
For i = 1 To n
|
||||
For j = 1 To m
|
||||
Dim cost = If(s(i - 1) = t(j - 1), 0, 1)
|
||||
d(i, j) = Math.Min(
|
||||
Math.Min(d(i - 1, j) + 1, d(i, j - 1) + 1),
|
||||
d(i - 1, j - 1) + cost
|
||||
)
|
||||
Next
|
||||
Next
|
||||
Return d(n, m)
|
||||
End Function
|
||||
|
||||
' Normalisierung: Großschreibung, Diakritika entfernen, Sonderzeichen/Mehrfachspaces eliminieren
|
||||
Public Function NormalizeForCompare(input As String) As String
|
||||
If String.IsNullOrWhiteSpace(input) Then Return String.Empty
|
||||
Dim s = input.ToUpperInvariant().Trim()
|
||||
|
||||
' diakritische Zeichen entfernen
|
||||
Dim formD = s.Normalize(NormalizationForm.FormD)
|
||||
Dim sb As New StringBuilder()
|
||||
For Each ch As Char In formD
|
||||
Dim uc = CharUnicodeInfo.GetUnicodeCategory(ch)
|
||||
If uc <> UnicodeCategory.NonSpacingMark Then sb.Append(ch)
|
||||
Next
|
||||
s = sb.ToString().Normalize(NormalizationForm.FormC)
|
||||
|
||||
' Hausnummern-Zusätze zusammenführen, Punkte/Kommas/Slash entfernen
|
||||
s = Regex.Replace(s, "[\.\,\/\\\-_]", " ")
|
||||
' "STRASSE" vs "STR." angleichen (einfacher Heuristik-Schritt)
|
||||
s = Regex.Replace(s, "\bSTR\.\b", "STRASSE")
|
||||
' Doppelte/mehrfache Spaces
|
||||
s = Regex.Replace(s, "\s+", " ").Trim()
|
||||
Return s
|
||||
End Function
|
||||
|
||||
Private Function SafeEquals(a As String, b As String) As Boolean
|
||||
Return String.Equals(NormalizeForCompare(a), NormalizeForCompare(b), StringComparison.Ordinal)
|
||||
End Function
|
||||
|
||||
End Module
|
||||
@@ -468,4 +468,16 @@ Public Class cMitarbeiter
|
||||
End Select
|
||||
Return ""
|
||||
End Function
|
||||
|
||||
Public Shared Function GetUserParam(param As String, Optional maId As Integer = -1, Optional defaultReturn As Object = Nothing) As String
|
||||
Dim result As String = Nothing
|
||||
If maId < 0 Then
|
||||
If VERAG_PROG_ALLGEMEIN.cAllgemein.MITARBEITER Is Nothing Then Return defaultReturn
|
||||
maId = VERAG_PROG_ALLGEMEIN.cAllgemein.MITARBEITER.mit_id
|
||||
End If
|
||||
|
||||
Dim Value = (New VERAG_PROG_ALLGEMEIN.SQL).DLookup("usrPr_value", "tblMitarbeiter_UserParams", "usrPr_maId = '" & maId & "' AND usrPr_parameter = '" & param & "'", "ADMIN", defaultReturn)
|
||||
Return Value
|
||||
End Function
|
||||
|
||||
End Class
|
||||
|
||||
Reference in New Issue
Block a user