Je sais pas si vous l'avez remarqué, la fonction SoundEx de Delphi utilise la phonétique anglaise. Ce qui peut poser quelques problèmes en français avec les lettres H, W et Y.
Voici donc une petite fonction retournant le SoundEx, mais en français :
Code Pascal : Sélectionner tout - Visualiser dans une fenêtre à part
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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
function SoundExFr(Chaine: String): String;
 
  function Majus(Ch: Char): Char;
  begin
    case Ch of
      'a', 'à', 'ä', 'â':
        Majus := 'A';
      'e', 'é', 'è', 'ê', 'ë':
        Majus := 'E';
      'i', 'ï', 'î':
        Majus := 'I';
      'o', 'ô', 'ö':
        Majus := 'O';
      'u', 'ù', 'û', 'ü':
        Majus := 'U';
      'c', 'ç':
        Majus := 'C';
      else
        Majus := UpCase(Ch);
    end;
  end;
 
const
  Voyelle: set of Char = ['A', 'E', 'I', 'O', 'U'];
var
  St, St2: String;
  i: Byte;
begin
  St := Chaine;
  St2 := '';
 
  for i := 1 to Length(St) do
    if St[i] <> ' ' then
      St2 := St2 + Majus(St[i]);
 
  St := '';
 
  for i := 1 to Length(St2) do
    if not (St2[i] in (Voyelle + ['Y', 'H', 'W'])) then
      St := St + St2[i];
 
  // Effet de bord si la chaîne ne contient que des voyelles ou est vide.
  if Length(St) > 0 then
    St2 := St[1]
  else
  begin
    SoundExFr := '';
    Exit;
  end;
 
  for i := 2 to Length(St) do
    case St[i] of
      'B', 'P':
        St2 := St2 + '1';
      'C', 'K', 'Q':
        St2 := St2 + '2';
      'D', 'T':
        St2 := St2 + '3';
      'L':
        St2 := St2 + '4';
      'M', 'N':
        St2 := St2 + '5';
      'R':
        St2 := St2 + '6';
      'G', 'J':
        St2 := St2 + '7';
      'S', 'X', 'Z':
        St2 := St2 + '8';
      'F', 'V':
        St2 := St2 + '9';
    end;
 
  St := St2[1];
 
  for i := 1 to Length(St2) do
    if St2[i] <> St[Length(St)] then
      St := St + St2[i];
 
  if Length(St) < 4 then
    for i := Length(St) to 4 do
      St := St + '0'
  else
    if Length(St) > 4 then
      St := Copy(St, 1, 4);
 
  SoundExFr := St;
end;
Cette fonction est adaptée du programme Turbo Pascal disponible ici :
http://algor.chez.com/soundex/soundex.htm

Edit : Petite correction d'un effet de bord si la chaîne en paramètre ne contient que des voyelles.