Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for random.wsc

(view source code of random.wsc as plain text)

  1. <?xml version="1.0"?>
  2. <component>
  3.  
  4. <?component error="true" debug="true"?>
  5.  
  6. <registration
  7. 	description="Random"
  8. 	progid="Random.WSC"
  9. 	version="1.00"
  10. 	classid="{ce1407dd-d883-4182-8c1f-bfe67f4b1278}"
  11. >
  12. </registration>
  13.  
  14. <public>
  15. 	<property name="Busy">
  16. 		<get/>
  17. 	</property>
  18. 	<property name="Debug">
  19. 		<get/>
  20. 	</property>
  21. 	<property name="Error">
  22. 		<get/>
  23. 	</property>
  24. 	<property name="LowerLimit">
  25. 		<get/>
  26. 		<put/>
  27. 	</property>
  28. 	<property name="NumRequests">
  29. 		<get/>
  30. 		<put/>
  31. 	</property>
  32. 	<property name="Result">
  33. 		<get/>
  34. 	</property>
  35. 	<property name="UpperLimit">
  36. 		<get/>
  37. 		<put/>
  38. 	</property>
  39. 	<property name="Version">
  40. 		<get/>
  41. 	</property>
  42. 	<method name="Query">
  43. 	</method>
  44. 	<method name="Init">
  45. 	</method>
  46. </public>
  47.  
  48. <script language="VBScript">
  1. <![CDATA[
  2.  
  3. ' This component uses random.org to retrieve true random integers
  4. '
  5. ' Properties:
  6. ' Busy        R   [boolean]   If TRUE results aren't available yet
  7. ' Debug       R   [string]    Debugging information
  8. ' Error       R   [boolean]   If TRUE check Debug property for description
  9. ' LowerLimit  R/W [integer]   Lower limit of the integer to be returned
  10. ' NumRequests R/W [integer]   Number of integers to be returned (default=1)
  11. ' Result      R   [array int] Resulting random integers
  12. ' UpperLimit  R/W [integer]   Upper limit of the integer to be returned
  13. ' Version     R   [string]    This class' version number
  14. '
  15. ' Methods:
  16. ' Query( )        Start the request for (a) new random integer(s)
  17. ' Init( )         Reset all properties
  18. '
  19. ' Change Log:
  20. ' August 15, 2007               First public release
  21. '
  22. ' Written by Rob van der Woude
  23. ' http://www.robvanderwoude.com
  24.  
  25. Option Explicit
  26.  
  27. Dim Busy, Debug, Error, Result, Version
  28. Dim LowerLimit, UpperLimit, NumRequests
  29.  
  30. Debug   = vbCrLf & "[" & Now & "] Component initialized"
  31. Version = "1.00"
  32.  
  33. Init
  34.  
  35.  
  36. Function get_Busy( )
  37. 	Debug = Debug & vbCrLf _
  38. 	      & "[" & Now & "] Busy value read (" & Busy & ")"
  39. 	get_Busy = Busy
  40. End Function
  41.  
  42.  
  43. Function get_Debug( )
  44. 	get_Debug = Debug
  45. End Function
  46.  
  47.  
  48. Function get_Error( )
  49. 	Debug = Debug & vbCrLf _
  50. 	      & "[" & Now & "] Error value read (" & Error & ")"
  51. 	get_Error = Error
  52. End Function
  53.  
  54.  
  55. Function get_LowerLimit( )
  56. 	Debug = Debug & vbCrLf _
  57. 	      & "[" & Now & "] LowerLimit value read (" & LowerLimit & ")"
  58. 	get_LowerLimit = LowerLimit
  59. End Function
  60.  
  61.  
  62. Function put_LowerLimit( newValue )
  63. 	Debug  = Debug & vbCrLf _
  64. 	       & "[" & Now & "] Trying to set LowerLimit value to " _
  65. 	       & newValue & vbCrLf _
  66. 	       & Space(22) & "Resetting Result value"
  67. 	Result = Array( "N/A" )
  68. 	If IsNumeric( newValue ) Then
  69. 		If CStr( CInt( newValue ) ) = CStr( newValue ) Then
  70. 			LowerLimit = newValue
  71. 			Debug = Debug & vbCrLf _
  72. 			      & "[" & Now & "] LowerLimit value set to " & newValue
  73. 		Else
  74. 			Debug = Debug & vbCrLf _
  75. 			      & "[" & Now & "] Specified LowerLimit (" _
  76. 			      & newValue & ") is not an integer"
  77. 			Error = True
  78. 		End If
  79. 	Else
  80. 		Debug = Debug & vbCrLf _
  81. 		      & "[" & Now & "] Specified LowerLimit (" _
  82. 		      & newValue & ") is not a number"
  83. 		Error = True
  84. 	End If
  85. End Function
  86.  
  87.  
  88. Function get_NumRequests( )
  89. 	Debug = Debug & vbCrLf _
  90. 	      & "[" & Now & "] NumRequests value read (" & NumRequests & ")"
  91. 	get_NumRequests = NumRequests
  92. End Function
  93.  
  94.  
  95. Function put_NumRequests( newValue )
  96. 	Debug  = Debug & vbCrLf _
  97. 	       & "[" & Now & "] Trying to set NumRequests value to " _
  98. 	       & newValue & vbCrLf _
  99. 	       & Space(22) & "Resetting Result value"
  100. 	Result = Array( "N/A" )
  101. 	If IsNumeric( newValue ) Then
  102. 		If CStr( CInt( newValue ) ) = CStr( newValue ) And newValue > 0 Then
  103. 			NumRequests = newValue
  104. 			Debug = Debug & vbCrLf _
  105. 			      & "[" & Now & "] NumRequests value set to " & newValue
  106. 		Else
  107. 			Debug = Debug & vbCrLf _
  108. 			      & "[" & Now & "] Specified NumRequests (" _
  109. 			      & newValue & ") is not an integer greater than zero"
  110. 			Error = True
  111. 		End If
  112. 	Else
  113. 		Debug = Debug & vbCrLf _
  114. 		      & "[" & Now & "] Specified NumRequests (" _
  115. 		      & newValue & ") is not a number"
  116. 		Error = True
  117. 	End If
  118. End Function
  119.  
  120.  
  121. Function get_Result( )
  122. 	Debug = Debug & vbCrLf _
  123. 	      & "[" & Now & "] Result value read (" & Join( Result, " " ) & ")"
  124. 	get_Result = Result
  125. End Function
  126.  
  127.  
  128. Function get_UpperLimit( )
  129. 	Debug = Debug & vbCrLf _
  130. 	      & "[" & Now & "] UpperLimit value read (" & UpperLimit & ")"
  131. 	get_UpperLimit = UpperLimit
  132. End Function
  133.  
  134.  
  135. Function put_UpperLimit( newValue )
  136. 	Debug  = Debug & vbCrLf _
  137. 	       & "[" & Now & "] Trying to set UpperLimit value to " _
  138. 	       & newValue & vbCrLf _
  139. 	       & Space(22) & "Resetting Result value"
  140. 	Result = Array( "N/A" )
  141. 	If IsNumeric( newValue ) Then
  142. 		If CStr( CInt( newValue ) ) = CStr( newValue ) Then
  143. 			UpperLimit = newValue
  144. 			Debug = Debug & vbCrLf _
  145. 			      & "[" & Now & "] UpperLimit value set to " & newValue
  146. 		Else
  147. 			Debug = Debug & vbCrLf _
  148. 			      & "[" & Now & "] Specified UpperLimit (" _
  149. 			      & newValue & ") is not an integer"
  150. 			Error = True
  151. 		End If
  152. 	Else
  153. 		Debug = Debug & vbCrLf _
  154. 			      & "[" & Now & "] Specified UpperLimit (" _
  155. 			      & newValue & ") is not a number"
  156. 		Error = True
  157. 	End If
  158. End Function
  159.  
  160.  
  161. Function get_Version( )
  162. 	Debug = Debug & vbCrLf _
  163. 	      & "[" & Now & "] Version value read (" & Version & ")"
  164. 	get_Version = Version
  165. End Function
  166.  
  167.  
  168. Function Query( )
  169. 	Dim arrResult, i, intStatus, objHTTP, strAgent, strResult, strURL
  170.  
  171. 	Query  = True
  172. 	Debug  = Debug & vbCrLf _
  173. 	       & "[" & Now & "] Query method started" & vbCrLf _
  174. 	       & Space(22) & "Resetting Result value"
  175. 	Result = Array( "N/A" )
  176.  
  177. 	' Check if a valid LowerLimit was specified
  178. 	If Not IsNumeric( LowerLimit ) Then
  179. 		Debug = Debug & vbCrLf _
  180. 		      & "[" & Now & "] LowerLimit value not set (" & LowerLimit & ")"
  181. 		Error = True
  182. 	End If
  183. 	' Check if a valid UpperLimit was specified
  184. 	If Not IsNumeric( UpperLimit ) Then
  185. 		Debug = Debug & vbCrLf _
  186. 		      & "[" & Now & "] UpperLimit value not set (" & UpperLimit & ")"
  187. 		Error = True
  188. 	End If
  189.  
  190. 	' Check for ANY error
  191. 	If Error Then
  192. 		Debug = Debug & vbCrLf _
  193. 		      & "[" & Now & "] An error has occurred (Error=" _
  194. 		      & Error & ")" & vbCrLf _
  195. 		      & Space(22) & "Aborting Query method"
  196. 		Result      = Array( "N/A" )
  197. 		NumRequests = 1
  198. 		Exit Function
  199. 	End If
  200.  
  201. 	' Format the URL for a HTTP request to random.org
  202. 	strURL = "http://www.random.org/integers/" _
  203. 	       & "?num=" & NumRequests _
  204. 	       & "&min=" & LowerLimit  _
  205. 	       & "&max=" & UpperLimit  _
  206. 	       & "&col=1&base=10&format=plain&rnd=new"
  207. 	Debug  = Debug & vbCrLf _
  208. 	       & "[" & Now & "] URL string set to:" & vbCrLf _
  209. 	       & Space(22) & """" & strURL & """"
  210.  
  211. 	' User agent string (not critical)
  212. 	strAgent = "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
  213. 	Debug    = Debug & vbCrLf _
  214. 	         & "[" & Now & "] Agent string set to:" & vbCrLf _
  215. 	         & Space(22) & """" & strAgent & """"
  216.  
  217.  
  218. 	' Prepare the HTTP request to random.org
  219. 	On Error Resume Next
  220. 	Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
  221. 	If Err Then
  222. 		Debug = Debug & vbCrLf _
  223. 		      & "[" & Now & "] Could not instantiate WinHTTPRequest object " _
  224. 		      & "(error: " & Err.Number & ")" & vbCrLf _
  225. 		      & Space(22) & "Aborting Query method"
  226. 		Exit Function
  227. 	Else
  228. 		Debug = Debug & vbCrLf _
  229. 		      & "[" & Now & "] WinHTTPRequest object instantiated successfully"
  230. 	End If
  231. 	objHTTP.Open "GET", strURL, False
  232. 	objHTTP.SetRequestHeader "User-Agent", strAgent
  233.  
  234. 	' Set Busy status
  235. 	Debug = Debug & vbCrLf _
  236. 	      & "[" & Now & "] Set Busy status"
  237. 	Busy  = True
  238.  
  239. 	' Send the HTTP request and store the results
  240. 	objHTTP.Send
  241. 	If Err Then
  242. 		Debug = Debug & vbCrLf _
  243. 		      & "[" & Now & "] Error sending WinHTTPRequest"              & vbCrLf _
  244. 		      & Space(22) & "Error Number      : " & Err.Number           & vbCrLf _
  245. 		      & Space(22) & "Error Description : " & Err.Description      & vbCrLf _
  246. 		      & Space(22) & "Error Source      : " & Err.Source           & vbCrLf _
  247. 		      & Space(22) & "Returned Status   : " & objHTTP.Status       & vbCrLf _
  248. 		      & Space(22) & "Returned Response : " & objHTTP.ResponseText & vbCrLf _
  249. 		      & Space(22) & "Aborting Query method"
  250. 		Exit Function
  251. 	Else
  252. 		intStatus = objHTTP.Status
  253. 		strResult = Trim( Replace( objHTTP.ResponseText, vbLf, " " ) )
  254. 		arrResult = Split( strResult )
  255. 		ReDim Preserve arrResult( NumRequests - 1 )
  256. 		Debug = Debug & vbCrLf _
  257. 		      & "[" & Now & "] WinHTTPRequest sent" & vbCrLf _
  258. 		      & Space(22) & "Returned Status   : " & intStatus & vbCrLf _
  259. 		      & Space(22) & "Returned Response : " & strResult
  260. 	End If
  261.  
  262. 	On Error Goto 0
  263.  
  264. 	If intStatus = 200 Then
  265. 		Result = arrResult
  266. 	Else
  267. 		' Debug info
  268. 		Result      = Array( "N/A" )
  269. 		NumRequests = 1
  270. 		Error       = True
  271. 	End If
  272.  
  273. 	' Clear Busy status and release WinHTTPRequest object
  274. 	Debug = Debug & vbCrLf _
  275. 	      & "[" & Now & "] Clear Busy status"
  276. 	Busy  = False
  277. 	Set objHTTP = Nothing
  278. 	Debug = Debug & vbCrLf _
  279. 	      & "[" & Now & "] Query method ended normally"
  280. End Function
  281.  
  282.  
  283. Function Init( )
  284. 	NumRequests = 1
  285. 	LowerLimit  = "N/A"
  286. 	UpperLimit  = "N/A"
  287. 	Result      = "N/A"
  288. 	Busy        = "False"
  289. 	Error       = "False"
  290. 	Init        = True
  291. End Function
  292.  
  293. ]]>
  1. </script>
  2.  
  3. </component>

page last uploaded: 2017-04-06, 13:33