Ajuda Pesquisa Fonético - FCodiFonPT_BR (Ed.92)

Na edição 92, trouxe uma errata do Código Fonético no Firebird - Ed.82. (autor: Jorge Luis Bublitz)

A nova implemenção pede para que não seja removida a primeira vogal. Fiz as devidas modificações, mas acontece o mesmo problema. Quando fazemos uma pesquisa por ´MARIA´ ele traz resultado contendo o nome ´MAURO´.

Alguém tem alguam idéia pra resolver este problema. Abaixo postei a função completa.


Resultado de pesquisar por ´MARIA´:
-------------------------------------------
NOME / COD. FONÉTICO
-------------------------------------------
MARCELA BIANCO / MARSLBNK
MARCIA LUCIA PENHA / MARSLZRSM
MARCOS VINICIUS SILVA / MARKSVNSSSLV
MARCUS VINICIUS BASTOS / MARKSVNSSBSTS
MAURO GERALDO BORBA / MARJRLDBRB


***********************************

unit untMain;

interface

uses
SysUtils;

function CodiFonPT_BR(nome: PChar): PChar; cdecl; export;

implementation

function CodiFonPT_BR(nome: PChar): PChar;
var
i, p: Integer;
novo, aux: string;
begin
try
aux := AnsiUpperCase(nome);
novo := ´´;

for i := 1 to Length(aux) do
begin
case aux[i] of
´á´, ´Á´, ´Â´, ´â´, ´Ã´, ´ã´, ´À´, ´à´, ´Ä´,
´ä´: aux[i] := ´A´;
´é´, ´É´, ´ê´, ´Ê´, ´è´, ´È´, ´ë´, ´Ë´:
aux[i] := ´E´;
´í´, ´Í´, ´î´, ´Î´, ´ì´, ´Ì´, ´ï´, ´Ï´:
aux[i] := ´I´;
´ó´, ´Ó´, ´ô´, ´Ô´, ´ò´, ´Ò´, ´õ´, ´Õ´, ´ö´,
´Ö´: aux[i] := ´O´;
´ú´, ´Ú´, ´û´, ´Û´, ´ù´, ´Ù´, ´ü´, ´Ü´:
aux[i] := ´U´;
´ç´, ´Ç´: aux[i] := ´C´;
´ñ´, ´Ñ´: aux[i] := ´N´;
´ý´, ´Ý´, ´Y´: aux[i] := ´I´;
else
if Ord(aux[i]) > 127 then
aux[i] := #32;
end;
end;

p := Pos(´ DA ´, aux);
while p > 0 do
begin
Delete(aux, p, 3);
p := Pos(´ DA ´, aux);
end;
p := Pos(´ DAS ´, aux);
while p > 0 do
begin
Delete(aux, p, 4);
p := Pos(´ DAS ´, aux);
end;
p := Pos(´ DE ´, aux);
while p > 0 do
begin
Delete(aux, p, 3);
p := Pos(´ DE ´, aux);
end;
p := Pos(´ DI ´, aux);
while p > 0 do
begin
Delete(aux, p, 3);
p := Pos(´ DI ´, aux);
end;
p := Pos(´ DO ´, aux);
while p > 0 do
begin
Delete(aux, p, 3);
p := Pos(´ DO ´, aux);
end;
p := Pos(´ DOS ´, aux);
while p > 0 do
begin
Delete(aux, p, 4);
p := Pos(´ DOS ´, aux);
end;
p := Pos(´ E ´, aux);
while p > 0 do
begin
Delete(aux, p, 2);
p := Pos(´ E ´, aux);
end;

for i := 1 to length(aux) - 1 do
if (aux[i] = aux[i + 1]) then
begin
Delete(aux, i, 1);
if (aux[i] = ´S´) and (aux[i + 1]
in [´I´, ´E´]) then
aux[i] := ´C´;
if (aux[i] = ´S´) and (aux[i + 1]
in [´O´, ´U´]) then
aux[i] := ´Ç´;
end;

for i := 1 to length(aux) do
begin
case aux[i] of
´B´, ´D´, ´F´, ´J´, ´K´, ´L´, ´M´, ´N´, ´R´,
´T´, ´V´, ´X´:
novo := novo + aux[i];
´C´:
if aux[i + 1] = ´H´ then
novo := novo + ´X´
else if aux[i + 1] in [´A´, ´O´, ´U´] then
novo := novo + ´K´
else if aux[i + 1] in [´E´, ´I´] then
novo := novo + ´S´;
´G´:
if aux[i + 1] in [´E´] then
novo := novo + ´J´
else
novo := novo + ´G´;
´P´:
if aux[i + 1] in [´H´] then
novo := novo + ´F´
else
novo := novo + ´P´;
´Q´:
if aux[i + 1] in [´U´] then
novo := novo + ´K´
else
novo := novo + ´Q´;
´S´:
case aux[i + 1] of
´H´: novo := novo + ´X´;
´A´, ´E´, ´I´, ´O´, ´U´:
if aux[i - 1] in
[´A´, ´E´, ´I´, ´O´, ´U´] then
novo := novo + ´Z´
else
novo := novo + ´S´;
else
novo := novo + ´S´;
end;
´Ç´: novo := novo + ´S´;
´W´: novo := novo + ´V´;
´Z´:
if (i = length(aux)) or (aux[i + 1] = ´ ´) then
novo := novo + ´S´
else
novo := novo + ´Z´;
´¬´: novo := novo + ´¬´;
else

if ((i = 1) or (i = 2)) and (aux[i]
in [´A´, ´B´, ´C´, ´D´, ´E´, ´F´,
´G´, ´H´, ´I´, ´J´, ´K´, ´L´, ´M´, ´N´,
´O´, ´P´, ´Q´, ´R´, ´S´, ´T´, ´U´, ´V´,
´W´, ´X´, ´Y´, ´Z´, ´0´, ´1´, ´2´, ´3´,
´4´, ´5´, ´6´, ´7´, ´8´, ´9´]) then
novo := novo + aux[i];

end;
end;
CodiFonPT_BR := PChar(novo);
except
CodiFonPT_BR := PChar(´´);
end;
end;