Código Fonte - O melhor conteúdo para programadores

Autor

VbScript

Compartilhe e guarde

Enquete

Que banco de dados você utiliza em seus projetos?

Solução do problema de acentos do XMLHTTP da Microsoft

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")
%>

Este código foi útil para você?

Nota	Comentário
Ainda não foi enviado nenhum comentário.

Regras:
Os comentários seguem as seguintes regras:

Todos os comentários são enviados por membros cadastrados no site.
A pontuação de comentários de conteúdo do próprio membro não serão computados.
Os comentários serão pré-aprovados, porém a equipe do site revisará o conteúdo de todos os comentários podendo ser invalidados (inclusive a pontuação).
Os comentários precisam ter, obrigatóriamente, coerência sobre o conteúdo que será comentado.
O membro que atingir 5 comentários invalidados não poderá mais comentar dentro do site. Com isso o membro não poderá mais ganhar pontos com comentários.
Há um limite de 10 comentários por dia para cada membro.
Qualquer comentário após ter sido publicado poderá ser retirado através da opção ( denunciar)

Comente

Autenticação:	Apelido: Senha: (ainda não tem cadastro? clique aqui!)

Título:	Máximo de 30 caracteres
Comentário:	Máximo de 255 caracteres
Avaliação:

Equipe | Tabela de Pontos e Estrelas | Política de Privacidade | Mapa do Site | Fale Conosco