soundex francais asp

Question

Bonjour, je cherche un code vbscript pour la version francaise pour soundex.

prince321 · Answer

j'ai arrivé a faire ça j'espere que ca aidera quelqu'un
<%


Function soundex_fr(si)
dim convVIn, convVOut, convGuIn, convGuOut, accentsif ( si "" ) then soundex_fr "    "  end If
si=replace(si,"É","E")
si=replace(si,"È","E")
si=replace(si,"Ë","E")
si=replace(si,"Ê","E")
si=replace(si,"Á","A")
si=replace(si,"À","A")
si=replace(si,"Ä","A")
si=replace(si,"Â","A")
si=replace(si,"Å","A")
si=replace(si,"Ã","A")
si=replace(si,"Ï","I")
si=replace(si,"Î","I")
si=replace(si,"Ì","I")
si=replace(si,"Í","I")
si=replace(si,"Ô","O")
si=replace(si,"Ö","O")
si=replace(si,"Ò","O")
si=replace(si,"Ó","O")
si=replace(si,"Õ","O")
si=replace(si,"Ø","O")
si=replace(si,"Ú","U")
si=replace(si,"Ù","U")
si=replace(si,"Û","U")
si=replace(si,"Ü","U")
si=replace(si,"Ç","S")
si=replace(si,"Ñ","N")
si=replace(si,"¿","E")
si=replace(si,"é","e")
si=replace(si,"è","e")
si=replace(si,"ë","e")
si=replace(si,"ê","E")
si=replace(si,"á","a")
si=replace(si,"í","i")
si=replace(si,"ì","i")
si=replace(si,"à","a")
si=replace(si,"ä","a")
si=replace(si,"å","a")
si=replace(si,"â","a")
si=replace(si,"ã","a")
si=replace(si,"ï","a")
si=replace(si,"î","i")
si=replace(si,"ô","o")
si=replace(si,"ö","o")
si=replace(si,"ò","o")
si=replace(si,"ó","o")
si=replace(si,"õ","o")
si=replace(si,"ø","o")
si=replace(si,"ú","u")
si=replace(si,"ù","u")
si=replace(si,"û","u")
si=replace(si,"ü","u")
si=replace(si,"ç","c")
si=replace(si,"ñ","n")
si=replace(si,"û","u")
si = UCase( si )


Set RegularExpressionObject = New RegExp
With RegularExpressionObject
.Pattern = "[^A-Z]"
.IgnoreCase = True
.Global = True
End With
si = RegularExpressionObject.Replace(si, "")
Set RegularExpressionObject = nothing


if ( len( si ) = 1 ) then return si&"   " end If


si=replace(si,"AA","A")
si=replace(si,"ZZ","Z")
si=replace(si,"EE","E")
si=replace(si,"RR","R")
si=replace(si,"TT","T")
si=replace(si,"YY","Y")
si=replace(si,"UU","U")
si=replace(si,"II","I")
si=replace(si,"OO","O")
si=replace(si,"PP","P")
si=replace(si,"QQ","Q")
si=replace(si,"SS","S")
si=replace(si,"DD","D")
si=replace(si,"FF","F")
si=replace(si,"GG","G")
si=replace(si,"HH","H")
si=replace(si,"JJ","J")
si=replace(si,"KK","K")
si=replace(si,"LL","L")
si=replace(si,"MM","M")
si=replace(si,"WW","W")
si=replace(si,"XX","X")
si=replace(si,"CC","C")
si=replace(si,"VV","V")
si=replace(si,"BB","B")
si=replace(si,"NN","N") 


si=replace(si,"GUI","KI")
si=replace(si,"GUE","KE")
si=replace(si,"GA","KA")
si=replace(si,"GO","KO")
si=replace(si,"GU","K")
si=replace(si,"SCI","SI")
si=replace(si,"SCE","SE")
si=replace(si,"SC","SK")
si=replace(si,"CA","KA")
si=replace(si,"CO","KO")
si=replace(si,"CU","KU")
si=replace(si,"QU","K")
si=replace(si,"Q","K")
si=replace(si,"CC","K")
si=replace(si,"CK","K")
si=replace(si,"G","J")
si=replace(si,"ST","T")
si=replace(si,"PH","F")
si=replace(si,"EAU","O")


'si=replace(si,"CH","9")
'si=replace(si,"SH","8")
'si=replace(si,"H","")
'si=replace(si,"9","CH")
'si=replace(si,"8","SH")


    ' on supprime les E, A et Y qui ne sont pas en première position 
dim  mot1,lon


mot1=mid(si,1,1)
si=mid(si,2)


Set RegularExpressionObject = New RegExp
With RegularExpressionObject
.Pattern = "[AEY]"
.IgnoreCase = True
.Global = True
End With
si = RegularExpressionObject.Replace(si, "")
si=mot1&si
Set RegularExpressionObject = nothing


lon=len(si)
mot1=mid(si,1,(lon-1))
si=mid(si,lon)


Set RegularExpressionObject = New RegExp
With RegularExpressionObject
.Pattern = "[TS]"
.IgnoreCase = True
.Global = True
End With
si = RegularExpressionObject.Replace(si, "")
si=mot1&si
Set RegularExpressionObject = nothing


si=mid(si&"    ",1,4)
soundex_fr=si
End Function
dim mot


%>

Soundex francais asp

1 réponse

Votre réponse

Discussions similaires