Source code for yfxclass.vbs

```
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
```
```
 
```