(view source code of yahoofx.vbs as plain text)
Option ExplicitDim dblAmount, dblConvert, dblExch, intArgs, strFromCurr, strToCurr' Initial valuesdblAmount = 0
intArgs = 0
' Check command line argumentsIf WScript.Arguments.Count <> 3 Then Syntax ""
If WScript.Arguments.Named.Exists( "Amount" ) Then
dblAmount = WScript.Arguments.Named( "Amount" )
intArgs = intArgs + 1
End If
If WScript.Arguments.Named.Exists( "A" ) Then
dblAmount = WScript.Arguments.Named( "A" )
intArgs = intArgs + 1
End If
If WScript.Arguments.Named.Exists( "From" ) Then
strFromCurr = WScript.Arguments.Named( "From" )
intArgs = intArgs + 1
End If
If WScript.Arguments.Named.Exists( "F" ) Then
strFromCurr = WScript.Arguments.Named( "F" )
intArgs = intArgs + 1
End If
If WScript.Arguments.Named.Exists( "To" ) Then
strToCurr = WScript.Arguments.Named( "To" )
intArgs = intArgs + 1
End If
If WScript.Arguments.Named.Exists( "T" ) Then
strToCurr = WScript.Arguments.Named( "T" )
intArgs = intArgs + 1
End If
If dblAmount = 0 And WScript.Arguments.Unnamed.Count = 1 Then
dblAmount = WScript.Arguments.Unnamed(0)
intArgs = intArgs + 1
End If
If intArgs <> 3 Then Syntax ""
' Validate command line argumentsIf Not IsNumeric( dblAmount ) Then
Syntax dblAmount & " is not a valid amount"
End If
If dblAmount <= 0 Then
Syntax "Amount must be greater than 0"End If
If Len( strFromCurr ) <> 3 Then
Syntax strFromCurr & " is not a valid ISO 4217 currency abbreviation." & vbCrLf _
& "Look up valid currency codes at http://www.oanda.com/site/help/iso_code.shtml"
End If
If Len( strToCurr ) <> 3 Then
Syntax strToCurr & " is not a valid ISO 4217 currency abbreviation." & vbCrLf _
& "Look up valid currency codes at http://www.oanda.com/site/help/iso_code.shtml"
End If
' Retrieve the exchange rate for these currenciesdblConvert = YahooTrade( strFromCurr, strToCurr )
If dblConvert = 0 Then
Syntax "Error retrieving exchange rate"Else ' Format the screen outputdblExch = FormatNumber( dblConvert * dblAmount, 2, True, False, False )
WScript.Echo strFromCurr & " " & dblAmount & " = " & strToCurr & " " & dblExch
End If
Sub Syntax( errMsg )
Dim StdIn, strMsgIf errMsg <> "" Then WScript.Echo "Error: " & errMsg
strMsg = "YahooFX.vbs, Version 1.00" & vbCrLf _
& "Calculate exchange rates" & vbCrLf & vbCrLf _
& "Usage: YAHOOFX.VBS [/Amount:]amount /From:icc /To:icc" _
& vbCrLf & vbCrLf _
& "Where: /A:amount The amount that has to be converted" _
& vbCrLf _& " /F:icc ISO 4217 currency code for amount" _
& vbCrLf _& " /T:icc ISO 4217 currency code to convert to" _
& vbCrLf & vbCrLf _
& "Notes: [1] Switches may be abbreviated, " _
& "e.g. /A and /AMOUNT are identical" & vbCrLf _
& " [2] Look up valid ISO 4217 currency codes at" _
& vbCrLf _& " http://www.oanda.com/site/help/iso_code.shtml" _
& vbCrLf _& " [3] This script uses Yahoo's currency pages " _
& "(http://finance.yahoo.com)" & vbCrLf _
& " to retrieve the current exchange rate " _
& "for our two currencies, so" & vbCrLf _
& " this script will be broken as soon as " _
& "Yahoo changes these pages." & vbCrLf _
& " [4] The author of this script cannot " _
& "be held responsible for any" & vbCrLf _
& " damage, direct nor consequential, " _
& "caused by the use of or" & vbCrLf _
& " inability to use this script. " _
& "Do not make any financial decisions" & vbCrLf _
& " based on the output of this script. " _
& "Always consult a ""second" & vbCrLf _
& " source"" before making any decision." _
& vbCrLf _& " Use this script entirely at your own risk." _
& vbCrLf & vbCrLf _
& "Examples:" & vbCrLf _
& " Convert 2000 US Dollars to Euros:" & vbCrLf _
& " YAHOOFX.VBS /AMOUNT:2000 /FROM:USD /TO:EUR" & vbCrLf _
& " Convert 1120 Danish Krones to Indian Rupees:" & vbCrLf _
& " YAHOOFX.VBS 1120 /F:DKK /T:INR" & vbCrLf & vbCrLf _
& "Written by Rob van der Woude" & vbCrLf _
& "http://www.robvanderwoude.com"
WScript.Echo strMsg
WScript.Quit 1
End Sub
Function YahooTrade( myFromCurr, myToCurr )
' This function retrieves the exchange rate' for any two currencies from finance.yahoo.com'' Arguments:' myFromCurr [string] ISO 4217 3 letter code for the currency to convert from' myToCurr [string] ISO 4217 3 letter code for the currency to convert to'' Look up currency codes at http://www.oanda.com/site/help/iso_code.shtml'' Returns:' Conversion rate as number'' Disclaimer:' This script uses http://finance.yahoo.com to retrieve exchange rates.' This script will break when Yahoo changes its web page layout or content.' The author of this script cannot be held responsible for any damage, direct' nor consequential, caused by the use of or inability to use this script.' Do not make any financial decisions based on the output of this script.' Always use a "second source" before making any decision.' Use this script entirely at your own risk.'' Written by Rob van der Woude' http://www.robvanderwoude.com Dim colMatches, intLastSubMatch, objHTTP, objRE, strConversion Dim strDecimal, strMyAmount, strResponse, strURL, strUserAgent ' Get the locally used decimal delimiterstrDecimal = Replace( FormatNumber( 0, 1, True ), "0", "" )
' Retrieve Yahoo's web page containing the our currencies' exchange rateSet objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
strURL = "http://finance.yahoo.com/q?s=" _
& UCase( myFromCurr & myToCurr ) & "=X"
objHTTP.Open "GET", strURL, False
strUserAgent = "Mozilla/4.0 (compatible; MSIE 6.0; Windows 98)"
objHTTP.SetRequestHeader "UserAgent", strUserAgent
objHTTP.Send
strResponse = objHTTP.ResponseText
Set objHTTP = Nothing
' Extract and return the exchange rate from ' the web page; in case of error return 0Set objRE = New RegExp
objRE.Global = False
objRE.IgnoreCase = True
objRE.Pattern = ">Last Trade:(<[^>]+>)+([.0-9]+)<[^>]+>"
Set colMatches = objRE.Execute( strResponse )
If colMatches.Count = 1 Then
intLastSubMatch = colMatches.Item(0).Submatches.Count - 1
strConversion = colMatches.Item(0).Submatches( intLastSubMatch )
If IsNumeric( strConversion ) Then
' Convert the match from string to number, ' using the local decimal delimiterstrConversion = CDbl( Replace( strConversion, ".", strDecimal ) )
YahooTrade = strConversion ElseYahooTrade = 0
End If
ElseYahooTrade = 0
End If
Set colMatches = Nothing
Set objRE = Nothing
End Function
page last modified: 2025-10-11; loaded in 0.0166 seconds