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

True Random Numbers (WSC)

Test Script
VBScript Code:
 
Option Explicit

' This should work ok
TestRandomComp 10

' This should generate an error
TestRandomComp  0


Sub TestRandomComp( myReq )
' This is a test subroutine for my RANDOM.WSC component

    Dim arrResult, i, intAvg, objFSO, objRnd, strWSC

    On Error Resume Next
    ' First let's see if the component is registered
    Set objRnd = CreateObject( "robvanderwoude.Random" )
    If Err Then
        ' If not, check if it exists in the current directory
        ' and use an alternative method to reference the component
        Set objFSO = CreateObject( "Scripting.FileSystemObject" )
        With objFSO
            strWSC = .BuildPath( .GetParentFolderName( WScript.ScriptFullName ), "Random.wsc" )
            If .FileExists( strWSC ) Then
                strWSC = "script:" & strWSC
                Set objRnd = GetObject( strWSC )
            Else
                WScript.Echo "Random.wsc not registered, " _
                           & "nor found in current directory"
            End If
        End With
    Set objFSO = Nothing
    End If
    On Error Goto 0

    ' Abort if we couldn't instantiate the object
    If Not IsObject( objRnd ) Then WScript.Quit 1

    ' Set the required properties and query random.org
    objRnd.LowerLimit  = 1
    objRnd.UpperLimit  = 6
    objRnd.NumRequests = myReq
    objRnd.Query

    WScript.Echo vbCrLf _
               & "Random.wsc, version " & objRnd.Version    & vbCrLf _
               & "Lower limit = "       & objRnd.LowerLimit & vbCrLf _
               & "Upper limit = "       & objRnd.UpperLimit & vbCrLf _
               & "NumRequests = "       & myReq             & vbCrLf

    If objRnd.Error Then
        WScript.Echo vbCrLf _
                   & "An error occurred, check the Debugging Info!" & vbCrLf
    Else
        WScript.Echo vbCrLf & "Results:" & vbCrLf & "========" & vbCrLf
        arrResult = objRnd.Result
        intAvg = 0
        For i = 0 To objRnd.NumRequests - 1
            WScript.Echo "Result[" & i & "] = " & arrResult(i)
            intAvg = intAvg + arrResult(i)
        Next
        WScript.Echo "Average   = " & ( intAvg / 10 )
    End If

    WScript.Echo vbCrLf & vbCrLf & "Debugging Info:" & vbCrLf & "==============="
    WScript.Echo objRnd.Debug & vbCrLf

    Set objRnd = Nothing
End Sub
 
Windows Script Component Source Code:
 
<?xml version="1.0"?>
<component>

<?component error="true" debug="true"?>

<registration
    description="Random"
    progid="Random.WSC"
    version="1.00"
    classid="{ce1407dd-d883-4182-8c1f-bfe67f4b1278}"
>
</registration>

<public>
    <property name="Busy">
        <get/>
    </property>
    <property name="Debug">
        <get/>
    </property>
    <property name="Error">
        <get/>
    </property>
    <property name="LowerLimit">
        <get/>
        <put/>
    </property>
    <property name="NumRequests">
        <get/>
        <put/>
    </property>
    <property name="Result">
        <get/>
    </property>
    <property name="UpperLimit">
        <get/>
        <put/>
    </property>
    <property name="Version">
        <get/>
    </property>
    <method name="Query">
    </method>
    <method name="Init">
    </method>
</public>

<script language="VBScript">
<![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

]]>
</script>

</component>
 
Sample output:
 
Random.wsc, version 1.00
Lower limit = 1
Upper limit = 6
NumRequests = 10


Results:
========

Result[0] = 4
Result[1] = 1
Result[2] = 4
Result[3] = 1
Result[4] = 5
Result[5] = 6
Result[6] = 2
Result[7] = 5
Result[8] = 5
Result[9] = 5
Average   = 3,8


Debugging Info:
===============

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


Random.wsc, version 1.00
Lower limit = 1
Upper limit = 6
NumRequests = 0


An error occurred, check the Debugging Info!



Debugging Info:
===============

[15-08-2007 00:03:11] Component initialized
[15-08-2007 00:03:11] Trying to set LowerLimit value to 1
                      Resetting Result value
[15-08-2007 00:03:11] LowerLimit value set to 1
[15-08-2007 00:03:11] Trying to set UpperLimit value to 6
                      Resetting Result value
[15-08-2007 00:03:11] UpperLimit value set to 6
[15-08-2007 00:03:11] Trying to set NumRequests value to 0
                      Resetting Result value
[15-08-2007 00:03:11] Specified NumRequests (0) is not an integer greater than zero
[15-08-2007 00:03:11] Query method started
                      Resetting Result value
[15-08-2007 00:03:11] An error has occurred (Error=True)
                      Aborting Query method
[15-08-2007 00:03:11] Version value read (1.00)
[15-08-2007 00:03:11] LowerLimit value read (1)
[15-08-2007 00:03:11] UpperLimit value read (6)
[15-08-2007 00:03:11] Error value read (True)
 
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]

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