<% '*********************************************************************** ' VP-ASP 6.0 ' Nov 12, 2005 ' Dec 31, 2005 Changed field names to lower case '********************************************************************* Function ShopFormatCurrency (amount, decimalpoint) ' Handle 0 and garbage prices dim tamount tamount=amount if GetSess("Fullunitname")<>"" then tamount=Currencypriceconvert(tamount) end if If not isnumeric(tamount) then tamount=0 end if if tamount=0 then if getconfig("xprice0")<>"" then shopformatcurrency=Getconfig("xprice0") exit function end if end if if GetSess("Newcurrencysymbol")<>"" then shopformatcurrency=GetSess("Newcurrencysymbol") & formatNumber (tamount, decimalpoint) elseif getconfig("XCurrencySymbol") <> "" then shopformatcurrency=getconfig("XCurrencySymbol") & formatNumber (tamount, decimalpoint) else shopformatcurrency="$" & formatNumber (tamount, decimalpoint) end if end function '============================================= 'VP-ASP 600 formats dual currency '12/10/2005 '============================================= Function ShopFormatDualCurrency (amount, decimalpoint) If getconfig("xdualcurrencysymbol")<>"" then shopformatdualcurrency=getconfig("xdualcurrencysymbol") & formatNumber (amount, decimalpoint) else shopformatdualcurrency=formatCurrency (amount, decimalpoint) end if end function '============================================= Sub RestoreCurrency on error resume next dim restored dim PricesIncVAT restored=getsess("Restored") if restored<>"" then exit sub 'Restore currency information 'If GetConfig("xMultiCurrency") = "Yes" Then If Request.Cookies("Currency") <> "" Then 'Response.write "CID value" & Request.Cookies("Currency")("CID") & "
" Call SetCurrency(Request.Cookies("Currency")("CID"),Request.Cookies("Currency")("IncVAT")) Else If GetConfig("xtaxincludedinprice") = "Yes" Then PricesIncVAT=True Else PricesIncVAT=False End If Call SetCurrency(GetConfig("xcurrencybase"),PricesIncVAT) End If 'End If SetSess "restored","Yes" End Sub 'So if a cookie is found we take the id and if the users want VAT or not otherwise we get two config values, first is the standard xtaxincludedinprice to decide if we should add VAT and the other is a new one, XDefaultCurrency, a config value to use when no setting is found. 'Setting the currency is done by a function SetCurrency which I put in Shop$DB very straight forward, you can see it appears in both routines above. Sub SetCurrency(ByVal CurrencyID, ByVal VAT) Dim CurrName, CurrRate, CurrSymbol, DefaultVAT 'Get the currency data Call GetCurrData(CurrencyID, CurrName, CurrRate, CurrSymbol) 'If no rows are returned, get the xDefaultCurrency data If CurrName = "" Then Call GetCurrData(GetConfig("xcurrencybase"), CurrName, CurrRate, CurrSymbol) 'Set up the Session Variables SetSess "CID", CurrencyID SetSess "Fullunitname", CurrName SetSess "Conversionvalue", CurrRate SetSess "Newcurrencysymbol", CurrSymbol SetSess "IncVAT", CBool(VAT) 'Write a Cookie with the Currency ID & VAT Status. Response.cookies("Currency")("CID")=CurrencyID Response.cookies("Currency")("IncVAT")= VAT Response.Cookies("Currency").Expires = Date + 10 End Sub 'One last sub, GetCurrData which just pulls the currency from a new currency table. Sub GetCurrData(CurrID, CurrName, CurrRate, CurrSymbol) if CurrID="" then exit sub dim sql,rs, dbc ShopOpendatabase dbc sql="select * from currencyvalues where cid = '" & currid & "'" 'Response.write sql set rs=dbc.execute(sql) if not rs.eof then currname=rs("fullunitname") currrate=rs("conversionvalue") currsymbol=rs("currencysymbol") end if closerecordset rs Shopclosedatabase dbc End Sub Function Currencypriceconvert(price) 'VP-ASP 6.09 - fix if there is no conversion value, then don't modify the price if GetSess("Conversionvalue") = "" OR isnull(GetSess("Conversionvalue")) then Currencypriceconvert = price else Currencypriceconvert=price*GetSess("Conversionvalue") end if End Function Sub navigateshowcurrency if GetSess("Fullunitname")<>"" then Response.write "Chosen Currency
" Response.write "" & GetSess("Fullunitname") & "" end if response.write "Change Currency" end sub Sub Navigateshowcurrencies setsess "returnurl", request.ServerVariables("scriptname") setsess "returnurl", right(getsess("returnurl"), instrrev(getsess("returnurl"), "/")) dim dbc, rs, sql, cid, checked shopopendatabase dbc %>

<% sql="select * from currencyvalues where hide = 0 order by fullunitname" set rs=dbc.execute(sql) Do While Not rs.EOF cid=rs("cid") if cid=getsess("cid") then checked=" selected=""selected""" else checked="" end if 'VP-ASP 6.50 - added call to redirect to shopcurrency.asp Response.write "" & rs("fullunitname")& "" & vbcrlf rs.MoveNext Loop response.write "

" Closerecordset rs shopclosedatabase dbc end sub '*************************************************************** ' Used when return a currency with currrebcy symbol ' hk '*************************************************************** Function ShopFormatCurrencyNumber (amount, decimalpoint) ' Handle 0 and garbage prices dim tamount tamount=amount if GetSess("Fullunitname")<>"" then tamount=Currencypriceconvert(tamount) end if If not isnumeric(tamount) then tamount=0 end if if tamount=0 then if getconfig("xprice0")<>"" then shopformatcurrency=Getconfig("xprice0") exit function end if end if shopformatcurrencynumber=formatNumber (tamount, decimalpoint) end function %>