home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / extra18 / pastrick / soundex / p.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-12-05  |  1.7 KB  |  58 lines
  1. (* ------------------------------------------------- *)
  2. (*                     P.PAS                         *)
  3. (*               Phonetische Suche                   *)
  4. (*       (c) 1991 Ulrich Borgdorf & DMV-Verlag       *)
  5. (* ------------------------------------------------- *)
  6. PROGRAM Phonetische_Suche;
  7.  
  8. USES Crt;
  9.  
  10. VAR
  11.   Eingabe, Ausgabe : STRING [40];
  12.  
  13.   FUNCTION Phonetisch(Ein : STRING) : STRING;
  14.   VAR
  15.     Zeichen : CHAR;
  16.     Aus     : STRING;
  17.     i, Code : BYTE;
  18.   BEGIN
  19.     Aus := '';
  20.     FOR i := 1 TO Length(Ein) DO BEGIN
  21.       Zeichen := UpCase(Ein[i]);
  22.       CASE Zeichen OF
  23.         'A','ä','Ä','E','H',
  24.         'I','U','ü','Ü','W','Y' : Aus := Aus + 'A';
  25.         'B','F','P','V'         : Aus := Aus + 'B';
  26.         'C','G','J','K','Q',
  27.         'S','ß','X','Z'         : Aus := Aus + 'C';
  28.         'D','T'                 : Aus := Aus + 'D';
  29.         'M','N'                 : Aus := Aus + 'M';
  30.         'L'                     : Aus := Aus + 'L';
  31.         'R'                     : Aus := Aus + 'R';
  32.       END;
  33.       IF (Zeichen >= '0') AND (Zeichen <= '9') THEN
  34.         Aus := Aus + Zeichen;
  35.     END;
  36.     Ein := Aus;
  37.     Aus := '';
  38.     FOR i := 1 TO Length(Ein) DO BEGIN
  39.       IF Ein[i] <> Aus[Length(Aus)] THEN
  40.         Aus := Aus + Ein[i];
  41.     END;
  42.     Phonetisch := Aus;
  43.   END;
  44.  
  45. BEGIN
  46.   ClrScr;
  47.   WriteLn('Phonetische Suche');
  48.   REPEAT
  49.     ReadLn(Eingabe);
  50.     Ausgabe := Phonetisch(Eingabe);
  51.     WriteLn('Aus ', Eingabe, ' wird ', Ausgabe);
  52.   UNTIL Ausgabe = 'AMDA';
  53.   WriteLn('* Ende *');
  54.   REPEAT UNTIL KeyPressed;
  55. END.
  56. (* ------------------------------------------------- *)
  57. (*                Ende von P.PAS                     *)
  58.