Option Explicit

Dim objYFX

Set objYFX = New YFX

' Show class information
WScript.Echo "Class ""YahooFX"", Version " & objYFX.Version
WScript.Echo objYFX.CopyRight & vbCrLf
WScript.Echo objYFX.Disclaimer

' Show exchange rate from British pounds to Canadian dollars
objYFX.CurrFromISO = "GBP"
objYFX.CurrToISO   = "CAD"
WScript.Echo objYFX.CurrFromISO & " = " & objYFX.CurrFromName
WScript.Echo objYFX.CurrToISO   & " = " & objYFX.CurrToName
objYFX.Query
WScript.Echo "Exchange rate from " & objYFX.CurrFromName & " to " & objYFX.CurrToName & " currently is at " & objYFX.ExchangeRate
WScript.Echo "So " & objYFX.CurrFromISO & " 1000 would be equivalent to " & objYFX.CurrToISO & " " & FormatNumber( objYFX.ExchangeRate * 1000, 2 )
WScript.Echo vbCrLf & Join( objYFX.StatusLog, vbCrLf ) & vbCrLf

' Show exchange rate from British pounds to US dollars
objYFX.CurrToISO = "USD"
WScript.Echo objYFX.CurrFromISO & " = " & objYFX.CurrFromName
WScript.Echo objYFX.CurrToISO   & " = " & objYFX.CurrToName
objYFX.Query
WScript.Echo "Exchange rate from " & objYFX.CurrFromName & " to " & objYFX.CurrToName & " currently is at " & objYFX.ExchangeRate
WScript.Echo "So " & objYFX.CurrFromISO & " 1000 would be equivalent to " & objYFX.CurrToISO & " " & FormatNumber( objYFX.ExchangeRate * 1000, 2 )
WScript.Echo vbCrLf & Join( objYFX.StatusLog, vbCrLf ) & vbCrLf

' Clear the (cumulative) log
objYFX.ClearLog

' Show exchange rate from Canadian dollars to US dollars
objYFX.CurrFromISO = "CAD"
WScript.Echo objYFX.CurrFromISO & " = " & objYFX.CurrFromName
WScript.Echo objYFX.CurrToISO   & " = " & objYFX.CurrToName
objYFX.Query
WScript.Echo "Exchange rate from " & objYFX.CurrFromName & " to " & objYFX.CurrToName & " currently is at " & objYFX.ExchangeRate
WScript.Echo "So " & objYFX.CurrFromISO & " 1000 would be equivalent to " & objYFX.CurrToISO & " " & FormatNumber( objYFX.ExchangeRate * 1000, 2 )
WScript.Echo vbCrLf & Join( objYFX.StatusLog, vbCrLf ) & vbCrLf

Set objYFX = Nothing

Class YFX
' This class retrieves the exchange rate for any
' two currencies from http://finance.yahoo.com
'
' Properties:
' CurrFromISO  R/W [string]    ISO 4217 currency code to convert from **
' CurrFromName R   [date]      Descriptive name of currency to convert from
' CurrToISO    R/W [date]      ISO 4217 currency code to convert to **
' CurrToName   R   [date]      Descriptive name of currency to convert to
' Disclaimer   R   [string]    Disclaimer text
' ExchangeRate R   [double]    Last known exchange rate retrieved from Yahoo
' Status       R   [integer]   Connection status number
' StatusLog    R   [array str] History of status/error messages
' StatusMsg    R   [string]    Last/current status/error messages
' Version      R   [string]    This class' version number
'
' Methods:
' ClearLog         clears the status log array
' Query            start the query for the exchange reate
'
' ** Look up currency codes at http://www.currencysystem.com/codes/
'
' Disclaimer:
' This class uses http://finance.yahoo.com to retrieve exchange rates,
' and http://www.currencysystem.com/codes/ to "translate" currency codes.
' This class will break when either Yahoo or CurrencySystem change their
' web page layout or content.
' The author of this class cannot be held responsible for any damage, direct
' nor consequential, caused by the use of or inability to use this class.
' Do not make any financial decisions based on the output of this class.
' Always use a "second source" before making any decision.
' Use this class entirely at your own risk.
'
' Change log:
' July 3, 2007     First public release
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com

	' Declare all our private, or local, variables
	Private colMatches, intLastSubMatch, objRE
	Private strConversion, strCurrencies, strDecimal, strResponse, strURL, strUserAgent
	Private m_CopyRight, m_CurrFromISO, m_CurrFromName, m_CurrToISO, m_CurrToName
	Private m_Disclaimer, m_ExchangeRate, m_Status, m_StatusLog, m_StatusMsg, m_Version

	' Initialize the variables when the class is initialized
	Private Sub Class_Initialize
		Dim objHTTP
		m_CopyRight    = "Copyright (C) 2007, Rob van der Woude, http://www.robvanderwoude.com"
		m_CurrFromISO  = ""
		m_CurrFromName = ""
		m_CurrToISO    = ""
		m_CurrToName   = ""
		m_Disclaimer   = "This class uses http://finance.yahoo.com to retrieve exchange rates," & vbCrLf _
		               & "and http://www.currencysystem.com/codes/ to ""translate"" currency codes." & vbCrLf _
		               & "This class will break when either Yahoo or CurrencySystem change their" & vbCrLf _
		               & "web page layout or content." & vbCrLf _
		               & "The author of this class cannot be held responsible for any damage, direct" & vbCrLf _
		               & "nor consequential, caused by the use of or inability to use this class." & vbCrLf _
		               & "Do not make any financial decisions based on the output of this class." & vbCrLf _
		               & "Always use a ""second source"" before making any decision." & vbCrLf _
		               & "Use this class entirely at your own risk." & vbCrLf
		m_ExchangeRate = 0
		m_Status       = 0
		m_StatusMsg    = "Class initialized"
		m_StatusLog    = Array( FormatDateTime( Date( ), vbShortDate ) _
		                      & ", " _
		                      & FormatDateTime( Time( ), vbLongTime ) _
		                      & ": " & m_StatusMsg & "." )
		m_Version      = "1.00"
		' Get the locally used decimal delimiter
		strDecimal   = Replace( FormatNumber( 0, 1, True ), "0", "" )
		strUserAgent = "Mozilla/4.0 (compatible; MSIE 6.0; Windows 98)"
		' Retrieve currency code from currencysystem.com
		Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
		strURL = "http://www.currencysystem.com/codes/"
		objHTTP.Open "GET", strURL, False
		objHTTP.SetRequestHeader "UserAgent", strUserAgent
		objHTTP.Send
		strCurrencies = objHTTP.ResponseText
		m_Status      = objHTTP.Status
		m_StatusMsg   = "CurrencySystem.com currency codes: " _
		              & objHTTP.Status & " = " & objHTTP.StatusText
		Add2Log m_StatusMsg
		Set objHTTP = Nothing
	End Sub

	Public Property Get CopyRight
		CopyRight = m_CopyRight
	End Property

	Public Property Get CurrFromISO
		CurrFromISO = m_CurrFromISO
	End Property

	Public Property Let CurrFromISO( myCurrFrom )
		Set objRE        = New RegExp
		objRE.Global     = False
		objRE.IgnoreCase = True
		objRE.Pattern    = "[A-Z]{3}"
		Set colMatches   = objRE.Execute( myCurrFrom )
		m_StatusMsg      = myCurrFrom & " check: " & colMatches.Count & " match(es)"
		Add2Log m_StatusMsg
		If colMatches.Count = 1 Then
			m_Status       = 0
			m_CurrFromISO  = UCase( myCurrFrom )
			' Extract the exchange rate from the CurrencySystem.com
			' web page stored in memory; in case of error, return 0
			Set objRE        = New RegExp
			objRE.Global     = False
			objRE.IgnoreCase = False
			objRE.Pattern    = "<tr><td[^>]*>([^<]*)</td><td[^>]*>" & UCase( myCurrFrom ) & "</td></tr>"
			Set colMatches   = objRE.Execute( strCurrencies )
			If colMatches.Count = 1 Then
				m_CurrFromName = colMatches.Item(0).Submatches(0)
			Else
				m_CurrFromName = ""
			End If
			Set colMatches = Nothing
			Set objRE      = Nothing
		Else
			m_Status    = 100
			m_StatusMsg = "Invalid currency code for " _
			            & """FROM"" currency: " & myCurrFrom
			Add2Log m_StatusMsg
		End If
		Set colMatches = Nothing
		Set objRE      = Nothing
	End Property

	Public Property Get CurrFromName
		CurrFromName = m_CurrFromName
	End Property

	Public Property Get CurrToISO
		CurrToISO = m_CurrToISO
	End Property

	Public Property Let CurrToISO( myCurrTo )
		Set objRE        = New RegExp
		objRE.Global     = False
		objRE.IgnoreCase = True
		objRE.Pattern    = "[A-Z]{3}"
		Set colMatches   = objRE.Execute( myCurrTo )
		m_StatusMsg      = myCurrTo & " check: " & colMatches.Count & " match(es)"
		Add2Log m_StatusMsg
		If colMatches.Count = 1 Then
			m_Status     = 0
			m_CurrToISO  = UCase( myCurrTo )
			' Extract and return the exchange rate from the
			' the web page; in case of error return 0
			Set objRE        = New RegExp
			objRE.Global     = False
			objRE.IgnoreCase = False
			objRE.Pattern    = "<tr><td[^>]*>([^<]*)</td><td[^>]*>" & UCase( myCurrTo ) & "</td></tr>"
			Set colMatches   = objRE.Execute( strCurrencies )
			If colMatches.Count = 1 Then
				m_CurrToName = colMatches.Item(0).Submatches(0)
			Else
				m_CurrToName = ""
			End If
			Set colMatches = Nothing
			Set objRE      = Nothing
		Else
			m_Status    = 100
			m_StatusMsg = "Invalid currency code for " _
			            & """TO"" currency: " & myCurrTo
			Add2Log m_StatusMsg
		End If
		Set colMatches = Nothing
		Set objRE      = Nothing
	End Property

	Public Property Get CurrToName
		CurrToName = m_CurrToName
	End Property

	Public Property Get ExchangeRate
		ExchangeRate = m_ExchangeRate
	End Property

	Public Property Get Disclaimer
		Disclaimer = m_Disclaimer
	End Property

	Public Property Get Status
		Status = m_Status
	End Property

	Public Property Get StatusLog
		StatusLog = m_StatusLog
	End Property

	Public Property Get StatusMsg
		StatusMsg = m_StatusMsg
	End Property

	Public Property Get Version
		Version = m_Version
	End Property

	Public Sub ClearLog
		m_StatusMsg    = "Log cleared"
		m_StatusLog    = Array( FormatDateTime( Date( ), vbShortDate ) _
		                      & ", " _
		                      & FormatDateTime( Time( ), vbLongTime ) _
		                      & ": " & m_StatusMsg & "." )
	End Sub

	Public Function Query
		Dim objHTTP
		' Retrieve Yahoo's web page containing our currencies' exchange rate
		Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
		strURL = "http://finance.yahoo.com/q?s=" _
		       & UCase( m_CurrFromISO & m_CurrToISO ) & "=X"
		objHTTP.Open "GET", strURL, False
		objHTTP.SetRequestHeader "UserAgent", strUserAgent
		objHTTP.Send
		strResponse = objHTTP.ResponseText
		m_Status    = objHTTP.Status
		m_StatusMsg = "Yahoo Finance Currency Converter: " _
		            & objHTTP.Status & " = " & objHTTP.StatusText
		Add2Log m_StatusMsg
		Set objHTTP = Nothing

		' Extract and return the exchange rate from
		' the web page; in case of error return 0
		Set objRE        = New RegExp
		objRE.Global     = False
		objRE.IgnoreCase = True
		objRE.Pattern    = ">Last Trade:(<[^>]+>)+([.0-9]+)<[^>]+>"
		Set colMatches   = objRE.Execute( strResponse )
		m_StatusMsg      = "Exchange rate search: " & colMatches.Count & " match(es)"
		Add2Log m_StatusMsg
		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 delimiter
				m_Status    = 0
				m_StatusMsg = "Exchange rate found: " & strConversion
				Add2Log m_StatusMsg
				strConversion  = CDbl( Replace( strConversion, ".", strDecimal ) )
				m_ExchangeRate = strConversion
			Else
				m_Status    = 100
				m_StatusMsg = "No numeric exchange rate found: " & strConversion
				Add2Log m_StatusMsg
				m_ExchangeRate = 0
			End If
		Else
			m_Status    = 100
			m_StatusMsg = "No exchange rate found"
			Add2Log m_StatusMsg
			m_ExchangeRate = 0
		End If
		Set colMatches = Nothing
		Set objRE      = Nothing
		m_Status    = 0
		m_StatusMsg = "Ready"
		Add2Log m_StatusMsg
	End Function

	Private Sub Add2Log( myLine )
		ReDim Preserve m_StatusLog( UBound( m_StatusLog ) + 1 )
		m_StatusLog( UBound( m_StatusLog ) ) = FormatDateTime( Date( ), vbShortDate ) _
		                                     & ", " _
		                                     & FormatDateTime( Time( ), vbLongTime ) _
		                                     & ": " & myLine & "."
	End Sub
End Class