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:

 Eingabe: Otto Karl;Otto Kalle;Ottomotor;Otmar;
 
 Iterationen:
 i=1
 (O)tto Karl
 (O)tto Kalle
 (O)ttomotor
 (O)tmar
 100% O

 i=2
 O(t)to Karl
 O(t)to Kalle
 O(t)tomotor
 O(t)mar
 100% t

 Ot(t)o Karl
 Ot(t)o Kalle
 Ot(t)omotor
 Ot(m)ar  
 75% t

 Ott(o) Karl
 Ott(o) Kalle
 Ott(o)motor
 //Otmar wird nicht mehr beachtet
 75% o

 Otto( )Karl
 Otto( )Kalle
 Otto(m)otor
 //Otmar
 50% " " => terminiert					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:

function SameString(string1, string2: WideString; tolerance: Integer; var Fehlstelle: Integer): Boolean;
var tmp: WideString;
    i, c: Integer;
begin
  // sicherstellen, dass string2 mindestens so lang ist wie 1
  if length(string1) > length(string2) then
  begin
    tmp := string1;
    string1 := string2;
    string2 := tmp;
  end;
  c := 0;
  for i := 1 to length(string1) do
  begin
    if WideUpperCase(string1[i]) <> WideUpperCase(string2[i]) then
    begin
      inc(c);
      // erste Fehlerstelle zurückmelden!
      if Fehlstelle = 0 then Fehlstelle := i;
    end;
    if c > tolerance then break; // Abbruch. Zu viele Fehler
  end;
  result := c <= tolerance;
end;					

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:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:

function GetCommonString(Strings: TTntStringlist; tolerance: Integer; var Fehlstelle: Integer): WideString;
var minlength, minidx, i: Integer;
    checkStr: WideString;
    durchlauf, durchlaufmax, errorCount: Integer;
begin
  durchlauf := 0;
  errorCount := 0;
  Fehlstelle := 0;
  CheckStr := '';
  case Strings.Count of
      0..1: durchlaufmax := 0;
      2..4: durchlaufmax := 1;
      5..9: durchlaufmax := 2
  else
      durchlaufmax := 3;
  end;

  if Strings.Count > 0 then
  repeat
        // Den String mit minimaler Länge bestimmen
        minlength := length(Strings[0]);
        minidx := 0;
        for i := 1 to Strings.Count - 1 do
        begin
          if length(Strings[i]) < minlength then
          begin
            minlength := length(Strings[i]);
            minidx := i;
          end;
        end;
        checkStr := Strings[minidx];
        // diesen String aus der Liste entfernen, damit er beim nächsten Durchlauf nicht wieder gefunden wird
        Strings.Delete(minidx);

        // Den Rest der Stringliste überprüfen, ob dieser String "passt"
        // ErrorCount zählt dabei die Strings, die nicht passen
        errorCount := 0;
        Fehlstelle := 0;
        for i := 0 to Strings.Count - 1 do
        begin
          if not SameString(checkStr, Strings[i], tolerance, Fehlstelle) then
            inc(errorCount);
          if errorCount > 1 then break;
        end;

        // Situation hier:
        // Wenn errorCount <= 1, dann ist CheckStr ein guter String für die Liste
        // Wenn nicht, dann probieren wir das nochmal.
        inc(durchlauf);
  until (durchlauf > durchlaufmax) or (errorCount <= 1) or (strings.Count = 0);

  if ErrorCount <= 1 then
    result := CheckStr
  else
  begin
    if fehlstelle <= length(CheckStr) Div 2 + 1 then
      result := ''
    else
    begin
      result := copy(CheckStr, 1, fehlstelle - 1) + ' ... ';
      fehlstelle := 0;
    end;
  end;
end;