Capturando informações climáticas para estatísticas

Olá pessoal. Quero agradecer pelos e-mails que tenho recebido oferecendo-me um feedback das publicações. Desejo que essas sejam úteis!

Nesse boletim veremos como capturar dados de outro site, especificamente do http://br.weather.com, site que disponibiliza dados de condições climáticas (temperatura, céu, sensação térmica, visibilidade entre outras informações).

A utilização deste recurso está me propiciando diversas análises na área que atuo. Sem mais delongas, vamos lá!

Obs.: Comunique o responsável pelo site e peça autorização para realizar essa ação**.

Cenário

Dispor de informação para criar análises de consumo de água através das condições climáticas.

Necessidade

É necessário amostras diárias para compor o estudo.

Criando rotina para capturar dados
Armazenamento
Banco SQL

/*CRIAR TABELA*/
CREATE TABLE [dbo].[TEMPO](
	[ID] [numeric](18, 0) IDENTITY(1,1) NOT NULL,
	[ATC] [varchar](150) COLLATE SQL_Latin1_General_CP1_CI_AS NULL,
	[ATCOM] [varchar](150) COLLATE SQL_Latin1_General_CP1_CI_AS NULL,
	[ORIGEM] [varchar](150) COLLATE SQL_Latin1_General_CP1_CI_AS NULL,
	[EXECUCAO] [varchar](50) COLLATE SQL_Latin1_General_CP1_CI_AS NULL,
	[TEMPERATURA] [varchar](50) COLLATE SQL_Latin1_General_CP1_CI_AS NULL,
	[SENSACAO] [varchar](50) COLLATE SQL_Latin1_General_CP1_CI_AS NULL,
	[CEU] [varchar](50) COLLATE SQL_Latin1_General_CP1_CI_AS NULL,
	[VENTO] [varchar](50) COLLATE SQL_Latin1_General_CP1_CI_AS NULL,
	[ORVALHO] [varchar](50) COLLATE SQL_Latin1_General_CP1_CI_AS NULL,
	[UMIDADE] [varchar](50) COLLATE SQL_Latin1_General_CP1_CI_AS NULL,
	[VISIBILIDADE] [varchar](50) COLLATE SQL_Latin1_General_CP1_CI_AS NULL,
	[BAROMETRO] [varchar](50) COLLATE SQL_Latin1_General_CP1_CI_AS NULL,
	[EXECUTADO] [varchar](50) COLLATE SQL_Latin1_General_CP1_CI_AS NULL,
	[ARQUIVO] [varchar](50) COLLATE SQL_Latin1_General_CP1_CI_AS NULL
) ON [PRIMARY]

GO

/*ARMAZENA ERROS DE CAPTURA*/
CREATE TABLE [dbo].[ERRO_BUSCA_TEMPO](
	[id] [numeric](18, 0) IDENTITY(1,1) NOT NULL,
	[erro] [varchar](200) COLLATE SQL_Latin1_General_CP1_CI_AS NULL,
	[data] [varchar](50) COLLATE SQL_Latin1_General_CP1_CI_AS NULL
) ON [PRIMARY]

GO

Criando script VBS para captura e armazenamento

On Error Resume Next
LCID = 1046

dim dados, cCont
Dim i
Dim atcom
Dim ObjFSO, ObjFile, ObjStream, Dia, Mes, Ano, Hora, IpNum
Dim oConn 				
Dim bBancoAberto 		
Dim cCon 		
Dim ipEnvia 

Const forReading = 1, forWriting = 2, forAppending = 8
Const TriDef = -2, TriTrue = -1, TriFalse = 0

Criando matriz para informações das cidades que serão capturadas as informações.
Para o modelo, será feito apenas para uma cidade.

reDim atc(0)
reDim cidade(0)
reDim caminho(0)
reDim armazena(uBound(atc), 2)

if not bBancoAberto then 	
	bBancoAberto = false
end if

sub AbreConexao					
	cCon = "Provider=SQLOLEDB.1;Data Source=BANCO; UID=USUARIO;PWD=SENHA;database=TABELA"
	set oConn = createobject("ADODB.connection") 		
	oConn.open cCon 		
	bBancoAberto = true
end sub

sub FechaConexao				
	oConn.Close 		
	set oConn = nothing 	
	bBancoAberto = false
end sub

AbreConexao

IP para enviar mensagem caso haja alguma coisa errada com a captura

ipEnvia = "192.168.0.1"

Determinando informações das cidades que serão capturadas as informações

atc(0) = "000"

cidade(0) = "Itapetininga"

caminho(0) = 	"http://br.weather.com/weather/local/BRXX0287"

Início da captura

cCont = 0
while cCont <= uBound(atc)

	Set obj = CreateObject("microsoft.XMLHTTP")

	obj.open "GET", caminho(cCont), false 

	obj.send

	dados = RSBinaryToString(obj.responseBody)
	NdADOS = dados
	
	if len(dados) > 0 and trim(left(RemoveHTML(dados),3)) <> "Aut" then

		novoDados = limpaDados(dados, cCont)
		
		armazena(cCont,0) = replace(novoDados, vbcrlf,"<br>")
		armazena(cCont,1) = atc(cCont)
		armazena(cCont,2) = cidade(cCont)
	
	else
		call MandaRecado("Erro na captura de dados da temperatura. Verifique a cota de tempo para utilização da internet.")
		WScript.Quit (GENERAL_FAILURE)
		WScript.Echo "Saindo..."
	end if
	cCont = cCont + 1
	
wend

Function RSBinaryToString(xBinary)
	Dim Binary
	If VarType(xBinary)=8 Then 	Binary = MultiByteToBinary(xBinary) Else 	Binary = xBinary
		Dim RS, LBinary
		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
			RSBinaryToString = RS("mBinary")
			Set RS=Nothing
		Else
			RSBinaryToString = ""
		End If
	Set RS=Nothing
End Function

Armazenar em arquivo texto

*** inicia cópia
MyFile = "guardaTempo.txt"

Set ObjFSO = CreateObject("Scripting.FileSystemObject")
	
If ObjFSO.FileExists(MyFile) = False then
   objFSO.CreateTextFile(MyFile)
End If


Set ObjFile = objFSO.GetFile(MyFile)
Set objStream = ObjFile.OpenAsTextStream(forAppending,TriDef)

for cContA = 0 to uBound(atc)
	objStream.WriteLine armazena(cContA, 0)
next 

'	objStream.WriteLine RemoveHTML(nDados)

set ObjFSO = nothing
set ObjStream = nothing
set ObjFile = nothing
'*** fim copia


FechaConexao

If Err.number<>0 then
	call MandaRecado("Veja o erro!!!" & vbcrlf & vbcrlf & "A descrição fornecida é: " & Err.Description)
'else
'	call MandaRecado("Fim!")
End If



'**********************
'funções
'**********************
Function limpaDados(noticia, id)

	i = 1
	i = inStr(i,noticia ,"<!-- Insert City Name and Zip Code -->")
	f = inStr(i,noticia ,"clearFields") 
	
	if f = 0 then
		f = inStr(i,noticia ,"Umidade")
		msgBox f & "Pegou falha, mas recuperada--->"
	end if
	
	noticia = Mid(noticia ,i,(f-i)) 
	
	noticia = RemoveHTML(noticia)
	
	atcom = lTrim(nome(noticia, ",", ","))
	origem = nomeMeio(noticia, "Brasil    ", ")	") & ")"
	if trim(origem) <> "ND)" then
		execucao = nomeMeio(noticia, "Brasil. ", " Local") 
		temperatura = trim(nomeMeio(noticia, "fimArquivo   ", "ºC") & "ºC")
		sensacao = trim(nomeMeio(noticia, "Sensação de ", "Vento"))
		ceu = nomeMeio(noticia, "ºC", "Sensação")
		vento = nomeMeio(noticia, "Vento:", "Ponto ")
		orvalho = nomeMeio(noticia, "Ponto de orvalho:", "Umidade")
		umidade = nomeMeio(noticia, "Umidade:", "Visibilidade")
		visibilidade = nomeMeio(noticia, "Visibilidade:", "Barômetro")
		barometro = nomeMeio(noticia, "Barômetro:", "Í")
		arquivo = nomeMeio(noticia, "iniciaArquivo", "fimArquivo")
	else
		origem = "SEM INFORMAÇÃO"
	end if
	agora = now()
	

	If Err.number<>0 then
		call MandaRecado("Erro na cidade " & cidade(id)& " e essa não foi gravada." & vbcrlf & vbcrlf & "A descrição fornecida é: " & Err.Description)
		msgBox  noticia 
		
		wscript.quit
	else
	limpaDados =	atc(id) & "|" & atcom & "|" & origem & "|" & execucao & "|" & _
					temperatura & "|" & _
					sensacao & "|" & ceu & "|" & vento & "|" & _
					orvalho & "|" & umidade  & "|" & visibilidade & "|" & _ 
					barometro & "|" & agora & " | " & arquivo
			
	call MandaProBanco(atc(id), atcom, origem, execucao, temperatura, sensacao, ceu, vento, orvalho, umidade, visibilidade, barometro, agora, arquivo)			
	End If

end function

function nome(tnome, p1, p2)
			stringe = tnome
			x = InStr(1, stringe, p1, 1)
			y = InStr(x, stringe, p2, 1)
			
			If x <> 0 and y <> 0 Then
				'Se for <> 0 ele achou um segundo espaço 
				Resultado = Left(Stringe, x - 1)
			Else
				'Se for = 0 não havia um segundo espaço na string.
				Resultado = stringe
			End If
			nome = resultado

end function

function nomeMeio(tnome, p1, p2)
			stringe = tnome
			x = InStr(2, stringe, p1, 1)
			if x > 0 then
				y = InStr(x, stringe, p2, 1)
				If x <> 0 and y <> 0 Then
					'Se for <> 0 ele achou um segundo espaço 
					Resultado = Mid(stringe, x+(len(p1)), (y-x)-len(p1)) 
				Else
					'Se for = 0 não havia um segundo espaço na string.
					Resultado = "ND"
				End If
				nomeMeio = resultado
			else
				nomeMeio = "ND"
			end if
end function

Function RemoveHTML(strText) 'função para limpara html
	Dim RegEx
	Set RegEx = New RegExp
	RegEx.Pattern = "<[^>]*>"
	RegEx.Global = True
	RemoveHTML = replace(strText, ".gif?","fimArquivo<.gif?")
	RemoveHTML = replace(RemoveHTML, "intlwxicons/52/","intlwxicons/52/>iniciaArquivo")

	RemoveHTML = RegEx.Replace(RemoveHTML , "")
	RemoveHTML = replace(RemoveHTML, vbcrlf,"<br>")
	RemoveHTML = replace(RemoveHTML, "<br>", "")
	RemoveHTML = replace(RemoveHTML, "  ", "")
	RemoveHTML = replace(RemoveHTML, "-->", "")
	RemoveHTML = replace(RemoveHTML, " ", " ")
	RemoveHTML = replace(RemoveHTML, "°C", "°C ")
	RemoveHTML = replace(RemoveHTML, "Sensação", " Sensação")
	RemoveHTML = replace(RemoveHTML, "quilu00F4metro", " Quilômetros")
	RemoveHTML = replace(RemoveHTML, "Índice UVN/DN/D function", "")
	RemoveHTML = replace(RemoveHTML, "Índice UVN/DN/Dfunction", "")
	RemoveHTML = replace(RemoveHTML, chr(10),"")
	RemoveHTML = replace(RemoveHTML, "relatório","relatório")
	RemoveHTML = replace(RemoveHTML, "Sensação","Sensação")
	RemoveHTML = replace(RemoveHTML, "Barômetro","Barômetro")
	RemoveHTML = replace(RemoveHTML, "°","º")

End Function

function MandaProBanco(atc, atcom, origem, execucao, temperatura, sensacao, ceu, vento, orvalho, umidade, visibilidade, barometro, agora, arquivo)
	sql =	"INSERT INTO TEMPO (ATC, ATCOM, ORIGEM, EXECUCAO, TEMPERATURA, SENSACAO, CEU, VENTO, ORVALHO, UMIDADE, VISIBILIDADE, BAROMETRO, EXECUTADO, ARQUIVO ) "& _
			"VALUES(" & CampoSQL(atc) & ", " & CampoSQL(atcom) & ", " & CampoSQL(origem) & ", " &  CampoSQL(execucao) & ", " & CampoSQL(temperatura) & ", " & CampoSQL(sensacao) & ", " & CampoSQL(ceu) & ", " & CampoSQL(vento) & ", " & CampoSQL(orvalho) & ", " & CampoSQL(umidade) & ", " & CampoSQL(visibilidade) & ", " & CampoSQL(barometro) & ", " & CampoSQL(agora) & ", " & CampoSQL(arquivo) & ")"
	Set rs = oConn.Execute(sql)
	'set rs = nothing
end function

Function CampoSQL(valor)
	if isnull(valor) or trim(valor) = "" then
		CampoSQL = "null"
	else
		CampoSQL = "'" & replace(trim(valor),"'","''") & "'"
	end if
End Function

function MandaRecado(mensagem)
	agora = now()

	set WS = CreateObject("WScript.Shell")
		x=WS.Run("net send " & ipEnvia & " " & mensagem & vbcrlf & vbcrlf & "Mensagem enviada pelo guardaTempo." & vbcrlf & "",0,true)
	set WS = Nothing

	sql = "insert into ERRO_BUSCA_TEMPO (erro, data) values (" & campoSQL(mensagem) & ", " & campoSQL(agora) & ")"
	Set rs = oConn.Execute(sql)
	set rs = nothing
end function

Criado o VBS e testado, agende uma tarefa para que esse script rode a cada uma hora. Esse é o tempo médio de disponibilização das informações no site.

Bom, é isso aí! Este código é simples, mas pode ser muito útil dependendo do que você vai fazer com ele.

Para fazer o download dos arquivos desta matéria, consulte:

http://www.ricarela.com/publica004.zip

Na próxima matéria vamos construir uma rotina para montar um relatório de referência cruzada a partir de uma base de dados SQL e com parâmetros conhecidos. Depois a gente vai complicando!!!

Entre em contato para dúvidas, sugestões e críticas.

De 0 a 10, o quanto você recomendaria este artigo para um amigo?

Powered by:

Capturando informações climáticas para estatísticas

Ricardo Santanna

Cenário

Necessidade

Criando script VBS para captura e armazenamento

Ricardo Santanna