Já faz algum tempo que percebi que o componente para requisição HTTP da Microsoft conhecido como XMLHTTP tem um sério problema na leitura de páginas que contenham acentos.
Como não encontrei nenhuma solução no site da Microsoft, desenvolvi a minha própria e que funciona perfeitamente.
A solução consiste na utilização de uma função que converte os dados em formato Binário para String (chamada BinaryToString), desta forma ao resgatar o conteúdo de uma URL é preciso trazê-lo somente em formato binário e depois convertê-lo. Desta forma não ocorre mais os problemas de acentuação.
Public Function BinaryToString(xBinary)
Dim Binary
Dim RS, LBinary
If VarType(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary
Const adLongVarChar = 201
Set RS = CreateObject("ADODB.Recordset")
LBinary = LenB(Binary)
If LBinary>0 Then
RS.Fields.Append "mBinary", adLongVarChar, LBinary
RS.Open
RS.AddNew
RS("mBinary").AppendChunk Binary
RS.Update
BinaryToString = RS("mBinary")
Else
BinaryToString = ""
End If
Set RS = Nothing
End Function
Public Function MultiByteToBinary(MultiByte)
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("ADODB.Recordset")
LMultiByte = LenB(MultiByte)
If LMultiByte>0 Then
RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
RS.Open
RS.AddNew
RS("mBinary").AppendChunk MultiByte & ChrB(0)
RS.Update
Binary = RS("mBinary").GetChunk(LMultiByte)
End If
Set RS = Nothing
MultiByteToBinary = Binary
End Function
Declaração das variáveis:
Dim objXmlHttp
Dim Url
Dim Conteudo
Inicialização do objeto:
Set objXmlHttp = Server.CreateObject("MSXML2.XMLHTTP")Url do Site:
Url = "http://rss.terra.com.br/0,,EI4795,00.xml"
Resgatando os dados da URL via HTTP:
objXMLHttp.Open "GET", Url, False
objXMLHttp.Send
Utilizando a função BinaryToString não haverá mais problemas com acentos.
Conteudo = BinaryToString(objXmlHttp.ResponseBody)
Response.ContentType = "text/xml"
Response.Write Conteudo
Destruição do objeto:
Set objXmlHttp = Server.CreateObject("MSXML2.XMLHTTP")
Public Function BinaryToString(xBinary)
Dim Binary
Dim RS, LBinary
If VarType(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary
Const adLongVarChar = 201
Set RS = CreateObject("ADODB.Recordset")
LBinary = LenB(Binary)
If LBinary>0 Then
RS.Fields.Append "mBinary", adLongVarChar, LBinary
RS.Open
RS.AddNew
RS("mBinary").AppendChunk Binary
RS.Update
BinaryToString = RS("mBinary")
Else
BinaryToString = ""
End If
Set RS = Nothing
End Function
Public Function MultiByteToBinary(MultiByte)
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("ADODB.Recordset")
LMultiByte = LenB(MultiByte)
If LMultiByte>0 Then
RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
RS.Open
RS.AddNew
RS("mBinary").AppendChunk MultiByte & ChrB(0)
RS.Update
Binary = RS("mBinary").GetChunk(LMultiByte)
End If
Set RS = Nothing
MultiByteToBinary = Binary
End Function
Declaração das variáveis:
Dim objXmlHttp
Dim Url
Dim Conteudo
Inicialização do objeto:
Set objXmlHttp = Server.CreateObject("MSXML2.XMLHTTP")
Url do Site:
Url = "http://rss.terra.com.br/0,,EI4795,00.xml"Resgatando os dados da URL via HTTP:
objXMLHttp.Open "GET", Url, False
objXMLHttp.Send
Utilizando a função BinaryToString não haverá mais problemas com acentos.
Conteudo = BinaryToString(objXmlHttp.ResponseBody)
Response.ContentType = "text/xml"
Response.Write Conteudo
Destruição do objeto:
Set objXmlHttp = Server.CreateObject("MSXML2.XMLHTTP")
