1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:

{http://groups.google.at/group/de.sci.informatik.misc/browse_thread/thread/7e28a09c69fd8b18/37ae33c36782ea32?lnk=st&q=%C3%A4hnlichkeit+zweier+strings+delphi&rnum=6&hl=de#37ae33c36782ea32}
function Similar(Str1, Str2: String): Integer;
VAR treffer, p1, p2, l1, l2, pt, diff: INTEGER;
     hstr: STRING;
    test: ARRAY [1..255] OF BOOLEAN;
BEGIN
 if (Str1 = '') or (Str2 = '') then
 begin
  Result := -1;
  exit;
 end;

 {Hinzugefügt: Bei nur 1 Wort das 1. Zeichen des Strings als 2. Wort verwenden}
 if Pos(' ', Str1) = 0 then Str1 := Str1+' '+Str1[1];
 if Pos(' ', Str2) = 0 then Str2 := Str2+' '+Str2[1];

 IF Length(Str1) < Length(Str2) THEN BEGIN
  hstr:= Str2;  Str2:= Str1;  Str1:= hstr;
 END;
 l1:= Length (Str1);
 l2:= Length (Str2);
 p1:= 1;  p2:= 1;  treffer:= 0;
 diff:= Max (l1, l2) DIV 3 + ABS (l1 - l2);
 FOR pt:= 1 TO l1 DO  test[pt]:= FALSE;
 REPEAT
  IF NOT (test[p1]) THEN BEGIN
   IF (Str1[p1] = Str2[p2]) AND (ABS(p1-p2) <= diff) THEN BEGIN
    test[p1]:= TRUE;
    treffer:= Succ(treffer);
    p1:= Succ(p1);
    p2:= Succ(p2);
    IF p1 > l1 THEN p1:= 1;
   END ELSE BEGIN
    test[p1]:= FALSE;
    p1:= Succ(p1);
    IF p1 > Length(Str1) THEN BEGIN
     WHILE (p1 > 1) AND NOT(test[p1]) DO  p1:= Pred(p1);
     p2:= Succ(p2)
    END;
   END;
  END ELSE BEGIN
   p1:= Succ(p1);
   IF p1 > Length(Str1) THEN BEGIN
    REPEAT
     p1:= Pred(p1);
    UNTIL (p1 = 1) OR test[p1];
    p2:= Succ(p2)
   END;
  END;
 UNTIL p2 > Length(Str2);
 Result := 100 * treffer DIV l1;
end;					

1:

          WHILE (p1 > 1) AND NOT(test[p1]) DO					

1:
2:
3:

test: ARRAY OF BOOLEAN;
BEGIN
 SetLength(test, Length(Str1)+Length(Str2));