Jump to content
Fórum Script Brasil
  • 0

Cotação Do Dolar, Previsao Tempo


adriano182
 Share

Question

5 answers to this question

Recommended Posts

  • 0

Script Cotação do dolar... Não me lembro onde peguei este código, mas mantenham o crédito...

Agora esta tudo OK!

<%

' Função para a captura do dólar comercial diretamente do site do Banco Central.

' Autor  : Adriano Dias

' E-mail : [email protected]

' Data  : 03/Ago/2001

' Use, altere, melhore a vontade, mas por favor, não esqueça os créditos.

Response.Expires = 0

Session.LCID    = 1046

Err.Clear

On Error Resume Next

Set obj = CreateObject("MSXML2.ServerXMLHTTP")

obj.open "GET", "http://www.bcb.gov.br/htms/infecon/taxas/taxas.htm"

obj.send

textHTML = obj.ResponseText

dados    = LCase(textHTML)

' Procura pela posição da string "Taxa de Venda"

i = 1

i = inStr(i,dados,"taxa de venda")

' Procura pela 1ª tag <tr> depois de "Taxa de Venda"

i    = inStr(i,dados,"<tr")

f    = inStr(i,dados,"</tr")  ' Pega a 1ª tag </tr> depois de <tr>

dados = Mid(dados,i,(f-i))    ' Retira somente linha da interesse

dados = Replace(dados,"</font>","|",1,2) ' Substitui </font> por "|" (2 vezes)

dados = Trim(LimpaHTML(dados))          ' Retira todas as tags

dados = Split(dados,"|")                ' Separa criando a matriz

dat = DateAdd("d",-1,Date) ' Data Base (Hoje - 1 dia). A Cotação é sempre do dia anterior

set conn = Server.CreateObject("ADODB.Connection")

conn.open Application("conn")

' Verifica se os dados parecem válidos

if not isDate(dados(0)) or not isNumeric(dados(1)) or not isNumeric(dados(2)) then

  msgerro = "Provavel problema com os dados capturados. " & vbcrlf & _

            "Data Base (" & ConverteData(dat,"DD/MM/YYYY") &  ") " & vbcrlf & _

            "Dados Recebidos (Data: " & dados(0) & ",Compra: " & dados(1) & ",Venda: " & dados(2) & ")"

  Finaliza

end if

' Verifica se a data recebida parece válida (considerado no max. 4 dias desatulizado. Ex. Carnaval : (Sáb, Dom, Seg, Ter)

if (DateDiff("d",CDate(dados(0)),dat) > 4) or (DateDiff("d",CDate(dados(0)),dat) < 0) then

  msgerro = "Datas de captura e data base muito distantes. " & vbcrlf & _

            "(Capturada)/(Base) : (" & dados(0) & ")/(" & dat & ")"

  Finaliza

end if

' Se houve uma falha não maior que 4 dias e o dia não é final de semana, atualiza com a ultima data e avisa o admin.

if (not WeekDay(dat) = 1) and (not WeekDay(dat) = 7) and (CDate(dados(0)) <> dat) then

  msgerro = "Data de atualização diferente da data esperada. Trata-se de um feriado ? " & vbcrlf & _

            "Os dados foram incluídos, porém certifique se está correto. Datas : (Recebida)/(Base) (" & dados(0) & ")/(" & dat & ")"

end if

' Mostra os dados capturados

inf = Array("Data","Compra","Venda")

For i = lbound(dados) to ubound(dados)

    Response.Write inf(i) & " : " & dados(i) & "<br>"

Next

Finaliza

' Final da rotina

' Sub´s e Function´s

Sub Finaliza

  if Len(msgerro) <> 0 then ' Se existe uma mensagem de erro...

    ' Envia e-mail para o Administrador

    Set ObjMail = CreateObject("CDONTS.NewMail")

    objMail.Send "[email protected]", "[email protected]", "Problemas com atualizacao da cotacao do dolar", msgerro

      Set ObjMail = nothing

      Response.Write "Erro na captura..."

  end if

  if Err.Number <> 0 then ' Se Err.Number contiver algo...

    ' Envia e-mail para o Administrador

    msgerro = "Erro Desconhecido. Cód. Erro : " & Err.Number & "  (" & Err.Description & ")" & vbcrlf & _

                "Conteúdo da página de Erro : " & vbcrlf & vbcrlf & LimpaHTML(Replace(textHTML,"<br>",vbcrlf))

    Set ObjMail = CreateObject("CDONTS.NewMail")

    objMail.Send "[email protected]", "[email protected]", "Problemas com atualizacao da cotacao do dolar", msgerro

    Set ObjMail = nothing

      Response.Write "Erro na captura..."

  end if

  conn.close

  set conn = nothing

  Response.End

End Sub

Function Strzero(val,num)

  val = Trim(CStr(val))

  Strzero = String(num-len(val),"0") & val

End Function

Function ConverteData (valor,formato)

if not isDate(valor) then

  Response.Write "Data Inválida !"

  Response.End

else

  formato = UCase(formato)

  if Trim(formato) = "" then formato = "DD/MM/YYYY HH:MI:SS"

  formato      = Replace(formato,"YYYY",Year(valor))

  formato      = Replace(formato,"MM",Strzero(Month(valor),2))

  formato      = Replace(formato,"DD",Strzero(Day(valor),2))

  formato      = Replace(formato,"HH",Strzero(Hour(valor),2))

  formato      = Replace(formato,"MI",Strzero(Minute(valor),2))

  ConverteData = Replace(formato,"SS",Strzero(Second(valor),2))

end if

End Function

Function LimpaHTML(matriz)

Do While True

  ini    = InStr(1,matriz,"<")

  If ini  = 0 Then Exit Do

  fim    = InStr(ini,matriz,">")

  parcial = Mid(matriz,ini,fim-ini+1)

  matriz  = Replace(matriz,parcial,"")

Loop

LimpaHTML  = matriz

End Function

%>

Edited by --_Michel_--
Link to comment
Share on other sites

Guest
This topic is now closed to further replies.
 Share



  • Forum Statistics

    • Total Topics
      150.7k
    • Total Posts
      648.4k
×
×
  • Create New...