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

[zrageburn 0]

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/")
	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/",""))
	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