Função tirar acento não funciona

[vivi@ne 0]

Boa tarde,

 

Alguém sabe como tirar o acento depois de fazer a instrução SQL?

 

Exemplo:

 

SQL = "Select * From consulta where id = '"&varCod&"' "

Set rs = MyConn.execute(SQL)

 

nome = rs("nome")

 

nome_sem_acento = Funcao_para_tirar_acento(nome)

 

Todas as funções que eu testei não fazem nenhuma alteração. Até tenho uma aqui que roda legal mas para "request("qualquercoisa")".

 

uso página com codificação utf-8

 

Espero a ajuda de vocês.

 

Bjk

[Ted k' 126]

como está vindo para você?

 

como está a função, você está fazendo corretamente, agora é erro de acentos ou caracteres?

[xanburzum 169]

olha uma funcaun simples

 

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
'Cria uma a varriável "varNome" que captura os dados de txtNome
'varNome="àÉêÊôÔõÕ"
varNome = Request.form("txtNome") 
'Cria o contador i que começa de 1 e vai até o nº de caracteres que tem 
'na variavel "varNome", com isto ele vai verificar letra por letra se tem acento ou não.

for i = 1 to len(varNome) 

'Cria a variavel Letra e executa a função Mid na variável "VarNome" que pega caracteres no meio de uma String

Letra = mid(varNome, i, 1)

'Executa as comparações da Variavel Letra e verifica se tem acento, se tiver, troca por pela mesma sem acento

Select Case Letra

Case "á","Á","à","À","ã","Ã","â","Â","â"
Letra = "A"

Case "é","É","ê","Ê"
Letra = "E"

Case "í","Í"
Letra = "I"

Case "ó","Ó","ô","Ô","õ","Õ"
Letra = "O"

Case "ú","Ú"
Letra = "U"

Case "ç","Ç"
Letra = "C"

End Select

'Cria a variavel "texto" que vai concatenando letra por letra até formar a palavra novamente

texto = texto & Letra

next

'Exibe a variavel texto e transforma todos os caracteres em Maiúsculo.

Response.Write "Obrigado(a) " & Ucase(texto)

%>

outro exemplo:

 

Function TiraAcento(ByVal Palavra)
cacento = "àáâãäèéêëìíîïòóôõöùúûüÀÁÂÃÄÈÉÊËÌÍÎÒÓÔÕÖÙÚÛÜçÇñÑ^~ºª´`'"
sacento = "aaaaaeeeeiiiiooooouuuuAAAAAEEEEIIIOOOOOUUUUcCnN"
texto = ""
If Palavra <> "" Then
For x = 1 To Len(Palavra)
letra = Mid(Palavra, x, 1)
pos_acento = InStr(cacento, letra)
If pos_acento > 0 Then
letra = Mid(sacento, pos_acento, 1)
End If
texto = texto & letra
Next
TiraAcento = texto
End If
response.write(texto)
End Function

[vivi@ne 0]

como está vindo para você?

 

como está a função, você está fazendo corretamente, agora é erro de acentos ou caracteres?

 

O problema é que não tira os acentos e também não dá nenhum erro

[xanburzum 169]

dá uma olhada aki, pode te ajudar...

Clique aqui

[vivi@ne 0]

dá uma olhada aki, pode te ajudar...

Clique aqui

 

Já tentei também, não funcionou.

[Patrique 0]

Poste o code ae de como você esta tentando fazer, certamente você esta se confundindo ao usar a função para retirar os acentos.

[vivi@ne 0]

Poste o code ae de como você esta tentando fazer, certamente você esta se confundindo ao usar a função para retirar os acentos.

 

Segue uma parte do código

 

Function TiraAcento(ByVal Palavra) 
cacento = "àáâãäèéêëìíîïòóôõöùúûüÀÁÂÃÄÈÉÊËÌÍÎÒÓÔÕÖÙÚÛÜçÇñÑ^~ºª´`'" 
sacento = "aaaaaeeeeiiiiooooouuuuAAAAAEEEEIIIOOOOOUUUUcCnN" 
texto = "" 
If Palavra <> "" Then 
For x = 1 To Len(Palavra) 
letra = Mid(Palavra, x, 1) 
pos_acento = InStr(cacento, letra) 
If pos_acento > 0 Then 
letra = Mid(sacento, pos_acento, 1) 
End If 
texto = texto & letra 
Next 
TiraAcento = texto 
End If 
response.write(texto) 
End Function
nomepasta = request("pasta")

Set objFS = Server.CreateObject("Scripting.FileSystemObject")
If (objFS.FolderExists(Server.Mappath("pasta/"& nomepasta) ))Then

SQL0 = "Select * From ...where id_clinica = '"&id&"' "
Set rs0 = MyConn.execute(SQL0)

if not rs0.EOF then


seq = "select MAX(id) from ..."
Set RSseq = MyConn.Execute(seq)
sequencia = RSseq(0)
randomize
tam=13
dataseq = (Right("0"&Day(now),2)&"/"&Right("0"&month(now),2)&"/"&year(now)&FormatDateTime(Now, 4))
md=md5(sequencia&dataseq)
senha=mid(md,tam)

senhac = senha&"C"
ArquivoXMLc = (senhac)    
Set FSO = CreateObject("Scripting.FileSystemObject") 
Set Linhas = FSO.CreateTextFile(Server.MapPath("...), True) 
...
    Linhas.WriteLine("<?xml version=""1.0"" encoding=""ISO-8859-1""?>")   
    Linhas.WriteLine("<ans:mensagemTISS xmlns:ans=""http://www.ans.gov.br/padroes/tiss/schemas""'>http://www.ans.gov.br/padroes/tiss/schemas"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xsi:schemaLocation=""http://www.ans.gov.br/padroes/tiss/schemas tissV2_01_03.xsd"">")
...    
End if

registros=Request("Registros")
For cont=1 to registros

cod="id"&cont
varCod=Request(cod)

SQL = "Select * From ... where id = '"&varCod&"' "
Set rs = MyConn.execute(SQL)

if not rs.EOF then 
...
nome = TiraAcento(rs("nome"))
...
Linhas.WriteLine("<ans:nomeBeneficiario>"&nome&"</ans:nomeBeneficiario>") 
... 

[fabiosc80 0]

tenta isso:

 

<%arquivo = RS("nome")%>
<%
arquivo = Replace(arquivo, " ", "_") : arquivo = Replace(arquivo, "'", "") : arquivo = Replace(arquivo, chr(34), "") : arquivo = Replace(arquivo, "/", "_")
arquivo = Replace(arquivo, "á", "a") : arquivo = Replace(arquivo, "à", "a") : arquivo = Replace(arquivo, "ã", "a") : arquivo = Replace(arquivo, "â", "a")
arquivo = Replace(arquivo, "é", "e") : arquivo = Replace(arquivo, "è", "e") : arquivo = Replace(arquivo, "ê", "e")
arquivo = Replace(arquivo, "í", "i") : arquivo = Replace(arquivo, "ì", "i")
arquivo = Replace(arquivo, "ó", "o") : arquivo = Replace(arquivo, "ò", "o") : arquivo = Replace(arquivo, "õ", "o") : arquivo = Replace(arquivo, "ô", "o")
arquivo = Replace(arquivo, "ú", "u") : arquivo = Replace(arquivo, "ù", "u") : arquivo = Replace(arquivo, "ü", "u")
arquivo = Replace(arquivo, "ç", "c") : arquivo = Replace(arquivo, ",", "") : arquivo = Replace(arquivo, ":", "_")
arquivo = Replace(arquivo, "º", "o") : arquivo = Replace(arquivo, "ª", "a") : arquivo = Replace(arquivo, ",", "")
%>

[vivi@ne 0]

tenta isso:

 

<%arquivo = RS("nome")%>
<%
arquivo = Replace(arquivo, " ", "_") : arquivo = Replace(arquivo, "'", "") : arquivo = Replace(arquivo, chr(34), "") : arquivo = Replace(arquivo, "/", "_")
arquivo = Replace(arquivo, "á", "a") : arquivo = Replace(arquivo, "à", "a") : arquivo = Replace(arquivo, "ã", "a") : arquivo = Replace(arquivo, "â", "a")
arquivo = Replace(arquivo, "é", "e") : arquivo = Replace(arquivo, "è", "e") : arquivo = Replace(arquivo, "ê", "e")
arquivo = Replace(arquivo, "í", "i") : arquivo = Replace(arquivo, "ì", "i")
arquivo = Replace(arquivo, "ó", "o") : arquivo = Replace(arquivo, "ò", "o") : arquivo = Replace(arquivo, "õ", "o") : arquivo = Replace(arquivo, "ô", "o")
arquivo = Replace(arquivo, "ú", "u") : arquivo = Replace(arquivo, "ù", "u") : arquivo = Replace(arquivo, "ü", "u")
arquivo = Replace(arquivo, "ç", "c") : arquivo = Replace(arquivo, ",", "") : arquivo = Replace(arquivo, ":", "_")
arquivo = Replace(arquivo, "º", "o") : arquivo = Replace(arquivo, "ª", "a") : arquivo = Replace(arquivo, ",", "")
%>

Usei como você postou e o resultado foi "Maria_José".

O acento continua lá

[xanburzum 169]

tenta esta funcaun

 

Function RemoveAcentos(ByVal Texto)
    Dim ComAcentos
    Dim SemAcentos
    Dim Resultado
	Dim Cont
    'Conjunto de Caracteres com acentos
    ComAcentos = "ÁÍÓÚÉÄÏÖÜËÀÌÒÙÈÃÕÂÎÔÛÊáíóúéäïöüëàìòùèãõâîôûêÇç"
    'Conjunto de Caracteres sem acentos
    SemAcentos = "AIOUEAIOUEAIOUEAOAIOUEaioueaioueaioueaoaioueCc"
    Cont = 0
    Resultado = Texto
    Do While Cont < Len(ComAcentos)
	Cont = Cont + 1
	Resultado = Replace(Resultado, Mid(ComAcentos, Cont, 1), Mid(SemAcentos, Cont, 1))
    Loop
    RemoveAcentos = Resultado
End Function

[Salgado 4]

Dê um response.Write no campo do BD, e depois na variável Nome e verifique no código fonte HTML como está o resultado.

 

Aconselho a, primeiro fazer a função funcionar e depois fazer o uso do FSO e da gravação do arquivo.

[vivi@ne 0]

tenta esta funcaun

 

Function RemoveAcentos(ByVal Texto)
    Dim ComAcentos
    Dim SemAcentos
    Dim Resultado
	Dim Cont
    'Conjunto de Caracteres com acentos
    ComAcentos = "ÁÍÓÚÉÄÏÖÜËÀÌÒÙÈÃÕÂÎÔÛÊáíóúéäïöüëàìòùèãõâîôûêÇç"
    'Conjunto de Caracteres sem acentos
    SemAcentos = "AIOUEAIOUEAIOUEAOAIOUEaioueaioueaioueaoaioueCc"
    Cont = 0
    Resultado = Texto
    Do While Cont < Len(ComAcentos)
	Cont = Cont + 1
	Resultado = Replace(Resultado, Mid(ComAcentos, Cont, 1), Mid(SemAcentos, Cont, 1))
    Loop
    RemoveAcentos = Resultado
End Function

 

Nada...

[vivi@ne 0]

Dê um response.Write no campo do BD, e depois na variável Nome e verifique no código fonte HTML como está o resultado.

 

Aconselho a, primeiro fazer a função funcionar e depois fazer o uso do FSO e da gravação do arquivo.

 

 

Tirei todo FSO da página e testei, mesmo assim não faz o replace.

O html traz o bd certinho, a instrução SQL e o Recordset sempre com acentuação.

 

Se eu escrevo "Maria José" e faço o replace funciona, mas se eu mando fazer o replace no Recordset, não funciona

[Salgado 4]

As funções estão funcionando.

 

Vamos fazer o seguinte então, jogue o dado do RS em uma variável e faça o replace nessa variável para testar. Caso isso não funcione faça o Replace usando o HTMLEncode de cada letra acentuada.

 

Caso tenha duvidas, ou não funcione, poste novamente. Caso funcione poste também.

[xanburzum 169]

estranho acabei de testar a funcaun e esta normal

 

Function RemoveAcentos(ByVal Texto)
   Dim ComAcentos  
  Dim SemAcentos   
 Dim Resultado       
 Dim Cont  
  'Conjunto de Caracteres com acentos 
   ComAcentos = "ÁÍÓÚÉÄÏÖÜËÀÌÒÙÈÃÕÂÎÔÛÊáíóúéäïöüëàìòùèãõâîôûêÇç"  
  'Conjunto de Caracteres sem acentos  
  SemAcentos = "AIOUEAIOUEAIOUEAOAIOUEaioueaioueaioueaoaioueCc"    
Cont = 0  
  Resultado = Texto   
 Do While Cont < Len(ComAcentos)   
     Cont = Cont + 1   
     Resultado = Replace(Resultado, Mid(ComAcentos, Cont, 1), Mid(SemAcentos, Cont, 1)) 
   Loop  
  RemoveAcentos = Resultado
End Function

[vivi@ne 0]

estranho acabei de testar a funcaun e esta normal

 

Function RemoveAcentos(ByVal Texto)
   Dim ComAcentos  
  Dim SemAcentos   
 Dim Resultado       
 Dim Cont  
  'Conjunto de Caracteres com acentos 
   ComAcentos = "ÁÍÓÚÉÄÏÖÜËÀÌÒÙÈÃÕÂÎÔÛÊáíóúéäïöüëàìòùèãõâîôûêÇç"  
  'Conjunto de Caracteres sem acentos  
  SemAcentos = "AIOUEAIOUEAIOUEAOAIOUEaioueaioueaioueaoaioueCc"    
Cont = 0  
  Resultado = Texto   
 Do While Cont < Len(ComAcentos)   
     Cont = Cont + 1   
     Resultado = Replace(Resultado, Mid(ComAcentos, Cont, 1), Mid(SemAcentos, Cont, 1)) 
   Loop  
  RemoveAcentos = Resultado
End Function

desculpe me expressei mal, a função funciona, aliás todas elas, mas não tira a acentuação. Consigo trocar todos os outros caracteres menos os acentuados

[vivi@ne 0]

As funções estão funcionando.

 

Vamos fazer o seguinte então, jogue o dado do RS em uma variável e faça o replace nessa variável para testar. Caso isso não funcione faça o Replace usando o HTMLEncode de cada letra acentuada.

 

Caso tenha duvidas, ou não funcione, poste novamente. Caso funcione poste também.

 

Como faço o Replace usando o HTMLEncode de cada letra acentuada?

[Salgado 4]

Fiz uma alteração na função que o Xan passou. Assim ela passa a substituir o código HTML do caractere acentuado pelo mesmo sem o acento.

 

Function RemoveAcentos(ByVal Texto)
   Dim ComAcentos
   Dim SemAcentos
   Dim Resultado
       Dim Cont
   'Conjunto de Caracteres com acentos
   ComAcentos = "ÁÍÓÚÉÄÏÖÜËÀÌÒÙÈÃÕÂÎÔÛÊáíóúéäïöüëàìòùèãõâîôûêÇç"
   'Conjunto de Caracteres sem acentos
   SemAcentos = "AIOUEAIOUEAIOUEAOAIOUEaioueaioueaioueaoaioueCc"
   Cont = 0
   Resultado = Texto
   Do While Cont < Len(ComAcentos)
       Cont = Cont + 1
       Resultado = Replace(Resultado, Server.HTMLEncode(Mid(ComAcentos, Cont, 1)), Mid(SemAcentos, Cont, 1))
   Loop
   RemoveAcentos = Resultado
End Function

Testa e veja se funciona.

[vivi@ne 0]

Fiz uma alteração na função que o Xan passou. Assim ela passa a substituir o código HTML do caractere acentuado pelo mesmo sem o acento.

 

Function RemoveAcentos(ByVal Texto)
    Dim ComAcentos
    Dim SemAcentos
    Dim Resultado
        Dim Cont
    'Conjunto de Caracteres com acentos
    ComAcentos = "ÁÍÓÚÉÄÏÖÜËÀÌÒÙÈÃÕÂÎÔÛÊáíóúéäïöüëàìòùèãõâîôûêÇç"
    'Conjunto de Caracteres sem acentos
    SemAcentos = "AIOUEAIOUEAIOUEAOAIOUEaioueaioueaioueaoaioueCc"
    Cont = 0
    Resultado = Texto
    Do While Cont < Len(ComAcentos)
        Cont = Cont + 1
        Resultado = Replace(Resultado, Server.HTMLEncode(Mid(ComAcentos, Cont, 1)), Mid(SemAcentos, Cont, 1))
    Loop
    RemoveAcentos = Resultado
End Function

Testa e veja se funciona.

 

Tô quase desistindo, não funciona, troca qualquer outro caracter mas não o acentuado...

Mesmo quando dou um HTMLEncode no RS a resposta é sempre a mesma "Maria José" com acento

 

Estive olhando no bd mas não encontrei nada diferente no MySql...