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