sterlina quotazione valutazione
Pagina 4
<%@ Language=VBScript %>
<%response.expires=0%>
<%server.ScriptTimeout = 120%>
<%
'Connessione col data source
strConn = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=95.110.230.101;PORT=3306;DATABASE=Sql358159_1;USER=Sql358159;PASSWORD=12421ef4;OPTION=3;"
Set Con = Server.CreateObject("ADODB.Connection")
Con.Open strConn
%>
<%
dim ValoreOro
dim ValoreOroMonete
dim ValoreOro24
dim ValoreOro18
dim ValoreOro14
ValoreOro=QuotazioneOro3
PercMonete=GetValore("Valore","impostazioni",con,"Descrizione='PercentualeMonete'")
Perc24=GetValore("Valore","impostazioni",con,"Descrizione='Percentuale24'")
Perc18=GetValore("Valore","impostazioni",con,"Descrizione='Percentuale18'")
Perc14=GetValore("Valore","impostazioni",con,"Descrizione='Percentuale14'")
QuotazioneArgento=GetValore("Valore","impostazioni",con,"Descrizione='QuotazioneArgento'")
QuotazioneArgentoGrammo=GetValore("Valore","impostazioni",con,"Descrizione='QuotazioneArgentoGrammo'")
'if QuotazioneArgento="" then
' con.execute "Insert Into impostazioni (Descrizione,Valore) VALUES ('QuotazioneArgento','0')"
'end if
if PercMonete<>"" then
ValoreOroMonete=Round(ValoreOro-ValoreOro/100*PercMonete,2)
end if
if Perc24<>"" then
ValoreOro24=Round(ValoreOro-ValoreOro/100*Perc24,2)
end if
if Perc18<>"" then
ValoreOro18=Round(ValoreOro-ValoreOro/100*Perc18,2)
end if
if Perc14<>"" then
ValoreOro14=Round(ValoreOro-ValoreOro/100*Perc14,2)
end if
function InviaMail(cFrom,cTo,cSubject,cBody)
dim eMail
dim iConf
dim Flds
Set eMail = Server.CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
Flds(cdoSendUsingMethod) = cdoSendUsingPort
'Flds(cdoSendUsing) = 2
Flds(cdoSMTPServer) = "localhost"
Flds(cdoSMTPServerPort) = 25
Flds(cdoSMTPAuthenticate) = cdoAnonymous' 1 'cdoBasic
Flds.Update
Set eMail.Configuration = iConf
eMail.From = cFrom
eMail.To = cTo
eMail.Subject = cSubject
eMail.HtmlBody = cBody
eMail.Send
Set eMail = Nothing
end function
function DataMySql(Data)
if trim(Data)="" then
DataMySql=""
else
DataMySql=Year(Data) & "/" & month(Data) & "/" & day(Data) & " " & Hour(Data) & ":" & Minute(Data) & ":" & Second(Data)
end if
end function
function DataMySqlEx(Data)
if trim(Data)="" then
DataMySqlEx=""
else
DataMySqlEx=Year(Data) & "/" & month(Data) & "/" & day(Data)
end if
end function
Sub IncrementaID(rs)
Set rsMax = server.CreateObject("Adodb.Recordset")
qrMax="select Max(id) as NewCont from " & GetNomeTabella(rs.Source)
rsMax.Open qrMax,Con,1,1
If IsNull(rsMax("NewCont")) Then
rs("id") = 1
Else
rs("id") = rsMax("NewCont") + 1
End If
rs.Update
rsMax.Close
set rsMax=nothing
End Sub
'Da usare nella insert into
Function GetNewID(Tabella)
Set rsMax = Server.CreateObject("Adodb.Recordset")
qrMax="Select Max(ID) as NewCont from " & Tabella
rsMax.open qrMax,Con,1,1
If IsNull(rsMax("NewCont")) Then
GetNewID = 1
Else
GetNewID = rsMax("NewCont") + 1
End If
rsMax.Close
set rsMax=nothing
End Function
Function GetNomeTabella(Query)
p = InStr(1, Query, "from", vbTextCompare)
a = Mid(Query, p + 5)
ar = Split(a, " ")
GetNomeTabella = ar(0)
End Function
function ValidMail(Email)
ValidMail=(instr(1,Email,"@")>0) and (instr(1,Email,".")>0)
end function
function CheckManutenzione()
set rs=server.CreateObject("Adodb.recordset")
qr="Select * from impostazioni where Descrizione='BloccoManutenzione'"
rs.Open qr,con,1,1
if Not rs.EOF then
if rs("Valore")="1" then
rs.Close
set rs=nothing
Response.Redirect "InCostruzione.asp"
Response.End
end if
end if
end function
Function RemNull(Testo, SostituisciApiciVirgole, IsData, Numerico)
Dim Vuoto
if SostituisciApiciVirgole="" then
SostituisciApiciVirgole=True
end if
if IsData="" then
IsData=False
end if
if Numerico="" then
Numerico=False
end if
If IsNull(Testo) Then
Vuoto = True
Else
If Numerico Then
If Testo = "" Then
Vuoto = True
End If
End If
End If
If Vuoto Then
If IsData Then
RemNull = "0.00.00"
ElseIf Numerico Then
RemNull = 0
Else
RemNull = ""
End If
Else
If IsData Then
If IsDate(Testo) Then
RemNull = Testo
Else
RemNull = "0.00.00"
End If
ElseIf Numerico Then
If IsNumeric(Testo) Then
If SostituisciApiciVirgole Then
RemNull = Replace(Testo, ",", ".")
Else
RemNull = Testo
End If
Else
RemNull = 0
End If
Else
If SostituisciApiciVirgole Then
RemNull = Replace(Testo, "'", "''")
Else
RemNull = CStr(Testo)
End If
End If
End If
End Function
Function GetValore(Campo, Tabella, vCon, Condizione)
Dim rs
Dim qr
If UCase(Condizione) = "ID=" Then
GetValore = 0
Exit Function
End If
set rs=Server.CreateObject("Adodb.Recordset")
qr = "Select " & Campo & " From " & Tabella & " Where " & Condizione
'Response.Write qr
'Response.End
rs.open qr,vCon,1,1
Select Case rs.Fields(Campo).Type
Case adChar,adLongVarChar,adVarChar,adVarWChar,adWChar
If rs.EOF Then
GetValore = ""
Else
GetValore = rs(Campo).value
End If
Case adBinary,adBoolean,adCurrency,adDouble,adInteger,adLongVarBinary,adNumeric,adSingle,adSmallInt,adTinyInt,adUnsignedTinyInt,adVarBinary
If rs.EOF Then
GetValore = 0
Else
GetValore = rs(Campo).value
End If
Case adDBTimeStamp,adDate
If rs.EOF Then
GetValore = "0.00.00"
Else
GetValore = rs(Campo).value
End If
End Select
rs.Close
Set rs = Nothing
End Function
Function Decrypt(Testo)
Dim ris
For i = 1 To Len(Testo)
Lett = Asc(Mid(Testo, i, 1)) - Asc(Mid(ENCRYPT_KEY, (i Mod Len(ENCRYPT_KEY)) + 1, 1))
If Lett < 0 Then
Lett = Lett + 255
End If
ris = ris & Chr(Lett Mod 255)
Next
Decrypt = ris
End Function
Function Accesso()
if Session("Login")="" then
Response.Redirect "login.asp"
end if
end function
Function QuotazioneOro()
Set objXML = CreateObject("Microsoft.XMLDOM")
objXML.setProperty "ServerHTTPRequest", True
objXML.async = False
'Carica il file XML o il feed rss in formato xml
strFile = "http://dgcsc.org/goldprices.xml"
If objXML.Load(strFile) Then
Set AllItems = objXML.selectNodes("//GoldPrice")
Set Post = AllItems(0).selectNodes("Price[@currencycode='EUR']")
QuotazioneOro = CDbl(Replace(Post(0).Text, ".", ","))
Set Post = Nothing
Set AllItems = Nothing
Set objXML = Nothing
Else
QuotazioneOro = 0
End If
End Function
Private Function QuotazioneOro2()
Dim Html
Dim objXMLHTTP, xml, text
Set xml = CreateObject("Microsoft.XMLHTTP")
'Or if this doesn't work then try :
'Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.Open "GET", "http://safimet.com/quotazioni/quotazioni.asp", False
xml.send
Html = xml.responseText
Set xml = Nothing
'Trova la scritta euro
p = InStr(1, Html, "€/Gr.")
If p = 0 Then
p = InStr(1, Html, "/Gr.")
End If
If p > 0 Then
'Va avanti fino al primo numero
'">
Do While Mid(Html, p, 2) <> """>" And p < Len(Html)
p = p + 1
Loop
Do While Not IsNumeric(Mid(Html, p, 1)) And p < Len(Html)
p = p + 1
Loop
Do While (IsNumeric(Mid(Html, p, 1)) Or Mid(Html, p, 1) = "." Or Mid(Html, p, 1) = ",") And p < Len(Html)
Ris = Ris & Mid(Html, p, 1)
p = p + 1
Loop
End If
if Ris<>"" then
QuotazioneOro2 = CDbl(Replace(Ris, ".", ","))
else
QuotazioneOro2 = 0
end if
End Function
Private Function QuotazioneOro3()
Dim Html
Dim objXMLHTTP, xml, text
Set xml = CreateObject("Microsoft.XMLHTTP")
'Or if this doesn't work then try :
'Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.Open "GET", "http://www.kitco.com/pop_windows/exchdetails.html", False
xml.send
Html = xml.responseText
Set xml = Nothing
'Trova la scritta euro
p = InStr(1, Html, "Euro")
If p > 0 Then
'Va avanti fino alla colonna dell'euro
For r = 1 To 7
p = InStr(p, Html, " """>" And p < Len(Html)
' p = p + 1
' Loop
Do While Not IsNumeric(Mid(Html, p, 1)) And p < Len(Html)
p = p + 1
Loop
Do While (IsNumeric(Mid(Html, p, 1)) Or Mid(Html, p, 1) = "." Or Mid(Html, p, 1) = ",") And p < Len(Html)
Ris = Ris & Mid(Html, p, 1)
p = p + 1
Loop
End If
if Ris<>"" then
QuotazioneOro3 = CDbl(Replace(Ris, ".", ","))
else
QuotazioneOro3 = 0
end if
End Function
%>
<%=FormatNumber(ValoreOro24)%>
18kt E. 26,79 |
|
|
