ETH Zurich, the Swiss university provides a web API to a high resolution Quantum Random Number Generator
See http://qrng.ethz.ch/#welcome-to-quantum-rng-for-openqu
This code populates an array of true random QUADs or EXTs with a single web GET.
'
See http://qrng.ethz.ch/#welcome-to-quantum-rng-for-openqu
This code populates an array of true random QUADs or EXTs with a single web GET.
'
Code:
#COMPILE EXE #DIM ALL #INCLUDE ONCE "WIN32API.INC" GLOBAL extRand() AS EXT GLOBAL qRand() AS QUAD GLOBAL sVals() AS STRING FUNCTION PBMAIN () AS LONG LOCAL qMin,qMax AS QUAD LOCAL qty, x AS LONG LOCAL s AS STRING 'Get some random quads qMin = 1: qMax = 1000: qty = 2000 IF GetRandQuads(qMin,qMax,qty) THEN IF qty > 200 THEN qty = 200 'just show first 200 at most FOR x = 0 TO qty -1 s+= STR$(qRand(x)) NEXT ? s ELSE ? "Problem retrieving Quantum Randon Integers" END IF 'Get some random Exts between 0 and 1 s="" qty = 2000 IF GetRandExts(qty) THEN IF qty > 200 THEN qty = 200 'just show first 200 at most FOR x = 0 TO qty -1 s+= STR$(extRand(x),18) NEXT ? s ELSE ? "Problem retrieving Quantum Random Exts" END IF END FUNCTION FUNCTION GetRandQuads(minval AS QUAD,maxval AS QUAD,qty AS LONG) AS LONG LOCAL v1 AS VARIANT LOCAL v2 AS VARIANT LOCAL v3 AS VARIANT LOCAL vResult AS VARIANT LOCAL vResponse AS VARIANT LOCAL oHttp AS DISPATCH LOCAL sResponse AS STRING LOCAL ResultHeader AS STRING LOCAL x AS LONG ResultHeader = "{""result"":" IF ABS(minval) > 999999999999999 OR ABS(maxval) > 999999999999999 THEN ? "Number out of range. Maximum 15 digits!" EXIT FUNCTION END IF ON ERROR GOTO errtrap 'in case HTTP call fails! SET oHttp = NEWCOM "Msxml2.XMLHTTP" v1 = "GET" v2 = "http://random.openqu.org/api/randint?min=" & FORMAT$(minval) & _ "&max=" & FORMAT$(maxval) & "&size=" & FORMAT$(qty) v3 = 0 OBJECT CALL oHttp.Open(v1, v2, v3) TO vResult OBJECT CALL oHttp.Send(v1) TO vResult OBJECT GET oHttp.Responsetext TO vResponse oHttp = NOTHING sResponse = VARIANT$(vResponse) IF LEFT$ (sResponse,10) = Resultheader THEN sResponse = TRIM$(MID$(sResponse,10),ANY " :{[[]}") REDIM qRand(0 TO qty-1) REDIM sVals(1 TO qty) PARSE sResponse,sVals() FOR x = 1 TO qty qRand(x-1) = VAL(sVals(x)) NEXT RESET sVals() FUNCTION =-1 END IF errtrap: END FUNCTION FUNCTION GetRandExts(qty AS LONG) AS LONG LOCAL v1 AS VARIANT LOCAL v2 AS VARIANT LOCAL v3 AS VARIANT LOCAL vResult AS VARIANT LOCAL vResponse AS VARIANT LOCAL oHttp AS DISPATCH LOCAL sResponse AS STRING LOCAL ResultHeader AS STRING LOCAL x AS LONG ResultHeader = "{""result"":" ON ERROR GOTO errtrap ''in case HTTP call fails! SET oHttp = NEWCOM "Msxml2.XMLHTTP" v1 = "GET" v2 = "http://random.openqu.org/api/rand?size=" & FORMAT$(qty) v3 = 0 OBJECT CALL oHttp.Open(v1, v2, v3) TO vResult OBJECT CALL oHttp.Send(v1) TO vResult OBJECT GET oHttp.Responsetext TO vResponse oHttp = NOTHING sResponse = VARIANT$(vResponse) IF LEFT$ (sResponse,10) = Resultheader THEN sResponse = TRIM$(MID$(sResponse,10),ANY " :{[[]}") REDIM sVals(1 TO qty) REDIM extRand(0 TO qty-1) PARSE sResponse,sVals() FOR x = 1 TO qty extRand(x-1) = VAL(sVals(x)) NEXT RESET sVals() FUNCTION =-1 END IF errtrap: END FUNCTION '
Comment