Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for rndclass.vbs

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

  1. Option Explicit
  2.  
  3. Dim intRequests
  4.  
  5. intRequests = 10
  6. Test
  7.  
  8. intRequests =  0
  9. Test
  10.  
  11.  
  12. Sub Test( )
  13. 	' This is a demo/test subroutine for the Random class
  14. 	Dim arrTest, clsRandom, i, intTest
  15.  
  16. 	Set clsRandom = New Random
  17. 	clsRandom.LowerLimit  = 1
  18. 	clsRandom.UpperLimit  = 6
  19. 	clsRandom.NumRequests = intRequests
  20. 	clsRandom.Query
  21.  
  22. 	WScript.Echo "Version    : " & clsRandom.Version
  23. 	WScript.Echo "NumRequests: " & intRequests
  24. 	WScript.Echo "Lower Limit: " & clsRandom.LowerLimit
  25. 	WScript.Echo "Upper Limit: " & clsRandom.UpperLimit
  26. 	WScript.Echo "Error      : " & clsRandom.Error & vbCrLf
  27.  
  28. 	intTest = 0
  29. 	arrTest = clsRandom.Result
  30. 	If IsNumeric( arrTest(0) ) Then
  31. 		For i = 0 To clsRandom.NumRequests -1
  32. 			WScript.Echo "Result " & i & "   : " & arrTest(i)
  33. 			intTest = intTest + arrTest(i)
  34. 		Next
  35. 		WScript.Echo "Average    : " & ( intTest / clsRandom.NumRequests )
  36. 	End If
  37. 	WScript.Echo vbCrLf & "Debug Info : " & clsRandom.Debug & vbCrLf
  38.  
  39. 	Set clsRandom = Nothing
  40. End Sub
  41.  
  42.  
  43. Class Random
  44. ' This class uses random.org to retrieve true random integers
  45. '
  46. ' Properties:
  47. ' Busy        R   [boolean]   If TRUE results aren't available yet
  48. ' Debug       R   [string]    Debugging information
  49. ' Error       R   [boolean]   If TRUE check Debug property for description
  50. ' LowerLimit  R/W [integer]   Lower limit of the integer to be returned
  51. ' NumRequests R/W [integer]   Number of integers to be returned (default=1)
  52. ' Result      R   [array int] Resulting random integers
  53. ' UpperLimit  R/W [integer]   Upper limit of the integer to be returned
  54. ' Version     R   [string]    This class' version number
  55. '
  56. ' Methods:
  57. ' Query( )        Start the request for (a) new random integer(s)
  58. ' Init( )         Reset all properties
  59. '
  60. ' Change Log:
  61. ' August 12, 2007               First public release
  62. '
  63. ' Written by Rob van der Woude
  64. ' http://www.robvanderwoude.com
  65.  
  66. 	' Local variables holding the values for for the public properties
  67. 	Private m_LowerLimit, m_UpperLimit, m_NumRequests
  68. 	Private m_Result, m_Busy, m_Debug, m_Error, m_Version
  69. 	' Local variables for the Query subroutine (cannot use Private
  70. 	' inside a subroutine, and using Dim would expose the variables)
  71. 	Private arrResult, i, intStatus, objHTTP, strAgent, strResult, strURL
  72.  
  73.     ' Initialize the variables when the class is initialized
  74. 	Private Sub Class_Initialize
  75. 		m_Debug   = m_Debug & vbCrLf _
  76. 		          & "[" & Now & "] Class initialization started"
  77. 		m_Version = "1.00"
  78. 		Init
  79. 		m_Debug = m_Debug & vbCrLf _
  80. 		        & "[" & Now & "] Class initialization ended normally"
  81. 	End Sub
  82.  
  83.     ' Get the LowerLimit value
  84. 	Public Property Get LowerLimit
  85. 		m_Debug   = m_Debug & vbCrLf _
  86. 		          & "[" & Now & "] LowerLimit value read (" & m_LowerLimit & ")"
  87. 		LowerLimit = m_LowerLimit
  88. 	End Property
  89.  
  90. 	' Set the LowerLimit value
  91. 	Public Property Let LowerLimit( myLimit )
  92. 		m_Debug  = m_Debug & vbCrLf _
  93. 		         & "[" & Now & "] Trying to set LowerLimit value to " _
  94. 		         & myLimit & vbCrLf _
  95. 		         & Space(22) & "Resetting Result value"
  96. 		m_Result = Array( "N/A" )
  97. 		If IsNumeric( myLimit ) Then
  98. 			If CStr( CInt( myLimit ) ) = CStr( myLimit ) Then
  99. 				m_LowerLimit = myLimit
  100. 				m_Debug = m_Debug & vbCrLf _
  101. 				        & "[" & Now & "] LowerLimit value set to " & myLimit
  102. 			Else
  103. 				m_Debug = m_Debug & vbCrLf _
  104. 				        & "[" & Now & "] Specified LowerLimit (" _
  105. 				        & myLimit & ") is not an integer"
  106. 		        m_Error = True
  107. 			End If
  108. 		Else
  109. 			m_Debug = m_Debug & vbCrLf _
  110. 			        & "[" & Now & "] Specified LowerLimit (" _
  111. 			        & myLimit & ") is not a number"
  112. 			m_Error = True
  113. 		End If
  114. 	End Property
  115.  
  116. 	' Get the UpperLimit value
  117. 	Public Property Get UpperLimit
  118. 		m_Debug   = m_Debug & vbCrLf _
  119. 		          & "[" & Now & "] UpperLimit value read (" & m_UpperLimit & ")"
  120. 		UpperLimit = m_UpperLimit
  121. 	End Property
  122.  
  123. 	' Set the UpperLimit value
  124. 	Public Property Let UpperLimit( myLimit )
  125. 		m_Debug  = m_Debug & vbCrLf _
  126. 		         & "[" & Now & "] Trying to set UpperLimit value to " _
  127. 		         & myLimit & vbCrLf _
  128. 		         & Space(22) & "Resetting Result value"
  129. 		m_Result = Array( "N/A" )
  130. 		If IsNumeric( myLimit ) Then
  131. 			If CStr( CInt( myLimit ) ) = CStr( myLimit ) Then
  132. 				m_UpperLimit = myLimit
  133. 				m_Debug = m_Debug & vbCrLf _
  134. 				        & "[" & Now & "] UpperLimit value set to " & myLimit
  135. 			Else
  136. 				m_Debug = m_Debug & vbCrLf _
  137. 				        & "[" & Now & "] Specified UpperLimit (" _
  138. 				        & myLimit & ") is not an integer"
  139. 				m_Error = True
  140. 			End If
  141. 		Else
  142. 			m_Debug = m_Debug & vbCrLf _
  143. 		        & "[" & Now & "] Specified UpperLimit (" _
  144. 		        & myLimit & ") is not a number"
  145. 			m_Error = True
  146. 		End If
  147. 	End Property
  148.  
  149. 	' Get the NumRequests value
  150. 	Public Property Get NumRequests
  151. 		m_Debug     = m_Debug & vbCrLf _
  152. 		            & "[" & Now & "] NumRequests value read (" & m_NumRequests & ")"
  153. 		NumRequests = m_NumRequests
  154. 	End Property
  155.  
  156. 	' Set the NumRequests value
  157. 	Public Property Let NumRequests( myNum )
  158. 		m_Debug  = m_Debug & vbCrLf _
  159. 		         & "[" & Now & "] Trying to set NumRequests value to " _
  160. 		         & myNum & vbCrLf _
  161. 		         & Space(22) & "Resetting Result value"
  162. 		m_Result = Array( "N/A" )
  163. 		If IsNumeric( myNum ) Then
  164. 			If CStr( CInt( myNum ) ) = CStr( myNum ) And myNum > 0 Then
  165. 				m_NumRequests = myNum
  166. 				m_Debug = m_Debug & vbCrLf _
  167. 				        & "[" & Now & "] NumRequests value set to " & myNum
  168. 			Else
  169. 				m_Debug = m_Debug & vbCrLf _
  170. 				        & "[" & Now & "] Specified NumRequests (" _
  171. 				        & myNum & ") is not an integer greater than zero"
  172. 				m_Error = True
  173. 			End If
  174. 		Else
  175. 			m_Debug = m_Debug & vbCrLf _
  176. 		        & "[" & Now & "] Specified NumRequests (" _
  177. 		        & myNum & ") is not a number"
  178. 			m_Error = True
  179. 		End If
  180. 	End Property
  181.  
  182.     ' Get the Busy value
  183. 	Public Property Get Busy
  184. 		m_Debug = m_Debug & vbCrLf _
  185. 		        & "[" & Now & "] Busy value read (" & m_Busy & ")"
  186. 		Busy = m_Busy
  187. 	End Property
  188.  
  189.     ' Get the Debug value
  190. 	Public Property Get Debug
  191. '		m_Debug = m_Debug & vbCrLf _
  192. '		        & "[" & Now & "] Debug value read (" & m_Debug & ")"
  193. 		Debug   = m_Debug
  194. 	End Property
  195.  
  196.     ' Get the Error value
  197. 	Public Property Get Error
  198. 		m_Debug = m_Debug & vbCrLf _
  199. 		        & "[" & Now & "] Error value read (" & m_Error & ")"
  200. 		Error   = m_Error
  201. 	End Property
  202.  
  203.     ' Get the Result value
  204. 	Public Property Get Result
  205. 		m_Debug = m_Debug & vbCrLf _
  206. 		        & "[" & Now & "] Result value read (" & Join( m_Result, " " ) & ")"
  207. 		Result  = m_Result
  208. 	End Property
  209.  
  210.     ' Get the Version value
  211. 	Public Property Get Version
  212. 		m_Debug = m_Debug & vbCrLf _
  213. 		        & "[" & Now & "] Version value read (" & m_Version & ")"
  214. 		Version = m_Version
  215. 	End Property
  216.  
  217. 	' Start the HTTP request to random.org
  218. 	Public Sub Query( )
  219. 		m_Debug  = m_Debug & vbCrLf _
  220. 		         & "[" & Now & "] Query method started" & vbCrLf _
  221. 		         & Space(22) & "Resetting Result value"
  222. 		m_Result = Array( "N/A" )
  223. 		' Check if a valid LowerLimit was specified
  224. 		If Not IsNumeric( m_LowerLimit ) Then
  225. 			m_Debug = m_Debug & vbCrLf _
  226. 			        & "[" & Now & "] LowerLimit value not set (" & m_LowerLimit & ")"
  227. 			m_Error = True
  228. 		End If
  229. 		' Check if a valid UpperLimit was specified
  230. 		If Not IsNumeric( m_UpperLimit ) Then
  231. 			m_Debug = m_Debug & vbCrLf _
  232. 			        & "[" & Now & "] UpperLimit value not set (" & m_UpperLimit & ")"
  233. 			m_Error = True
  234. 		End If
  235. 		' Check for ANY error
  236. 		If m_Error Then
  237. 			m_Debug = m_Debug & vbCrLf _
  238. 			        & "[" & Now & "] An error has occurred (Error=" _
  239. 			        & m_Error & ")" & vbCrLf _
  240. 			        & Space(22) & "Aborting Query method"
  241. 			m_Result      = Array( "N/A" )
  242. 			m_NumRequests = 1
  243. 			Exit Sub
  244. 		End If
  245.  
  246. 		' Format the URL for a HTTP request to random.org
  247. 		strURL   = "http://www.random.org/integers/" _
  248. 		         & "?num=" & m_NumRequests _
  249. 		         & "&min=" & m_LowerLimit  _
  250. 		         & "&max=" & m_UpperLimit  _
  251. 		         & "&col=1&base=10&format=plain&rnd=new"
  252. 		m_Debug  = m_Debug & vbCrLf _
  253. 		         & "[" & Now & "] URL string set to:" & vbCrLf _
  254. 		         & Space(22) & """" & strURL & """"
  255. 		' User agent string (not critical)
  256. 		strAgent = "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
  257. 		m_Debug  = m_Debug & vbCrLf _
  258. 		         & "[" & Now & "] Agent string set to:" & vbCrLf _
  259. 		         & Space(22) & """" & strAgent & """"
  260.  
  261. 		' Prepare the HTTP request to random.org
  262. 		On Error Resume Next
  263. 		Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
  264. 		If Err Then
  265. 			m_Debug = m_Debug & vbCrLf _
  266. 			        & "[" & Now & "] Could not instantiate WinHTTPRequest object " _
  267. 			        & "(error: " & Err.Number & ")" & vbCrLf _
  268. 			        & Space(22) & "Aborting Query method"
  269. 			Exit Sub
  270. 		Else
  271. 			m_Debug = m_Debug & vbCrLf _
  272. 			        & "[" & Now & "] WinHTTPRequest object instantiated successfully"
  273. 		End If
  274. 		objHTTP.Open "GET", strURL, False
  275. 		objHTTP.SetRequestHeader "User-Agent", strAgent
  276.  
  277. 		' Set Busy status
  278. 		m_Debug = m_Debug & vbCrLf _
  279. 		        & "[" & Now & "] Set Busy status"
  280. 		m_Busy = True
  281.  
  282. 		' Send the HTTP request and store the results
  283. 		objHTTP.Send
  284. 		If Err Then
  285. 			m_Debug = m_Debug & vbCrLf _
  286. 			        & "[" & Now & "] Error sending WinHTTPRequest"              & vbCrLf _
  287. 			        & Space(22) & "Error Number      : " & Err.Number           & vbCrLf _
  288. 			        & Space(22) & "Error Description : " & Err.Description      & vbCrLf _
  289. 			        & Space(22) & "Error Source      : " & Err.Source           & vbCrLf _
  290. 			        & Space(22) & "Returned Status   : " & objHTTP.Status       & vbCrLf _
  291. 			        & Space(22) & "Returned Response : " & objHTTP.ResponseText & vbCrLf _
  292. 			        & Space(22) & "Aborting Query method"
  293. 			Exit Sub
  294. 		Else
  295. 			intStatus = objHTTP.Status
  296. 			strResult = Trim( Replace( objHTTP.ResponseText, vbLf, " " ) )
  297. 			arrResult = Split( strResult )
  298. 			ReDim Preserve arrResult( m_NumRequests - 1 )
  299. 			m_Debug = m_Debug & vbCrLf _
  300. 			        & "[" & Now & "] WinHTTPRequest sent" & vbCrLf _
  301. 			        & Space(22) & "Returned Status   : " & intStatus & vbCrLf _
  302. 			        & Space(22) & "Returned Response : " & strResult
  303. 		End If
  304.  
  305. 		On Error Goto 0
  306.  
  307. 		If intStatus = 200 Then
  308. 			m_Result = arrResult
  309. 		Else
  310. 			' Debug info
  311. 			m_Result      = Array( "N/A" )
  312. 			m_NumRequests = 1
  313. 			m_Error       = True
  314. 		End If
  315.  
  316. 		' Clear Busy status and release WinHTTPRequest object
  317. 		m_Debug = m_Debug & vbCrLf _
  318. 		        & "[" & Now & "] Clear Busy status"
  319. 		m_Busy = False
  320. 		Set objHTTP = Nothing
  321. 		m_Debug = m_Debug & vbCrLf _
  322. 		        & "[" & Now & "] Query method ended normally"
  323. 	End Sub
  324.  
  325. 	' Reinitialize all properties
  326. 	Public Sub Init( )
  327. 		m_Debug = m_Debug & vbCrLf _
  328. 		        & "[" & Now & "] Init method started"
  329. 		m_Busy        = False
  330. 		m_Error       = False
  331. 		m_LowerLimit  = "N/A"
  332. 		m_NumRequests = 1
  333. 		m_UpperLimit  = "N/A"
  334. 		m_Result      = Array( "N/A" )
  335. 		m_Debug = m_Debug & vbCrLf _
  336. 		        & "[" & Now & "] Init method ended normally"
  337. 	End Sub
  338. End Class
  339.  

page last uploaded: 2017-07-06, 12:37