Dublettenabgleichen

Im nachfolgenden Code demonstiere ich, wie ich in meiner Firma Dubletten abgleiche.

const
  ws : integer = 3;             //  Wichtung für das Ersetzen   3
  wi : integer = 1;             //  Wichtung für das Einfügen   1
  wd : integer = 6;             //  Wichtung für das Löschen    6

function DamerauLevenstein(s1,s2:string;ws,wi,wd:integer):Integer;
var m, i, j : Integer;
    d       : array of array of integer;

  function Pp(x,y:Integer):Integer;
  begin
    if s1[x] = s2[y] then Result:= 0 else Result:= ws;
  end;

begin
  s1 := AnsiUpperCase(Trim(s1));
  s2 := AnsiUpperCase(Trim(s2));
  m := Max(length(s1),length(s2));
  SetLength (d,m + 1,m + 1);
  d[0,0]:=0;
  for j:=1 to m do d[0,j]:=d[0  ,j-1] + wi;
  for i:=1 to m do d[i,0]:=d[i-1,0  ] + wd;
  for i:=1 to Length(s1) do
    for j:=1 to Length(s2) do
      d[i,j]:=MinIntValue([ d[i-1,j-1] + Pp(i,j),
                            d[ i ,j-1] + wi,
                            d[i-1,  j] + wd
                         ]);
  result := d[Length(s1),Length(s2)];
  SetLength(d,0);
end;

function getplain(s: string):string;
var
  i: Integer;
begin
  Result:='';
  for i:=1 to Length(s) do
    if s[i] in ['0'..'9'] then Result:=Result+s[i];
end;

function TForm1.vergleiche(k: torgkontakt; l:thtmlkontakt):integer;
var score: integer;
begin
  score:=0;
  if getplain(k.str_PLZ)=getplain(l.str_PLZ) then
    score:=score+40;

  if (k.STR_TELEFON<>'') and (l.str_tel<>'') then
    if (getplain(k.STR_TELEFON)=getplain(l.str_tel)) then
      score:=score+30;

  if (k.STR_TELEFAX<>'') and (l.str_fax<>'') then
    if (getplain(k.STR_TELEFAX)=getplain(l.str_fax)) then
      score:=score+30;

  if DamerauLevenstein(k.str_Strasse, l.str_Strasse, ws, wi, wd)<10 then
    score:=score+20;

  if (k.str_name1<>'') and (l.str_name1<>'') then
    if DamerauLevenstein(k.str_name1, l.str_name1, ws, wi, wd)<10 then
      score:=score+10;
  if (k.str_name1<>'') and (l.str_name2<>'') then
    if DamerauLevenstein(k.str_name1, l.str_name2, ws, wi, wd)<10 then
      score:=score+10;
  if (k.str_name2<>'') and (l.str_name1<>'') then
    if DamerauLevenstein(k.str_name2, l.str_name1, ws, wi, wd)<10 then
      score:=score+10;
  if (k.str_name2<>'') and (l.str_name2<>'') then
    if DamerauLevenstein(k.str_name2, l.str_name2, ws, wi, wd)<10 then
      score:=score+10;

  result:=score;
end;