>* SOUNDEX() para fonética brasileira >********************************************************************* >* Parametro:Palavra Retorno: String que representa o som da palavra >* Rotina original: Newton em 03/1990 >* Metodo :As letras ou sequencias que produzem som ambiguo, sao >* substituidos de modo a evitar a ambiguidade. Exemplo: >* Z pode ter som de S >* S pode ter som de C >* C pode ter som de K >* Z,S e C sao substiuidos por K >* Este metodo, empobrece o resultado, fazendo com q palavras >* diferentes possuam o mesmo resultado. Porem, na pratica, >* parece atender de forma simples. >* A rotina não trata caracteres acentuados e, pode não funcionar >* para palavras de língua inglesa. Sugere-se neste caso utilizar >* soundex(soundexbr(palavra)) >*==================================================================== >Procedure SoundexBr && Char Palavra >Parameter Palavra >Local M_Char,M_CharPro,M_CharAnt,M_Pai,M_Aux,M_S1,M_S2,M_S3,M_S4,M_Saida >* >*M_Char && Caracter retirado da palavra >*M_CharPro && Caracter posterior a M_CHAR >M_CharAnt = Space(1) && Caracter anterior a M_CHAR >M_Pal = Upper(Palavra) && Palavra em UpCase >M_Aux = 0 && Contador auxiliar >M_S1 = "CSZNEYWVL" && Cadeia de caracteres origem >M_S2 = "KKKMIIUUU" && Cadeia de caracteres destino >M_S3 = "BCDFGJKMNPQRSTVWXZ" && Consoantes >M_S4 = " BDFGHJQT" && Cadeia Apos a letra H >M_Saida = Space(0) && Cadeia auxiliar de saida >* >For M_Aux=1 to Len(M_pal) > M_Char = Subs(M_Pal,M_Aux,1) > M_CharPro = Subs(M_Pal+" ",M_Aux+1,1) > If M_Char$M_S1 > M_Char=Subs(M_S2,At(M_Char,M_S1),1) > Endif > If M_Char = Space(1) > Loop > Endif > If M_Char = "H" and M_CharAnt$M_S4 > Loop > Endif > If M_Char = M_CharAnt > Loop > Endif > If M_Char $ "KG" and M_CharPro$M_S3 > Loop > Endif > * Modificacoes do proximo caracter > If M_Char+M_CharPro = "IX" && Trocar Por "IK" && EX ->EZ > M_Pal = Trim(Left(M_Pal,M_Aux)+"K"+Subs(M_Pal+" ",M_Aux+2)) > Endif > If M_Char+M_CharPro = "KH" && Trocar por "X" && CH ->X > M_Pal = Trim(Left(M_Pal,M_Aux)+Space(1)+Subs(M_Pal+" ",M_Aux+2)) > M_Char = "X" > Endif > If M_Char+M_CharPro = "QU" && Trocar por "K" && QU ->K > M_Pal = Trim(Left(M_Pal,M_Aux)+Space(1)+Subs(M_Pal+" ",M_Aux+2)) > M_Char = "K" > Endif > If M_Char+M_CharPro = "GI" && Trocar por "JI" && GE ->JE > M_Char = "J" > Endif > If M_Char+M_CharPro = "PH" && Trocar por "F" > M_Pal = Trim(Left(M_Pal,M_Aux)+Space(1)+Subs(M_Pal+" ",M_Aux+2)) > M_Char = "F" > Endif > If M_Aux = Len(M_Pal) && Ultimo Caracter > If M_Char = "G" .and. M_CharAnt = "M" > Loop > Endif > If M_Char$"KD" > Loop > Endif > Endif > If M_Char = M_CharAnt > Loop > Endif > M_Saida = M_Saida + M_Char > M_CharAnt = M_Char >Next >* >Return M_Saida >