Option Explicit

Dim intRequests

intRequests = 10
Test

intRequests =  0
Test


Sub Test( )
	' This is a demo/test subroutine for the Random class
	Dim arrTest, clsRandom, i, intTest

	Set clsRandom = New Random
	clsRandom.LowerLimit  = 1
	clsRandom.UpperLimit  = 6
	clsRandom.NumRequests = intRequests
	clsRandom.Query

	WScript.Echo "Version    : " & clsRandom.Version
	WScript.Echo "NumRequests: " & intRequests
	WScript.Echo "Lower Limit: " & clsRandom.LowerLimit
	WScript.Echo "Upper Limit: " & clsRandom.UpperLimit
	WScript.Echo "Error      : " & clsRandom.Error & vbCrLf

	intTest = 0
	arrTest = clsRandom.Result
	If IsNumeric( arrTest(0) ) Then
		For i = 0 To clsRandom.NumRequests -1
			WScript.Echo "Result " & i & "   : " & arrTest(i)
			intTest = intTest + arrTest(i)
		Next
		WScript.Echo "Average    : " & ( intTest / clsRandom.NumRequests )
	End If
	WScript.Echo vbCrLf & "Debug Info : " & clsRandom.Debug & vbCrLf

	Set clsRandom = Nothing
End Sub


Class Random
' This class 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 12, 2007               First public release
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com

	' Local variables holding the values for for the public properties
	Private m_LowerLimit, m_UpperLimit, m_NumRequests
	Private m_Result, m_Busy, m_Debug, m_Error, m_Version
	' Local variables for the Query subroutine (cannot use Private
	' inside a subroutine, and using Dim would expose the variables)
	Private arrResult, i, intStatus, objHTTP, strAgent, strResult, strURL

    ' Initialize the variables when the class is initialized
	Private Sub Class_Initialize
		m_Debug   = m_Debug & vbCrLf _
		          & "[" & Now & "] Class initialization started"
		m_Version = "1.00"
		Init
		m_Debug = m_Debug & vbCrLf _
		        & "[" & Now & "] Class initialization ended normally"
	End Sub

    ' Get the LowerLimit value
	Public Property Get LowerLimit
		m_Debug   = m_Debug & vbCrLf _
		          & "[" & Now & "] LowerLimit value read (" & m_LowerLimit & ")"
		LowerLimit = m_LowerLimit
	End Property

	' Set the LowerLimit value
	Public Property Let LowerLimit( myLimit )
		m_Debug  = m_Debug & vbCrLf _
		         & "[" & Now & "] Trying to set LowerLimit value to " _
		         & myLimit & vbCrLf _
		         & Space(22) & "Resetting Result value"
		m_Result = Array( "N/A" )
		If IsNumeric( myLimit ) Then
			If CStr( CInt( myLimit ) ) = CStr( myLimit ) Then
				m_LowerLimit = myLimit
				m_Debug = m_Debug & vbCrLf _
				        & "[" & Now & "] LowerLimit value set to " & myLimit
			Else
				m_Debug = m_Debug & vbCrLf _
				        & "[" & Now & "] Specified LowerLimit (" _
				        & myLimit & ") is not an integer"
		        m_Error = True
			End If
		Else
			m_Debug = m_Debug & vbCrLf _
			        & "[" & Now & "] Specified LowerLimit (" _
			        & myLimit & ") is not a number"
			m_Error = True
		End If
	End Property

	' Get the UpperLimit value
	Public Property Get UpperLimit
		m_Debug   = m_Debug & vbCrLf _
		          & "[" & Now & "] UpperLimit value read (" & m_UpperLimit & ")"
		UpperLimit = m_UpperLimit
	End Property

	' Set the UpperLimit value
	Public Property Let UpperLimit( myLimit )
		m_Debug  = m_Debug & vbCrLf _
		         & "[" & Now & "] Trying to set UpperLimit value to " _
		         & myLimit & vbCrLf _
		         & Space(22) & "Resetting Result value"
		m_Result = Array( "N/A" )
		If IsNumeric( myLimit ) Then
			If CStr( CInt( myLimit ) ) = CStr( myLimit ) Then
				m_UpperLimit = myLimit
				m_Debug = m_Debug & vbCrLf _
				        & "[" & Now & "] UpperLimit value set to " & myLimit
			Else
				m_Debug = m_Debug & vbCrLf _
				        & "[" & Now & "] Specified UpperLimit (" _
				        & myLimit & ") is not an integer"
				m_Error = True
			End If
		Else
			m_Debug = m_Debug & vbCrLf _
		        & "[" & Now & "] Specified UpperLimit (" _
		        & myLimit & ") is not a number"
			m_Error = True
		End If
	End Property

	' Get the NumRequests value
	Public Property Get NumRequests
		m_Debug     = m_Debug & vbCrLf _
		            & "[" & Now & "] NumRequests value read (" & m_NumRequests & ")"
		NumRequests = m_NumRequests
	End Property

	' Set the NumRequests value
	Public Property Let NumRequests( myNum )
		m_Debug  = m_Debug & vbCrLf _
		         & "[" & Now & "] Trying to set NumRequests value to " _
		         & myNum & vbCrLf _
		         & Space(22) & "Resetting Result value"
		m_Result = Array( "N/A" )
		If IsNumeric( myNum ) Then
			If CStr( CInt( myNum ) ) = CStr( myNum ) And myNum > 0 Then
				m_NumRequests = myNum
				m_Debug = m_Debug & vbCrLf _
				        & "[" & Now & "] NumRequests value set to " & myNum
			Else
				m_Debug = m_Debug & vbCrLf _
				        & "[" & Now & "] Specified NumRequests (" _
				        & myNum & ") is not an integer greater than zero"
				m_Error = True
			End If
		Else
			m_Debug = m_Debug & vbCrLf _
		        & "[" & Now & "] Specified NumRequests (" _
		        & myNum & ") is not a number"
			m_Error = True
		End If
	End Property

    ' Get the Busy value
	Public Property Get Busy
		m_Debug = m_Debug & vbCrLf _
		        & "[" & Now & "] Busy value read (" & m_Busy & ")"
		Busy = m_Busy
	End Property

    ' Get the Debug value
	Public Property Get Debug
'		m_Debug = m_Debug & vbCrLf _
'		        & "[" & Now & "] Debug value read (" & m_Debug & ")"
		Debug   = m_Debug
	End Property

    ' Get the Error value
	Public Property Get Error
		m_Debug = m_Debug & vbCrLf _
		        & "[" & Now & "] Error value read (" & m_Error & ")"
		Error   = m_Error
	End Property

    ' Get the Result value
	Public Property Get Result
		m_Debug = m_Debug & vbCrLf _
		        & "[" & Now & "] Result value read (" & Join( m_Result, " " ) & ")"
		Result  = m_Result
	End Property

    ' Get the Version value
	Public Property Get Version
		m_Debug = m_Debug & vbCrLf _
		        & "[" & Now & "] Version value read (" & m_Version & ")"
		Version = m_Version
	End Property

	' Start the HTTP request to random.org
	Public Sub Query( )
		m_Debug  = m_Debug & vbCrLf _
		         & "[" & Now & "] Query method started" & vbCrLf _
		         & Space(22) & "Resetting Result value"
		m_Result = Array( "N/A" )
		' Check if a valid LowerLimit was specified
		If Not IsNumeric( m_LowerLimit ) Then
			m_Debug = m_Debug & vbCrLf _
			        & "[" & Now & "] LowerLimit value not set (" & m_LowerLimit & ")"
			m_Error = True
		End If
		' Check if a valid UpperLimit was specified
		If Not IsNumeric( m_UpperLimit ) Then
			m_Debug = m_Debug & vbCrLf _
			        & "[" & Now & "] UpperLimit value not set (" & m_UpperLimit & ")"
			m_Error = True
		End If
		' Check for ANY error
		If m_Error Then
			m_Debug = m_Debug & vbCrLf _
			        & "[" & Now & "] An error has occurred (Error=" _
			        & m_Error & ")" & vbCrLf _
			        & Space(22) & "Aborting Query method"
			m_Result      = Array( "N/A" )
			m_NumRequests = 1
			Exit Sub
		End If

		' Format the URL for a HTTP request to random.org
		strURL   = "http://www.random.org/integers/" _
		         & "?num=" & m_NumRequests _
		         & "&min=" & m_LowerLimit  _
		         & "&max=" & m_UpperLimit  _
		         & "&col=1&base=10&format=plain&rnd=new"
		m_Debug  = m_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)"
		m_Debug  = m_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
			m_Debug = m_Debug & vbCrLf _
			        & "[" & Now & "] Could not instantiate WinHTTPRequest object " _
			        & "(error: " & Err.Number & ")" & vbCrLf _
			        & Space(22) & "Aborting Query method"
			Exit Sub
		Else
			m_Debug = m_Debug & vbCrLf _
			        & "[" & Now & "] WinHTTPRequest object instantiated successfully"
		End If
		objHTTP.Open "GET", strURL, False
		objHTTP.SetRequestHeader "User-Agent", strAgent

		' Set Busy status
		m_Debug = m_Debug & vbCrLf _
		        & "[" & Now & "] Set Busy status"
		m_Busy = True

		' Send the HTTP request and store the results
		objHTTP.Send
		If Err Then
			m_Debug = m_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 Sub
		Else
			intStatus = objHTTP.Status
			strResult = Trim( Replace( objHTTP.ResponseText, vbLf, " " ) )
			arrResult = Split( strResult )
			ReDim Preserve arrResult( m_NumRequests - 1 )
			m_Debug = m_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
			m_Result = arrResult
		Else
			' Debug info
			m_Result      = Array( "N/A" )
			m_NumRequests = 1
			m_Error       = True
		End If

		' Clear Busy status and release WinHTTPRequest object
		m_Debug = m_Debug & vbCrLf _
		        & "[" & Now & "] Clear Busy status"
		m_Busy = False
		Set objHTTP = Nothing
		m_Debug = m_Debug & vbCrLf _
		        & "[" & Now & "] Query method ended normally"
	End Sub

	' Reinitialize all properties
	Public Sub Init( )
		m_Debug = m_Debug & vbCrLf _
		        & "[" & Now & "] Init method started"
		m_Busy        = False
		m_Error       = False
		m_LowerLimit  = "N/A"
		m_NumRequests = 1
		m_UpperLimit  = "N/A"
		m_Result      = Array( "N/A" )
		m_Debug = m_Debug & vbCrLf _
		        & "[" & Now & "] Init method ended normally"
	End Sub
End Class