Componente (Cotação do Dolar)

[briam 0]

Ola pessoal, bom, não sou programador, mas me viro com alguns códigos quando a água bate...

Bom, baixei um código que (acho eu) precisa de um componente instalado no servidor. Ai vai um pedacinho do código:

 

Set VL_OBJ_XML = Server.CreateObject("Microsoft.XMLHTTP")

 

Gostaria da confirmação dos colegas. Como você´s pdoem ver, como programador, eu sou um otimo designer... Eu não sei se á o nome do componente ou algo parecido...

 

A segunda parte do problema é que estou precisando de um código que capture de alguma fonte qualquer a cotação do dolar em tempo real. Se não fosse esse componente eu já tinha achado.

 

Alguem saberia me dar alguma dica. Abaixo segue o codigo completo para analise.

 

<%

Dim VL_Cotacao

Dim VL_Cotacoes

Call funGetCotacaoDolar() ' Resgatando a cotação do dolar

%>

 

<%

 

Function funGetCotacaoDolar()

 

VL_Cotacao = funGetURLCode( "http://www.investshop.com.br/mer/include/Dolar.csv" )

VL_Cotacao = Replace(VL_Cotacao, VbCrLf, ";")

VL_Cotacoes = Split(VL_Cotacao,";")

 

' DOLAR COMERCIAL

' VL_Cotacoes(5) '-> COMPRA

' VL_Cotacoes(6) '-> VENDA

' VL_Cotacoes(7) '-> VARIACAO

 

' DOLAR PARALELO

' VL_Cotacoes(9) '-> COMPRA

' VL_Cotacoes(10) '-> VENDA

' VL_Cotacoes(11) '-> VARIACAO

 

' DOLAR TURSIMO

' VL_Cotacoes(13) '-> COMPRA

' VL_Cotacoes(14) '-> VENDA

' VL_Cotacoes(15) '-> VARIACAO

 

' DOLAR PTAX

' VL_Cotacoes(17) '-> COMPRA

' VL_Cotacoes(18) '-> VENDA

' VL_Cotacoes(19) '-> VARIACAO

 

End Function

 

 

Function funGetURLCode( pURL )

 

on error resume next

 

DIM VL_OBJ_XML

DIM VL_OBJ_RSP

 

Set VL_OBJ_XML = Server.CreateObject("Microsoft.XMLHTTP")

VL_OBJ_XML.open "GET", pURL, "False"

VL_OBJ_XML.setRequestHeader "MessageType", "CALL"

VL_OBJ_XML.setRequestHeader "Content-Type", "text/xml"

VL_OBJ_XML.send

VL_OBJ_RSP = RSBinaryToString( VL_OBJ_XML.responseBody )

Set VL_OBJ_XML = Nothing

funGetURLCode = (VL_OBJ_RSP)

 

End Function

 

 

Function RSBinaryToString(xBinary)

 

Dim Binary

 

If VarType(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary

 

Dim RS, LBinary

Const adLongVarChar = 201

 

Set RS = Server.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")

 

Else

 

RSBinaryToString = ""

 

End If

 

Set RS=Nothing

 

End Function

 

Function MultiByteToBinary(MultiByte)

 

Dim RS, LMultiByte, Binary

Const adLongVarBinary = 205

 

Set RS = Server.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

%>

[Penna 0]

Se você estiver usando o IIS (Internet Information Server) ele já vem instalado e pronto pra uso. Se tiver usando o PWS do win 98, creio eu que não existe possibilidade de instalação.Depois dessa verificação, nos informe o erro que esta dando no seu código.