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

True Random Numbers

  1. RndInt (Function using WinHTTP & Random.org)
  2. RndIntArr (Function using WinHTTP & Random.org)
  3. Random (Class using WinHTTP & Random.org)
  4. Random.wsc (Windows Script Component using WinHTTP & Random.org)

 

RndInt (WinHTTP & Random.org)
VBScript Code:
Function RndInt( myMin, myMax )
' Retrieves a single TRUE random integer from http://www.random.org/
'
' Arguments:
' myMin  [int]  lowest possible value for the random integer
' myMax  [int]  highest possible value for the random integer
'
' Returns:
' [int]  random integer within the specified range
'        OR a [string] error message
'
' Note:
' Read http://www.random.org/quota/ if you intend to use this script often
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
    Dim intStatus, objHTTP, strAgent, strResult, strURL

    If Not IsNumeric( myMin ) Then
        RndInt = "Error (" & myMin & " is not a number)"
        Exit Function
    End If

    If Not IsNumeric( myMax ) Then
        RndInt = "Error (" & myMax & " is not a number)"
        Exit Function
    End If

    If Not CInt( myMin ) = myMin Then
        RndInt = "Error (" & myMin & " is not an integer)"
        Exit Function
    End If

    If Not CInt( myMax ) = myMax Then
        RndInt = "Error (" & myMax & " is not an integer)"
        Exit Function
    End If

    strURL   = "http://www.random.org/integers/?num=1" _
             & "&min=" & myMin _
             & "&max=" & myMax _
             & "&col=1&base=10&format=plain&rnd=new"
    strAgent = "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"

    Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
    objHTTP.Open "GET", strURL, False
    objHTTP.SetRequestHeader "User-Agent", strAgent

    On Error Resume Next
    objHTTP.Send
    intStatus = objHTTP.Status
    strResult = Trim( Replace( objHTTP.ResponseText, vbLf, " " ) )
    On Error Goto 0

    If intStatus = 200 Then
        RndInt = strResult
    Else
        RndInt = "Error (Status " & intStatus & ")"
    End If

    Set objHTTP = Nothing
End Function
 
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]
 
RndIntArr (WinHTTP & Random.org)
VBScript Code:
Function RndIntArr( myMin, myMax, myLength )
' Retrieves TRUE random integers from http://www.random.org/
'
' Arguments:
' myMin     [int]  lowest possible value for the random integer
' myMax     [int]  highest possible value for the random integer
' myLength  [int]  the number of random integers that should be retrieved
'
' Returns:
' [array of int]   array with the requested number of random integers within
'                  the specified range OR an [array of string] error message
'
' Note:
' Read http://www.random.org/quota/ if you intend to use this script often
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
    Dim arrResult, i, intStatus, objHTTP, strAgent, strResult, strURL

    If Not IsNumeric( myMin ) Then
        RndInt = "Error (" & myMin & " is not a number)"
        Exit Function
    End If

    If Not IsNumeric( myMax ) Then
        RndInt = "Error (" & myMax & " is not a number)"
        Exit Function
    End If

    If Not IsNumeric( myLength ) Then
        RndInt = "Error (" & myLength & " is not a number)"
        Exit Function
    End If

    If Not CInt( myMin ) = myMin Then
        RndInt = "Error (" & myMin & " is not an integer)"
        Exit Function
    End If

    If Not CInt( myMax ) = myMax Then
        RndInt = "Error (" & myMax & " is not an integer)"
        Exit Function
    End If

    If Not Abs( CInt( myLength ) ) = myLength Then
        RndInt = "Error (" & myLength & " is not an integer)"
        Exit Function
    End If

    If myLength < 1 Then
        RndInt = "Error (" & myLength & " is not a valid number of requests)"
        Exit Function
    End If

    strURL   = "http://www.random.org/integers/" _
             & "?num=" & myLength _
             & "&min=" & myMin _
             & "&max=" & myMax _
             & "&col=1&base=10&format=plain&rnd=new"
    strAgent = "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"

    Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
    objHTTP.Open "GET", strURL, False
    objHTTP.SetRequestHeader "User-Agent", strAgent

    On Error Resume Next
    objHTTP.Send
    intStatus = objHTTP.Status
    strResult = Trim( Replace( objHTTP.ResponseText, vbLf, " " ) )
    arrResult = Split( strResult )
    ReDim Preserve arrResult( myLength - 1 )
    On Error Goto 0

    If intStatus = 200 Then
        RndIntArr = arrResult
    Else
        RndIntArr = Array( "Error (Status " & intStatus & ")" )
    End If

    Set objHTTP = Nothing
End Function
 
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 arrTest

' Cast 1 die with the RndInt function,
' which returns a single random integer
WScript.Echo RndInt( 1, 6 )

' Cast 2 dice with the RndIntArr function, which
' returns multiple random integers in an array
arrTest = RndIntArr( 1, 6, 2 )
WScript.Echo arrTest(0) & vbCrLf & arrTest(1)
 
Sample output:
3
3
5
 
[Back to the top of this page]

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