<% Option Explicit Response.Buffer = True Dim CCC, RGC, DSC, RLC, recspp, view, sort, pagenum, id Dim thispage, FormName, ULX ThisPage = Request.ServerVariables("SCRIPT_NAME") SetNames Thispage, FormName ULX = GetSn("ULX") 'Response.write "100 GBP = " & GetRate("GBP", "EUR", 100) & "EUR
" %> Exchange rate rurrency converter <%=MenuHome(12)%> <%=MenuOffice(-1)%>
Tenerife apartment rentals logo

Currency convertor

Please wait - getting live rates...





<% Sub OldInfo '************************************** ' Name: Dynamic Currency Convertor ' Assumes:1. Save as ASP file eg test.asp & run it, It has been hard coded to convert $100 US dollars to Australian dollars ' Side Effects:If Yahoo change their interface then this may not work. 'AUTHOR : DENIS HOGAN ' 22 April 2004 ' I am not happy with the code BUT it works ' Limitations : If yahoo change their interface I/we are screwed 'No error trapping. ' Purpose : Dynamically converts currenc ' SOME COUNTRY CODES 'AUD = Australia 'CNY = Chinese Yuan 'FJD = Fiji Dollar 'GBP = British Pound 'USD = United States 'HKD = Hong Kong Dollar 'SGD = Singapore 'IDR = Indonesian Rupiah 'INR = Indian Rupee 'JPY = Japanese Yen 'MYR = Malaysian Ringgit 'MXN = Mexican Peso 'NZD = New Zealand Dollar 'SAR = Saudi Arabian Riyal 'THB = Thai Baht 'VND = Vietnam Dong 'ZAR = South African Rand ' SYNTAX ' http://quote.yahoo.com/m5?a=( VALUE TO CONVERT )&s= ( CONVERT FROM )&t= ( CONVERT TO ) ' EXAMPLE 1 - converts 100 US to Australian dollars, get the codes from the table above ' There are a whole lot of codes that can be added ' OPTIONS: store codes above in table & pass value & codes as PARAMETERS to this code below & ' You will have a dynamic cureency convertor. ' HTTPGet("http://quote.yahoo.com/m5?a=100.00&s=USD&t=AUD") ' SAMPLE PARAMETERS YOU COULD USE '================================== ' currencyToConvert = request.querystring("currencyToConvert") ' any vaoue eg 100.56 or 1500.34 etc ' ConvertFROM = request.querystring("ConvertFROM") ' any of the country code above, MUST be uppercase ' ConvertTO = request.querystring("ConvertTO") ' any of the country code above, MUST be uppercase MyPos=0 sbURL = HTTPGet("http://quote.yahoo.com/m5?a=100&s=GBP&t=EUR") ' I noticed that the last occurence of In the code of the Yahoo site ' has the figures, if they move it Then we are screwed. ' -------------------------------------------------------------------- MyPos = InstrRev(SbURL, "", -1, 1) ' Find the 1st occurence position of < in the coverted Currency totdigits = Instr(mid(SbURL,MyPos+7,20),"<") ' response.write totdigits & " totdigits
" ' Display the conversion ' This value can be used To pass to a database, to a user/client or bank ie secure payment response.write mid(SbURL,MyPos+7,totdigits-1) & " <= Value generated by my program
"' & " <= CHECK IT
" response.write "
" ' UNCOMMENT THIS To VIEW DISPLAY THE Position of the coverted Currency 'for x = 1 To 30 ' response.write x & " - " & mid(SbURL,MyPos+7,x) & "
" 'next ' UNCOMMENT THIS To VIEW THE URL & CHECK THE CONVERSION ' -------------------------------------------------------- ' response.write SbURL ' UNCOMMENT THIS To VIEW DISPLAY TO CHECK SOURCE ' ------------------------------------------------------------------- %> <% End Sub Function GetRate(FCDE, TCDE, FAMT) Dim myPos, SbUrl, objHTTP, totdigits, strURL If FCDE = "" Then FCDE = "GBP" If FAMT = "" Then FAMT = 1 If TCDE = "" Then TCDE = "EUR" MyPos=0 strURL = "http://quote.yahoo.com/m5?a=100&s=GBP&t=EUR" Set objHTTP=Server.CreateObject("Microsoft.XMLHTTP") objHTTP.Open "GET", strURL, False objHTTP.Send sbURL = objHTTP.ResponseText Set objHTTP = Nothing MyPos = InstrRev(SbURL, "", -1, 1) totdigits = Instr(mid(SbURL,MyPos+7,20),"<") GetRate = mid(SbURL, MyPos + 7, totdigits - 1) End Function %>