241 lines
11 KiB
VB.net
241 lines
11 KiB
VB.net
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 |