Rob van der Woude's Scripting Pages
VBScript Scripting Techniques > Data > Random > True Random > True Random (Class)
VBScript Scripting Techniques > Data > Random > True Random (Class)  
VBScript Scripting Techniques > Internet > True Random > True Random (Class)  

True Random Numbers (Class)

Random (WinHTTP & Random.org)
VBScript Code:
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 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
 
Requirements:
Windows version: 2000 SP3, XP, Server 2003, or Vista
Network: any
Client software: Internet Explorer 5.01
Script Engine: any
Summarized: Works in Windows 2000 SP3 or later.
Should work in Windows 95, 98, ME, or NT 4 with Internet Explorer 5.01 or later.
 
[Back to the top of this page]
 
Sample Script
VBScript Code:
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
 
Sample output:
Version    : 1.00
NumRequests: 10
Lower Limit: 1
Upper Limit: 6
Error      : False

Result 0   : 1
Result 1   : 3
Result 2   : 1
Result 3   : 6
Result 4   : 1
Result 5   : 6
Result 6   : 5
Result 7   : 6
Result 8   : 1
Result 9   : 4
Average    : 3.4

Debug Info :
[13-08-2007 10:53:03] Class initialization started
[13-08-2007 10:53:03] Init method started
[13-08-2007 10:53:03] Init method ended normally
[13-08-2007 10:53:03] Class initialization ended normally
[13-08-2007 10:53:03] Trying to set LowerLimit value to 1
                      Resetting Result value
[13-08-2007 10:53:03] LowerLimit value set to 1
[13-08-2007 10:53:03] Trying to set UpperLimit value to 6
                      Resetting Result value
[13-08-2007 10:53:03] UpperLimit value set to 6
[13-08-2007 10:53:03] Trying to set NumRequests value to 10
                      Resetting Result value
[13-08-2007 10:53:03] NumRequests value set to 10
[13-08-2007 10:53:03] Query method started
                      Resetting Result value
[13-08-2007 10:53:03] URL string set to:
                      "http://www.random.org/integers/?num=10&min=1&max=6&col=1&base=10&format=plain&rnd=new"
[13-08-2007 10:53:03] Agent string set to:
                      "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
[13-08-2007 10:53:03] WinHTTPRequest object instantiated successfully
[13-08-2007 10:53:03] Set Busy status
[13-08-2007 10:53:06] WinHTTPRequest sent
                      Returned Status   : 200
                      Returned Response : 1 3 1 6 1 6 5 6 1 4
[13-08-2007 10:53:06] Clear Busy status
[13-08-2007 10:53:06] Query method ended normally
[13-08-2007 10:53:06] Version value read (1.00)
[13-08-2007 10:53:06] LowerLimit value read (1)
[13-08-2007 10:53:06] UpperLimit value read (6)
[13-08-2007 10:53:06] Error value read (False)
[13-08-2007 10:53:06] Result value read (1 3 1 6 1 6 5 6 1 4)
[13-08-2007 10:53:06] NumRequests value read (10)
[13-08-2007 10:53:06] NumRequests value read (10)

Version    : 1.00
NumRequests: 0
Lower Limit: 1
Upper Limit: 6
Error      : True


Debug Info :
[13-08-2007 10:53:06] Class initialization started
[13-08-2007 10:53:06] Init method started
[13-08-2007 10:53:06] Init method ended normally
[13-08-2007 10:53:06] Class initialization ended normally
[13-08-2007 10:53:06] Trying to set LowerLimit value to 1
                      Resetting Result value
[13-08-2007 10:53:06] LowerLimit value set to 1
[13-08-2007 10:53:06] Trying to set UpperLimit value to 6
                      Resetting Result value
[13-08-2007 10:53:06] UpperLimit value set to 6
[13-08-2007 10:53:06] Trying to set NumRequests value to 0
                      Resetting Result value
[13-08-2007 10:53:06] Specified NumRequests (0) is not an integer greater than zero
[13-08-2007 10:53:06] Query method started
                      Resetting Result value
[13-08-2007 10:53:06] An error has occurred (Error=True)
                      Aborting Query method
[13-08-2007 10:53:06] Version value read (1.00)
[13-08-2007 10:53:06] LowerLimit value read (1)
[13-08-2007 10:53:06] UpperLimit value read (6)
[13-08-2007 10:53:06] Error value read (True)
[13-08-2007 10:53:06] Result value read (N/A)
 
[Back to the top of this page]

page last modified: 2016-09-19; loaded in 0.0017 seconds