Soundex-Algorithmus für Deutsch

[Teekeks]

Hi!
Ich verwende schon ewig einen Soundex Algorytmus der Eigentlich für das Amerikanische gedacht war, aber von meinem Vater leicht angepasst wurde. Er funktioniert est super und es hat sich bis heute noch keiner beschwert...
hier ist er:

Delphi-Quellcode:

(* ------------------------------------------------------ *)
(*                    SOUNDEX.PAS                         *)
(*            Phonetisches Suchen mit Pascal              *)
(*             (c) 1990 Bodo Joest & TOOLBOX              *)
(*     Leichte Änderungen für Delphi32 JB, 2001           *)
(*     Anpassung für ersten Laut von Jens During          *)
(* ------------------------------------------------------ *)

UNIT Sound_Ex;

INTERFACE

FUNCTION SoundEx(CONST Idx: String): String;

IMPLEMENTATION

FUNCTION UpString(CONST Txt : String): String;
VAR
  i : INTEGER;
BEGIN
  Result := Txt;
  FOR i := 1 TO Length(Result) DO
    Result[i] := UpCase(Result[i]);
END;

FUNCTION SoundEx(CONST Idx : String): String;
            { Umwandlung eines Strings in eine Phonemkette }
CONST                                            { Phoneme }
  BFPV     = ['B', 'F', 'P', 'V'];
  CGJKQSXZ = ['C', 'G', 'J', 'K', 'Q', 'S', 'X', 'Z'];
  DT       = ['D', 'T'];
  L        = ['L'];
  MN       = ['M', 'N'];
  R        = ['R'];
VAR
  i       : INTEGER;
  Code    : String[5];
  CodeLen : BYTE ABSOLUTE Code;
  Index   : String;
BEGIN
  Index := UpString(Idx);
//Code  := Index[1]; //Änderung JD,Phonemkennung ab Laut 1!!
  Code  := '';
  i     := 1;
  WHILE (i <= Length(Index)) AND (CodeLen < 5) DO BEGIN
    IF      (Index[i] IN BFPV)     AND
            (Code[CodeLen] <> '1') THEN Code := Code + '1'
    ELSE IF (Index[i] IN CGJKQSXZ) AND
            (Code[CodeLen] <> '2') THEN Code := Code + '2'
    ELSE IF (Index[i] IN DT)       AND
            (Code[CodeLen] <> '3') THEN Code := Code + '3'
    ELSE IF (Index[i] IN L)        AND
            (Code[CodeLen] <> '4') THEN Code := Code + '4'
    ELSE IF (Index[i] IN MN)       AND
            (Code[CodeLen] <> '5') THEN Code := Code + '5'
    ELSE IF (Index[i] IN R)        AND
            (Code[CodeLen] <> '6') THEN Code := Code + '6';
    Inc(i);
  END;
  Code   := Code + '0000';
  Result := Code;
END;

END.

gruß Teekeks