Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for yfxclass.vbs

(view source code of yfxclass.vbs as plain text)

  1. Option Explicit
  2.  
  3. Dim objYFX
  4.  
  5. Set objYFX = New YFX
  6.  
  7. ' Show class information
  8. WScript.Echo "Class ""YahooFX"", Version " & objYFX.Version
  9. WScript.Echo objYFX.CopyRight & vbCrLf
  10. WScript.Echo objYFX.Disclaimer
  11.  
  12. ' Show exchange rate from British pounds to Canadian dollars
  13. objYFX.CurrFromISO = "GBP"
  14. objYFX.CurrToISO   = "CAD"
  15. WScript.Echo objYFX.CurrFromISO & " = " & objYFX.CurrFromName
  16. WScript.Echo objYFX.CurrToISO   & " = " & objYFX.CurrToName
  17. objYFX.Query
  18. WScript.Echo "Exchange rate from " & objYFX.CurrFromName & " to " & objYFX.CurrToName & " currently is at " & objYFX.ExchangeRate
  19. WScript.Echo "So " & objYFX.CurrFromISO & " 1000 would be equivalent to " & objYFX.CurrToISO & " " & FormatNumber( objYFX.ExchangeRate * 1000, 2 )
  20. WScript.Echo vbCrLf & Join( objYFX.StatusLog, vbCrLf ) & vbCrLf
  21.  
  22. ' Show exchange rate from British pounds to US dollars
  23. objYFX.CurrToISO = "USD"
  24. WScript.Echo objYFX.CurrFromISO & " = " & objYFX.CurrFromName
  25. WScript.Echo objYFX.CurrToISO   & " = " & objYFX.CurrToName
  26. objYFX.Query
  27. WScript.Echo "Exchange rate from " & objYFX.CurrFromName & " to " & objYFX.CurrToName & " currently is at " & objYFX.ExchangeRate
  28. WScript.Echo "So " & objYFX.CurrFromISO & " 1000 would be equivalent to " & objYFX.CurrToISO & " " & FormatNumber( objYFX.ExchangeRate * 1000, 2 )
  29. WScript.Echo vbCrLf & Join( objYFX.StatusLog, vbCrLf ) & vbCrLf
  30.  
  31. ' Clear the (cumulative) log
  32. objYFX.ClearLog
  33.  
  34. ' Show exchange rate from Canadian dollars to US dollars
  35. objYFX.CurrFromISO = "CAD"
  36. WScript.Echo objYFX.CurrFromISO & " = " & objYFX.CurrFromName
  37. WScript.Echo objYFX.CurrToISO   & " = " & objYFX.CurrToName
  38. objYFX.Query
  39. WScript.Echo "Exchange rate from " & objYFX.CurrFromName & " to " & objYFX.CurrToName & " currently is at " & objYFX.ExchangeRate
  40. WScript.Echo "So " & objYFX.CurrFromISO & " 1000 would be equivalent to " & objYFX.CurrToISO & " " & FormatNumber( objYFX.ExchangeRate * 1000, 2 )
  41. WScript.Echo vbCrLf & Join( objYFX.StatusLog, vbCrLf ) & vbCrLf
  42.  
  43. Set objYFX = Nothing
  44.  
  45. Class YFX
  46. ' This class retrieves the exchange rate for any
  47. ' two currencies from http://finance.yahoo.com
  48. '
  49. ' Properties:
  50. ' CurrFromISO  R/W [string]    ISO 4217 currency code to convert from **
  51. ' CurrFromName R   [date]      Descriptive name of currency to convert from
  52. ' CurrToISO    R/W [date]      ISO 4217 currency code to convert to **
  53. ' CurrToName   R   [date]      Descriptive name of currency to convert to
  54. ' Disclaimer   R   [string]    Disclaimer text
  55. ' ExchangeRate R   [double]    Last known exchange rate retrieved from Yahoo
  56. ' Status       R   [integer]   Connection status number
  57. ' StatusLog    R   [array str] History of status/error messages
  58. ' StatusMsg    R   [string]    Last/current status/error messages
  59. ' Version      R   [string]    This class' version number
  60. '
  61. ' Methods:
  62. ' ClearLog         clears the status log array
  63. ' Query            start the query for the exchange reate
  64. '
  65. ' ** Look up currency codes at http://www.currencysystem.com/codes/
  66. '
  67. ' Disclaimer:
  68. ' This class uses http://finance.yahoo.com to retrieve exchange rates,
  69. ' and http://www.currencysystem.com/codes/ to "translate" currency codes.
  70. ' This class will break when either Yahoo or CurrencySystem change their
  71. ' web page layout or content.
  72. ' The author of this class cannot be held responsible for any damage, direct
  73. ' nor consequential, caused by the use of or inability to use this class.
  74. ' Do not make any financial decisions based on the output of this class.
  75. ' Always use a "second source" before making any decision.
  76. ' Use this class entirely at your own risk.
  77. '
  78. ' Change log:
  79. ' July 3, 2007     First public release
  80. '
  81. ' Written by Rob van der Woude
  82. ' http://www.robvanderwoude.com
  83.  
  84. 	' Declare all our private, or local, variables
  85. 	Private colMatches, intLastSubMatch, objRE
  86. 	Private strConversion, strCurrencies, strDecimal, strResponse, strURL, strUserAgent
  87. 	Private m_CopyRight, m_CurrFromISO, m_CurrFromName, m_CurrToISO, m_CurrToName
  88. 	Private m_Disclaimer, m_ExchangeRate, m_Status, m_StatusLog, m_StatusMsg, m_Version
  89.  
  90. 	' Initialize the variables when the class is initialized
  91. 	Private Sub Class_Initialize
  92. 		Dim objHTTP
  93. 		m_CopyRight    = "Copyright (C) 2007, Rob van der Woude, http://www.robvanderwoude.com"
  94. 		m_CurrFromISO  = ""
  95. 		m_CurrFromName = ""
  96. 		m_CurrToISO    = ""
  97. 		m_CurrToName   = ""
  98. 		m_Disclaimer   = "This class uses http://finance.yahoo.com to retrieve exchange rates," & vbCrLf _
  99. 		               & "and http://www.currencysystem.com/codes/ to ""translate"" currency codes." & vbCrLf _
  100. 		               & "This class will break when either Yahoo or CurrencySystem change their" & vbCrLf _
  101. 		               & "web page layout or content." & vbCrLf _
  102. 		               & "The author of this class cannot be held responsible for any damage, direct" & vbCrLf _
  103. 		               & "nor consequential, caused by the use of or inability to use this class." & vbCrLf _
  104. 		               & "Do not make any financial decisions based on the output of this class." & vbCrLf _
  105. 		               & "Always use a ""second source"" before making any decision." & vbCrLf _
  106. 		               & "Use this class entirely at your own risk." & vbCrLf
  107. 		m_ExchangeRate = 0
  108. 		m_Status       = 0
  109. 		m_StatusMsg    = "Class initialized"
  110. 		m_StatusLog    = Array( FormatDateTime( Date( ), vbShortDate ) _
  111. 		                      & ", " _
  112. 		                      & FormatDateTime( Time( ), vbLongTime ) _
  113. 		                      & ": " & m_StatusMsg & "." )
  114. 		m_Version      = "1.00"
  115. 		' Get the locally used decimal delimiter
  116. 		strDecimal   = Replace( FormatNumber( 0, 1, True ), "0", "" )
  117. 		strUserAgent = "Mozilla/4.0 (compatible; MSIE 6.0; Windows 98)"
  118. 		' Retrieve currency code from currencysystem.com
  119. 		Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
  120. 		strURL = "http://www.currencysystem.com/codes/"
  121. 		objHTTP.Open "GET", strURL, False
  122. 		objHTTP.SetRequestHeader "UserAgent", strUserAgent
  123. 		objHTTP.Send
  124. 		strCurrencies = objHTTP.ResponseText
  125. 		m_Status      = objHTTP.Status
  126. 		m_StatusMsg   = "CurrencySystem.com currency codes: " _
  127. 		              & objHTTP.Status & " = " & objHTTP.StatusText
  128. 		Add2Log m_StatusMsg
  129. 		Set objHTTP = Nothing
  130. 	End Sub
  131.  
  132. 	Public Property Get CopyRight
  133. 		CopyRight = m_CopyRight
  134. 	End Property
  135.  
  136. 	Public Property Get CurrFromISO
  137. 		CurrFromISO = m_CurrFromISO
  138. 	End Property
  139.  
  140. 	Public Property Let CurrFromISO( myCurrFrom )
  141. 		Set objRE        = New RegExp
  142. 		objRE.Global     = False
  143. 		objRE.IgnoreCase = True
  144. 		objRE.Pattern    = "[A-Z]{3}"
  145. 		Set colMatches   = objRE.Execute( myCurrFrom )
  146. 		m_StatusMsg      = myCurrFrom & " check: " & colMatches.Count & " match(es)"
  147. 		Add2Log m_StatusMsg
  148. 		If colMatches.Count = 1 Then
  149. 			m_Status       = 0
  150. 			m_CurrFromISO  = UCase( myCurrFrom )
  151. 			' Extract the exchange rate from the CurrencySystem.com
  152. 			' web page stored in memory; in case of error, return 0
  153. 			Set objRE        = New RegExp
  154. 			objRE.Global     = False
  155. 			objRE.IgnoreCase = False
  156. 			objRE.Pattern    = "<tr><td[^>]*>([^<]*)</td><td[^>]*>" & UCase( myCurrFrom ) & "</td></tr>"
  157. 			Set colMatches   = objRE.Execute( strCurrencies )
  158. 			If colMatches.Count = 1 Then
  159. 				m_CurrFromName = colMatches.Item(0).Submatches(0)
  160. 			Else
  161. 				m_CurrFromName = ""
  162. 			End If
  163. 			Set colMatches = Nothing
  164. 			Set objRE      = Nothing
  165. 		Else
  166. 			m_Status    = 100
  167. 			m_StatusMsg = "Invalid currency code for " _
  168. 			            & """FROM"" currency: " & myCurrFrom
  169. 			Add2Log m_StatusMsg
  170. 		End If
  171. 		Set colMatches = Nothing
  172. 		Set objRE      = Nothing
  173. 	End Property
  174.  
  175. 	Public Property Get CurrFromName
  176. 		CurrFromName = m_CurrFromName
  177. 	End Property
  178.  
  179. 	Public Property Get CurrToISO
  180. 		CurrToISO = m_CurrToISO
  181. 	End Property
  182.  
  183. 	Public Property Let CurrToISO( myCurrTo )
  184. 		Set objRE        = New RegExp
  185. 		objRE.Global     = False
  186. 		objRE.IgnoreCase = True
  187. 		objRE.Pattern    = "[A-Z]{3}"
  188. 		Set colMatches   = objRE.Execute( myCurrTo )
  189. 		m_StatusMsg      = myCurrTo & " check: " & colMatches.Count & " match(es)"
  190. 		Add2Log m_StatusMsg
  191. 		If colMatches.Count = 1 Then
  192. 			m_Status     = 0
  193. 			m_CurrToISO  = UCase( myCurrTo )
  194. 			' Extract and return the exchange rate from the
  195. 			' the web page; in case of error return 0
  196. 			Set objRE        = New RegExp
  197. 			objRE.Global     = False
  198. 			objRE.IgnoreCase = False
  199. 			objRE.Pattern    = "<tr><td[^>]*>([^<]*)</td><td[^>]*>" & UCase( myCurrTo ) & "</td></tr>"
  200. 			Set colMatches   = objRE.Execute( strCurrencies )
  201. 			If colMatches.Count = 1 Then
  202. 				m_CurrToName = colMatches.Item(0).Submatches(0)
  203. 			Else
  204. 				m_CurrToName = ""
  205. 			End If
  206. 			Set colMatches = Nothing
  207. 			Set objRE      = Nothing
  208. 		Else
  209. 			m_Status    = 100
  210. 			m_StatusMsg = "Invalid currency code for " _
  211. 			            & """TO"" currency: " & myCurrTo
  212. 			Add2Log m_StatusMsg
  213. 		End If
  214. 		Set colMatches = Nothing
  215. 		Set objRE      = Nothing
  216. 	End Property
  217.  
  218. 	Public Property Get CurrToName
  219. 		CurrToName = m_CurrToName
  220. 	End Property
  221.  
  222. 	Public Property Get ExchangeRate
  223. 		ExchangeRate = m_ExchangeRate
  224. 	End Property
  225.  
  226. 	Public Property Get Disclaimer
  227. 		Disclaimer = m_Disclaimer
  228. 	End Property
  229.  
  230. 	Public Property Get Status
  231. 		Status = m_Status
  232. 	End Property
  233.  
  234. 	Public Property Get StatusLog
  235. 		StatusLog = m_StatusLog
  236. 	End Property
  237.  
  238. 	Public Property Get StatusMsg
  239. 		StatusMsg = m_StatusMsg
  240. 	End Property
  241.  
  242. 	Public Property Get Version
  243. 		Version = m_Version
  244. 	End Property
  245.  
  246. 	Public Sub ClearLog
  247. 		m_StatusMsg    = "Log cleared"
  248. 		m_StatusLog    = Array( FormatDateTime( Date( ), vbShortDate ) _
  249. 		                      & ", " _
  250. 		                      & FormatDateTime( Time( ), vbLongTime ) _
  251. 		                      & ": " & m_StatusMsg & "." )
  252. 	End Sub
  253.  
  254. 	Public Function Query
  255. 		Dim objHTTP
  256. 		' Retrieve Yahoo's web page containing our currencies' exchange rate
  257. 		Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
  258. 		strURL = "http://finance.yahoo.com/q?s=" _
  259. 		       & UCase( m_CurrFromISO & m_CurrToISO ) & "=X"
  260. 		objHTTP.Open "GET", strURL, False
  261. 		objHTTP.SetRequestHeader "UserAgent", strUserAgent
  262. 		objHTTP.Send
  263. 		strResponse = objHTTP.ResponseText
  264. 		m_Status    = objHTTP.Status
  265. 		m_StatusMsg = "Yahoo Finance Currency Converter: " _
  266. 		            & objHTTP.Status & " = " & objHTTP.StatusText
  267. 		Add2Log m_StatusMsg
  268. 		Set objHTTP = Nothing
  269.  
  270. 		' Extract and return the exchange rate from
  271. 		' the web page; in case of error return 0
  272. 		Set objRE        = New RegExp
  273. 		objRE.Global     = False
  274. 		objRE.IgnoreCase = True
  275. 		objRE.Pattern    = ">Last Trade:(<[^>]+>)+([.0-9]+)<[^>]+>"
  276. 		Set colMatches   = objRE.Execute( strResponse )
  277. 		m_StatusMsg      = "Exchange rate search: " & colMatches.Count & " match(es)"
  278. 		Add2Log m_StatusMsg
  279. 		If colMatches.Count = 1 Then
  280. 			intLastSubMatch = colMatches.Item(0).Submatches.Count - 1
  281. 			strConversion   = colMatches.Item(0).Submatches( intLastSubMatch )
  282. 			If IsNumeric( strConversion ) Then
  283. 				' Convert the match from string to number,
  284. 				' using the local decimal delimiter
  285. 				m_Status    = 0
  286. 				m_StatusMsg = "Exchange rate found: " & strConversion
  287. 				Add2Log m_StatusMsg
  288. 				strConversion  = CDbl( Replace( strConversion, ".", strDecimal ) )
  289. 				m_ExchangeRate = strConversion
  290. 			Else
  291. 				m_Status    = 100
  292. 				m_StatusMsg = "No numeric exchange rate found: " & strConversion
  293. 				Add2Log m_StatusMsg
  294. 				m_ExchangeRate = 0
  295. 			End If
  296. 		Else
  297. 			m_Status    = 100
  298. 			m_StatusMsg = "No exchange rate found"
  299. 			Add2Log m_StatusMsg
  300. 			m_ExchangeRate = 0
  301. 		End If
  302. 		Set colMatches = Nothing
  303. 		Set objRE      = Nothing
  304. 		m_Status    = 0
  305. 		m_StatusMsg = "Ready"
  306. 		Add2Log m_StatusMsg
  307. 	End Function
  308.  
  309. 	Private Sub Add2Log( myLine )
  310. 		ReDim Preserve m_StatusLog( UBound( m_StatusLog ) + 1 )
  311. 		m_StatusLog( UBound( m_StatusLog ) ) = FormatDateTime( Date( ), vbShortDate ) _
  312. 		                                     & ", " _
  313. 		                                     & FormatDateTime( Time( ), vbLongTime ) _
  314. 		                                     & ": " & myLine & "."
  315. 	End Sub
  316. End Class
  317.  

page last uploaded: 2017-08-21, 14:26