Cotação do Dólar

[hinom 5]

<%' Função para a captura do dólar comercial diretamente do site do Banco Central.' Autor  : Adriano Dias' E-mail : adiasbr@yahoo.com.br' Data   : 03/Ago/2001' Use, altere, melhore a vontade, mas por favor, não esqueça os créditos.Response.Expires = 0Session.LCID     = 1046Err.ClearOn Error Resume NextSet obj = CreateObject("MSXML2.ServerXMLHTTP")obj.open "GET", "http://www.bcb.gov.br/htms/infecon/taxas/taxas.htm"obj.sendtextHTML = obj.ResponseTextdados    = LCase(textHTML)' Procura pela posição da string "Taxa de Venda"i = 1i = 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 interessedados = Replace(dados,"</font>","|",1,2) ' Substitui </font> por "|" (2 vezes)dados = Trim(LimpaHTML(dados))           ' Retira todas as tagsdados = Split(dados,"|")                 ' Separa criando a matrizdat = DateAdd("d",-1,Date) ' Data Base (Hoje - 1 dia). A Cotação é sempre do dia anteriorset conn = Server.CreateObject("ADODB.Connection")conn.open Application("conn")' Verifica se os dados parecem válidosif 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) & ")"   Finalizaend 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 & ")"   Finalizaend 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 capturadosinf = Array("Data","Compra","Venda")For i = lbound(dados) to ubound(dados)    Response.Write inf(i) & " : " & dados(i) & ""NextFinaliza' Final da rotina' Sub´s e Function´sSub 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 "sender@dominio", "admin@dominio", "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,"",vbcrlf))     Set ObjMail = CreateObject("CDONTS.NewMail")      objMail.Send "sender@dominio", "admin@dominio", "Problemas com atualizacao da cotacao do dolar", msgerro     Set ObjMail = nothing       Response.Write "Erro na captura..."  end if  conn.close  set conn = nothing  Response.EndEnd SubFunction Strzero(val,num)   val = Trim(CStr(val))   Strzero = String(num-len(val),"0") & valEnd FunctionFunction ConverteData (valor,formato)if not isDate(valor) then   Response.Write "Data Inválida !"   Response.Endelse   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 ifEnd FunctionFunction 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,"")LoopLimpaHTML  = matrizEnd Function%>

 

por favor, mantenham os créditos.

[d.eleete 0]

Muito 10 esse codigo B) . . e com certeza iremos manter os créditos!

[nickian 0]

Olá, :rolleyes: está dando o seguinte erro:Erro na captura...Erro na captura...Data : 30/07/2003Compra : 2,9465Venda : 2,9473Erro na captura...Erro na captura... Por que ?

[hinom 5]

Olá, :D está dando o seguinte erro:Erro na captura...Erro na captura...Data : 30/07/2003Compra : 2,9465Venda : 2,9473Erro na captura...Erro na captura... Por que ?

pra evitar isso simplesmente desabilite as mensagens

[sodra 0]

c eu for teste issu no meu pc no pws vai funcionar? naum precisa d ennhum componente?

[Alan Vilaça 0]

ai galera não estou conseguindo colocar, esse código na minha página alguem poderia por favor me ajudar???ICQ: 124009074MSN: avilaca@semrodeios.com.brMuito Obrigado Antecipadamente...

[WEBIER 0]

seguinte erro:

 

# Tipo de erro:

Erro de compilação do Microsoft VBScript (0x800A0409)

Constante de seqüência não finalizada

/cotacao.asp, line 33, column 22

i = inStr(i,dados,"

[hargon 64]

Copie o código novamente.

 

Devido ter sido postado com a tag QUOTE, houve um erro na exibição do código, mas agora está ok.

[desisto 0]

sistema de 2001...

 

a pagina - http://www.bcb.gov.br/htms/infecon/taxas/taxas.htm - nao existe mais

[hargon 64]

Boa observação desisto. Esse código é bem antigo. Existem outros mais novos por aqui, e caso tenha interesse em criar um novo, certamente tentaremos lhe ajudar.

[desisto 0]

eu conheci esse codigo a uns longos anos, por isso fui direto ver a url

 

a pg ja esta fora a muito tempo

[xanburzum 169]

olha este code

 

<%
Set HttpObj = Server.CreateObject("AspHTTP.Conn")
HttpObj.URL = "http://www.investshop.com.br/mer/include/Dolar.csv"
cotacao = HttpObj.GetUrl
cotacoes = replace(cotacao,"Nome;Compra;Venda;Variacao","") ' Tira a primeira parte que e lixo
' Coloca Valores em uma Array
dim valores()
dim cont, cont_valores
for cont = 1 to len(cotacoes) step 1
if (mid(cotaco s,cont,1) = ";") or (mid(cotacoes,cont,1) r = " ") or (mid(cotacoes,cont,1) = Chr(10))then
cont_valores = cont_valores + 1
Redim Preserve valores(cont_valores)
valores(cont_valores) = Cstr(str)
str = ""
else
str = str + mid(cotacoes,cont,1)
end if 
next
' Fim Coloca valores em uma Array

' Coloca os valores nas variaveis
DOLAR_COMERCIAL_COMPRA = valores(3)
DOLAR_COMERCIAL_VENDA = valores(4)
DOLAR_COMERCIAL_VARIACAO = valores(5)

DOLAR_PARALELO_COMPRA = valores(7)
DOLAR_PARALELO_VENDA = valores(8)
DOLAR_PARALELO_VARIACAO = valores(9)

DOLAR_TURISMO_COMPRA = valores(11)
DOLAR_TURISMO_VENDA = valores(12)
DOLAR_TURISMO_VARIACAO = valores(13)

PTAX_COMPRA = valores(15)
PTAX_VENDA = valores(16)
PTAX_VARIACAO = valores(17)
' Fim coloca os valores nas variaveis

%>