Source code for random.wsc

```
<![CDATA[
```
```
 
```

' This component uses random.org to retrieve true random integers

```
'
```
```
' Properties:
```

' Busy        R   [boolean]   If TRUE results aren't available yet

' Debug       R   [string]    Debugging information

' Error       R   [boolean]   If TRUE check Debug property for description

' LowerLimit  R/W [integer]   Lower limit of the integer to be returned

' NumRequests R/W [integer]   Number of integers to be returned (default=1)

' Result      R   [array int] Resulting random integers

' UpperLimit  R/W [integer]   Upper limit of the integer to be returned

' Version     R   [string]    This class' version number

```
'
```
```
' Methods:
```

' Query( )        Start the request for (a) new random integer(s)

```
' Init( )         Reset all properties
```
```
'
```
```
' Change Log:
```

' August 15, 2007               First public release

```
'
```
```
' Written by Rob van der Woude
```
```
' http://www.robvanderwoude.com
```
```
 
```
```
Option Explicit
```
```
 
```
```
Dim Busy, Debug, Error, Result, Version
```
```
Dim LowerLimit, UpperLimit, NumRequests
```
```
 
```

Debug   = vbCrLf & "[" & Now & "] Component initialized"

```
Version = "1.00"
```
```
 
```
```
Init
```
```
 
```
```
 
```
```
Function get_Busy( )
```
```
	Debug = Debug & vbCrLf _
```

	      & "[" & Now & "] Busy value read (" & Busy & ")"

```
	get_Busy = Busy
```
```
End Function
```
```
 
```
```
 
```
```
Function get_Debug( )
```
```
	get_Debug = Debug
```
```
End Function
```
```
 
```
```
 
```
```
Function get_Error( )
```
```
	Debug = Debug & vbCrLf _
```

	      & "[" & Now & "] Error value read (" & Error & ")"

```
	get_Error = Error
```
```
End Function
```
```
 
```
```
 
```
```
Function get_LowerLimit( )
```
```
	Debug = Debug & vbCrLf _
```

	      & "[" & Now & "] LowerLimit value read (" & LowerLimit & ")"

```
	get_LowerLimit = LowerLimit
```
```
End Function
```
```
 
```
```
 
```
```
Function put_LowerLimit( newValue )
```
```
	Debug  = Debug & vbCrLf _
```

	       & "[" & Now & "] Trying to set LowerLimit value to " _

```
	       & newValue & vbCrLf _
```

	       & Space(22) & "Resetting Result value"

```
	Result = Array( "N/A" )
```
```
	If IsNumeric( newValue ) Then
```

		If CStr( CInt( newValue ) ) = CStr( newValue ) Then

```
			LowerLimit = newValue
```
```
			Debug = Debug & vbCrLf _
```

			      & "[" & Now & "] LowerLimit value set to " & newValue

```
		Else
```
```
			Debug = Debug & vbCrLf _
```

			      & "[" & Now & "] Specified LowerLimit (" _

			      & newValue & ") is not an integer"

```
			Error = True
```
```
		End If
```
```
	Else
```
```
		Debug = Debug & vbCrLf _
```

		      & "[" & Now & "] Specified LowerLimit (" _

		      & newValue & ") is not a number"

```
		Error = True
```
```
	End If
```
```
End Function
```
```
 
```
```
 
```
```
Function get_NumRequests( )
```
```
	Debug = Debug & vbCrLf _
```

	      & "[" & Now & "] NumRequests value read (" & NumRequests & ")"

```
	get_NumRequests = NumRequests
```
```
End Function
```
```
 
```
```
 
```
```
Function put_NumRequests( newValue )
```
```
	Debug  = Debug & vbCrLf _
```

	       & "[" & Now & "] Trying to set NumRequests value to " _

```
	       & newValue & vbCrLf _
```

	       & Space(22) & "Resetting Result value"

```
	Result = Array( "N/A" )
```
```
	If IsNumeric( newValue ) Then
```

		If CStr( CInt( newValue ) ) = CStr( newValue ) And newValue > 0 Then

```
			NumRequests = newValue
```
```
			Debug = Debug & vbCrLf _
```

			      & "[" & Now & "] NumRequests value set to " & newValue

```
		Else
```
```
			Debug = Debug & vbCrLf _
```

			      & "[" & Now & "] Specified NumRequests (" _

			      & newValue & ") is not an integer greater than zero"

```
			Error = True
```
```
		End If
```
```
	Else
```
```
		Debug = Debug & vbCrLf _
```

		      & "[" & Now & "] Specified NumRequests (" _

		      & newValue & ") is not a number"

```
		Error = True
```
```
	End If
```
```
End Function
```
```
 
```
```
 
```
```
Function get_Result( )
```
```
	Debug = Debug & vbCrLf _
```

	      & "[" & Now & "] Result value read (" & Join( Result, " " ) & ")"

```
	get_Result = Result
```
```
End Function
```
```
 
```
```
 
```
```
Function get_UpperLimit( )
```
```
	Debug = Debug & vbCrLf _
```

	      & "[" & Now & "] UpperLimit value read (" & UpperLimit & ")"

```
	get_UpperLimit = UpperLimit
```
```
End Function
```
```
 
```
```
 
```
```
Function put_UpperLimit( newValue )
```
```
	Debug  = Debug & vbCrLf _
```

	       & "[" & Now & "] Trying to set UpperLimit value to " _

```
	       & newValue & vbCrLf _
```

	       & Space(22) & "Resetting Result value"

```
	Result = Array( "N/A" )
```
```
	If IsNumeric( newValue ) Then
```

		If CStr( CInt( newValue ) ) = CStr( newValue ) Then

```
			UpperLimit = newValue
```
```
			Debug = Debug & vbCrLf _
```

			      & "[" & Now & "] UpperLimit value set to " & newValue

```
		Else
```
```
			Debug = Debug & vbCrLf _
```

			      & "[" & Now & "] Specified UpperLimit (" _

			      & newValue & ") is not an integer"

```
			Error = True
```
```
		End If
```
```
	Else
```
```
		Debug = Debug & vbCrLf _
```

			      & "[" & Now & "] Specified UpperLimit (" _

			      & newValue & ") is not a number"

```
		Error = True
```
```
	End If
```
```
End Function
```
```
 
```
```
 
```
```
Function get_Version( )
```
```
	Debug = Debug & vbCrLf _
```

	      & "[" & Now & "] Version value read (" & Version & ")"

```
	get_Version = Version
```
```
End Function
```
```
 
```
```
 
```
```
Function Query( )
```

	Dim arrResult, i, intStatus, objHTTP, strAgent, strResult, strURL

```
 
```
```
	Query  = True
```
```
	Debug  = Debug & vbCrLf _
```

	       & "[" & Now & "] Query method started" & vbCrLf _

	       & Space(22) & "Resetting Result value"

```
	Result = Array( "N/A" )
```
```
 
```

	' Check if a valid LowerLimit was specified

```
	If Not IsNumeric( LowerLimit ) Then
```
```
		Debug = Debug & vbCrLf _
```

		      & "[" & Now & "] LowerLimit value not set (" & LowerLimit & ")"

```
		Error = True
```
```
	End If
```

	' Check if a valid UpperLimit was specified

```
	If Not IsNumeric( UpperLimit ) Then
```
```
		Debug = Debug & vbCrLf _
```

		      & "[" & Now & "] UpperLimit value not set (" & UpperLimit & ")"

```
		Error = True
```
```
	End If
```
```
 
```
```
	' Check for ANY error
```
```
	If Error Then
```
```
		Debug = Debug & vbCrLf _
```

		      & "[" & Now & "] An error has occurred (Error=" _

```
		      & Error & ")" & vbCrLf _
```

		      & Space(22) & "Aborting Query method"

```
		Result      = Array( "N/A" )
```
```
		NumRequests = 1
```
```
		Exit Function
```
```
	End If
```
```
 
```

	' Format the URL for a HTTP request to random.org

	strURL = "http://www.random.org/integers/" _

```
	       & "?num=" & NumRequests _
```
```
	       & "&min=" & LowerLimit  _
```
```
	       & "&max=" & UpperLimit  _
```

	       & "&col=1&base=10&format=plain&rnd=new"

```
	Debug  = Debug & vbCrLf _
```

	       & "[" & Now & "] URL string set to:" & vbCrLf _

	       & Space(22) & """" & strURL & """"

```
 
```
```
	' User agent string (not critical)
```

	strAgent = "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"

```
	Debug    = Debug & vbCrLf _
```

	         & "[" & Now & "] Agent string set to:" & vbCrLf _

	         & Space(22) & """" & strAgent & """"

```
 
```
```
 
```

	' Prepare the HTTP request to random.org

```
	On Error Resume Next
```

	Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )

```
	If Err Then
```
```
		Debug = Debug & vbCrLf _
```

		      & "[" & Now & "] Could not instantiate WinHTTPRequest object " _

		      & "(error: " & Err.Number & ")" & vbCrLf _

		      & Space(22) & "Aborting Query method"

```
		Exit Function
```
```
	Else
```
```
		Debug = Debug & vbCrLf _
```

		      & "[" & Now & "] WinHTTPRequest object instantiated successfully"

```
	End If
```
```
	objHTTP.Open "GET", strURL, False
```

	objHTTP.SetRequestHeader "User-Agent", strAgent

```
 
```
```
	' Set Busy status
```
```
	Debug = Debug & vbCrLf _
```

	      & "[" & Now & "] Set Busy status"

```
	Busy  = True
```
```
 
```

	' Send the HTTP request and store the results

```
	objHTTP.Send
```
```
	If Err Then
```
```
		Debug = Debug & vbCrLf _
```

		      & "[" & Now & "] Error sending WinHTTPRequest"              & vbCrLf _

		      & Space(22) & "Error Number      : " & Err.Number           & vbCrLf _

		      & Space(22) & "Error Description : " & Err.Description      & vbCrLf _

		      & Space(22) & "Error Source      : " & Err.Source           & vbCrLf _

		      & Space(22) & "Returned Status   : " & objHTTP.Status       & vbCrLf _

		      & Space(22) & "Returned Response : " & objHTTP.ResponseText & vbCrLf _

		      & Space(22) & "Aborting Query method"

```
		Exit Function
```
```
	Else
```
```
		intStatus = objHTTP.Status
```

		strResult = Trim( Replace( objHTTP.ResponseText, vbLf, " " ) )

```
		arrResult = Split( strResult )
```

		ReDim Preserve arrResult( NumRequests - 1 )

```
		Debug = Debug & vbCrLf _
```

		      & "[" & Now & "] WinHTTPRequest sent" & vbCrLf _

		      & Space(22) & "Returned Status   : " & intStatus & vbCrLf _

		      & Space(22) & "Returned Response : " & strResult

```
	End If
```
```
 
```
```
	On Error Goto 0
```
```
 
```
```
	If intStatus = 200 Then
```
```
		Result = arrResult
```
```
	Else
```
```
		' Debug info
```
```
		Result      = Array( "N/A" )
```
```
		NumRequests = 1
```
```
		Error       = True
```
```
	End If
```
```
 
```

	' Clear Busy status and release WinHTTPRequest object

```
	Debug = Debug & vbCrLf _
```

	      & "[" & Now & "] Clear Busy status"

```
	Busy  = False
```
```
	Set objHTTP = Nothing
```
```
	Debug = Debug & vbCrLf _
```

	      & "[" & Now & "] Query method ended normally"

```
End Function
```
```
 
```
```
 
```
```
Function Init( )
```
```
	NumRequests = 1
```
```
	LowerLimit  = "N/A"
```
```
	UpperLimit  = "N/A"
```
```
	Result      = "N/A"
```
```
	Busy        = "False"
```
```
	Error       = "False"
```
```
	Init        = True
```
```
End Function
```
```
 
```
```
]]>
```