Strings auf Ähnlichkeit überprüfen

[Gambit]

Hallo,
ich möchte zwei Strings auf Ähnlichkeit überprüfen.
Dabei soll ausgegeben werden zu wieviel Prozent sich die Strings ähneln.
Dazu splitte ich die Strings zunächst in die enthaltenen Wörter und schreibe sie in jeweils eine ListBox. Danach prüfe ich nach, zu wieviel Prozenz die Wörter aus dem ersten String im zweiten enthalten sind und nutze dazu auch die SoundexSimillar Funktion um Rechtschreibfehler soweit möglich auszuschließen. Am Schluss prüfe ich noch zu wieviel Prozent die Wörter aus dem ersten String im zweiten enthalten sind:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var i, j, SimillarWordsCounter: Integer;
begin
  ListBox1.Items:= filter(PChar(Edit1.Text));
  ListBox2.Items:= filter(PChar(Edit2.Text));

  for i:= 0 to ListBox1.Items.Count-1 do
  begin
    for j:= 0 to ListBox2.Items.Count-1 do
    begin
      if SoundExSimilar(ListBox1.Items.Strings[i], ListBox2.Items.Strings[j], 4) then
      SimillarWordsCounter:= SimillarWordsCounter+1;
    end;
  end;
  showMessage('Strings ähneln sich zu '+
              IntToStr(((SimillarWordsCounter div ListBox1.Items.Count * 100)
              +(ListBox1.Items.Count+ListBox2.Items.Count)div 2*100)div 2)+ ' %') ;
end;

function filter(source:PChar):TStringList;
var p, start   : PChar;
    token      : string;
begin
  result := TStringList.Create;
  p := source;
  while (p^ <> #0) do begin
     if p^ in [#1..#64,#91..#96,#123..#127] then Inc(p)
     else begin                 // ein Wort wurde gefunden ...
       start := p;
       while not (p^ in [#0..#64,#91..#96,#123..#127]) do Inc(p);
       SetString(token, start, p-start);
       result.Add(token)
     end
  end
end;

Vielleicht hat ja jemand 'ne Anregung, in wie weit man die Prüfung noch verbessern könnte. Außerdem bin ich mir nicht sicher, ob die statistische Auswertung in showMessage so OK ist.

Gruß

Gambit