Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for truernd.vbs

(view source code of truernd.vbs as plain text) 

  1. Option Explicit
  2.  
  3. Dim arrTest
  4.  
  5. ' Cast 1 die with the RndInt function,
  6. ' which returns a single random integer
  7. WScript.Echo RndInt( 1, 6 )
  8.  
  9. ' Cast 2 dice with the RndIntArr function, which
  10. ' returns multiple random integers in an array
  11. arrTest = RndIntArr( 1, 6, 2 )
  12. WScript.Echo arrTest(0) & vbCrLf & arrTest(1)
  13.  
  14.  
  15. Function RndInt( myMin, myMax )
  16. ' Retrieves a single TRUE random integer from http://www.random.org/
  17. '
  18. ' Arguments:
  19. ' myMin  [int]  lowest possible value for the random integer
  20. ' myMax  [int]  highest possible value for the random integer
  21. '
  22. ' Returns:
  23. ' [int]  random integer within the specified range
  24. '        OR a [string] error message
  25. '
  26. ' Note:
  27. ' Read http://www.random.org/quota/ if you intend to use this script often
  28. '
  29. ' Written by Rob van der Woude
  30. ' http://www.robvanderwoude.com
  31. 	Dim intStatus, objHTTP, strAgent, strResult, strURL
  32.  
  33. 	If Not IsNumeric( myMin ) Then
  34. 		RndInt = "Error (" & myMin & " is not a number)"
  35. 		Exit Function
  36. 	End If
  37.  
  38. 	If Not IsNumeric( myMax ) Then
  39. 		RndInt = "Error (" & myMax & " is not a number)"
  40. 		Exit Function
  41. 	End If
  42.  
  43. 	If Not CInt( myMin ) = myMin Then
  44. 		RndInt = "Error (" & myMin & " is not an integer)"
  45. 		Exit Function
  46. 	End If
  47.  
  48. 	If Not CInt( myMax ) = myMax Then
  49. 		RndInt = "Error (" & myMax & " is not an integer)"
  50. 		Exit Function
  51. 	End If
  52.  
  53. 	strURL   = "http://www.random.org/integers/?num=1" _
  54. 	         & "&min=" & myMin _
  55. 	         & "&max=" & myMax _
  56. 	         & "&col=1&base=10&format=plain&rnd=new"
  57. 	strAgent = "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
  58.  
  59. 	Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
  60. 	objHTTP.Open "GET", strURL, False
  61. 	objHTTP.SetRequestHeader "User-Agent", strAgent
  62.  
  63. 	On Error Resume Next
  64. 	objHTTP.Send
  65. 	intStatus = objHTTP.Status
  66. 	strResult = Trim( Replace( objHTTP.ResponseText, vbLf, " " ) )
  67. 	On Error Goto 0
  68.  
  69. 	If intStatus = 200 Then
  70. 		RndInt = strResult
  71. 	Else
  72. 		RndInt = "Error (Status " & intStatus & ")"
  73. 	End If
  74.  
  75. 	Set objHTTP = Nothing
  76. End Function
  77.  
  78.  
  79. Function RndIntArr( myMin, myMax, myLength )
  80. ' Retrieves TRUE random integers from http://www.random.org/
  81. '
  82. ' Arguments:
  83. ' myMin     [int]  lowest possible value for the random integer
  84. ' myMax     [int]  highest possible value for the random integer
  85. ' myLength  [int]  the number of random integers that should be retrieved
  86. '
  87. ' Returns:
  88. ' [array of int]   array with the requested number of random integers within
  89. '                  the specified range OR an [array of string] error message
  90. '
  91. ' Note:
  92. ' Read http://www.random.org/quota/ if you intend to use this script often
  93. '
  94. ' Written by Rob van der Woude
  95. ' http://www.robvanderwoude.com
  96. 	Dim arrResult, i, intStatus, objHTTP, strAgent, strResult, strURL
  97.  
  98. 	If Not IsNumeric( myMin ) Then
  99. 		RndInt = "Error (" & myMin & " is not a number)"
  100. 		Exit Function
  101. 	End If
  102.  
  103. 	If Not IsNumeric( myMax ) Then
  104. 		RndInt = "Error (" & myMax & " is not a number)"
  105. 		Exit Function
  106. 	End If
  107.  
  108. 	If Not IsNumeric( myLength ) Then
  109. 		RndInt = "Error (" & myLength & " is not a number)"
  110. 		Exit Function
  111. 	End If
  112.  
  113. 	If Not CInt( myMin ) = myMin Then
  114. 		RndInt = "Error (" & myMin & " is not an integer)"
  115. 		Exit Function
  116. 	End If
  117.  
  118. 	If Not CInt( myMax ) = myMax Then
  119. 		RndInt = "Error (" & myMax & " is not an integer)"
  120. 		Exit Function
  121. 	End If
  122.  
  123. 	If Not Abs( CInt( myLength ) ) = myLength Then
  124. 		RndInt = "Error (" & myLength & " is not an integer)"
  125. 		Exit Function
  126. 	End If
  127.  
  128. 	If myLength < 1 Then
  129. 		RndInt = "Error (" & myLength & " is not a valid number of requests)"
  130. 		Exit Function
  131. 	End If
  132.  
  133. 	strURL   = "http://www.random.org/integers/" _
  134. 	         & "?num=" & myLength _
  135. 	         & "&min=" & myMin _
  136. 	         & "&max=" & myMax _
  137. 	         & "&col=1&base=10&format=plain&rnd=new"
  138. 	strAgent = "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"
  139.  
  140. 	Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
  141. 	objHTTP.Open "GET", strURL, False
  142. 	objHTTP.SetRequestHeader "User-Agent", strAgent
  143.  
  144. 	On Error Resume Next
  145. 	objHTTP.Send
  146. 	intStatus = objHTTP.Status
  147. 	strResult = Trim( Replace( objHTTP.ResponseText, vbLf, " " ) )
  148. 	arrResult = Split( strResult )
  149. 	ReDim Preserve arrResult( myLength - 1 )
  150. 	On Error Goto 0
  151.  
  152. 	If intStatus = 200 Then
  153. 		RndIntArr = arrResult
  154. 	Else
  155. 		RndIntArr = Array( "Error (Status " & intStatus & ")" )
  156. 	End If
  157.  
  158. 	Set objHTTP = Nothing
  159. End Function
  160.  

page last modified: 2024-04-16; loaded in 0.0123 seconds