[Resolvido] Script para pegar previsão do tempo do Weather.MSN

Segue um script que fiz com a ajuda de um amigo pra poder pegar a previsão do tempo do Weather MSN para a cidade de Londrina... (já testei com Maringá, Curitiba e São Paulo também e funcionou 100%... hehehe

Recomendo que seja criado um VBS (agendado - 2x/dia) para criar o arquivo de include, pois dependendo da demanda, pode gerar erros.

Para trocar a cidade, pegue o valor da URL, e abra no browser, aí no campo Find weather for:, coloque a cidade que deseja.

Espero que seja útil... hehehe.

Abraços.

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

Dim objXmlHttp
Dim URL
Dim conteudo
Dim icone
Dim maxima
Dim minima

Set objXmlHttp = Server.CreateObject("MSXML2.XMLHTTP")

[b]URL = "http://weather.msn.com/local.aspx?&wealocations=wc:BRXX0137&q=Londrina,+BRA&setunit=C" [/b]

objXMLHttp.Open "GET", URL, False
objXMLHttp.Send

conteudo = BinaryToString(objXmlHttp.ResponseBody)

i = 1

	i = inStr(i,conteudo,"<td class=""icon""><img src=""[http://blst.msn.com/as/wea3/i/en-us/saw/")](http://blst.msn.com/as/wea3/i/en-us/saw/)
	f = inStr(i,conteudo,".gif")
	icone = Mid(conteudo,i,(f-i))
	icone = trim(replace(icone,"<td class=""icon""><img src=""[http://blst.msn.com/as/wea3/i/en-us/saw/",""))](http://blst.msn.com/as/wea3/i/en-us/saw/)
	icone = icone & ".gif"

	i2 = 1
	i2 = inStr(i2,conteudo,"<th>Hi:</th>")
	f2 = inStr(i2,conteudo,"°</td>")
	maxima = Mid(conteudo,i2,(f2-i2))
	maxima = trim(replace(maxima,"<th>Hi:</th>",""))
	maxima = trim(replace(maxima,"<td>",""))

	i3 = 1
	i3 = inStr(i3,conteudo,"<th>Lo:</th>")
	f3 = inStr(i3,conteudo,"°</td>")
	minima = Mid(conteudo,i3,(f3-i3))
	minima = trim(replace(minima,"<th>Lo:</th>",""))
	minima = trim(replace(minima,"<td>",""))

Set objXmlHttp = Nothing