Announcement

**John Gleason** · 23 Sep 2008, 10:42 AM

Rnd2 discussion

Discussion here

**David Roberts** · 6 Oct 2008, 04:46 AM

CryptoRandom: This additional Case for trueRandom.inc requires XP and/or Vista and CC5 and/or PB9.

For comments go to post #32 here.

In the example code above add:

#Include "WIN32API.INC"

In PBMain add:

Let GetCrypto = Class "CCryptoRand"

at the top, and add

GetCrypto = Nothing

at the bottom.

In trueRandom.inc add:

NB: I had (-1), now (6)

Macro CryptoRandom = Rnd2(6)

and then before Function Rnd2 add:

Code:

Global GetCrypto As ICryptoRand
 
Declare Function RtlGenRandom( RandomBuffer As Byte, ByVal RandomBufferLength As Dword ) As Long
 
Type mwcParams
  Mult As Word
  Random As Long
  Carry As Long
End Type
 
Union CryptoBuffer
 sDummy As String * 10
 mwc As mwcParams
End Union
 
Class CCryptoRand
 
  Instance hLib, hProc As Dword
 
  Class Method Create
    hLib = LoadLibrary( "advapi32.dll")
    hProc = GetProcAddress(hLib, "SystemFunction036")
  End Method
 
  Class Method Destroy
    FreeLibrary hLib
  End Method
 
  Interface ICryptoRand: Inherit IUnknown
 
    Method Bytes( x As CryptoBuffer) As Long
      Dim BinaryByte(10) As Byte
      Local BinarySize As Dword
 
      BinarySize = 10
 
      Call Dword hProc Using RtlGenRandom( BinaryByte(0), ByVal BinarySize )
 
      x.sDummy = Peek$( VarPtr( BinaryByte(0) ), BinarySize )
 
    End Method
 
  End Interface
 
End Class

In Function Rnd2 add:

Local Buffer As CryptoBuffer

NB: I had -1, now 6

and add Case 6

Code:

Case 6 ' [B]Was -1[/B]
  oneTime = 1
  GetCrypto.Bytes(Buffer) ' Get 10 cryptographic bytes
  mwcSoph = Peek(Dword, CodePtr(multiplier) + (Buffer.mwc.Mult Mod 384) * 4)
  mwcRandom = Buffer.mwc.Random
  If Abs(mwcRandom) <= 1 Then ' A very rare event
    mwcRandom = Buffer.mwc.Carry ' Try the Carry entry
    If Abs(mwcRandom) <= 1 Then ' Playing hard to get, eh?
      Do
        GetCrypto.Bytes(Buffer) ' Get another set
        mwcRandom = Buffer.mwc.Random
        If Abs(mwcRandom) > 1 Then Exit Loop ' Should be on a winner here
        mwcRandom = Buffer.mwc.Carry ' The odds are getting astronomical now.
      Loop Until Abs(mwcRandom) > 1
    End If
  End If
  mwcCarry = Buffer.mwc.Carry ' May have been ued by mwcRandom, but not a problem
  If (mwcCarry = mwcSoph - 1) Or (mwcCarry = 0) Then ' Less chance than mwcRandom failing
    Do
      GetCrypto.Bytes(Buffer) ' Get another set
      mwcCarry = Buffer.mwc.Random
      If (mwcCarry <> mwcSoph - 1) And (mwcCarry [COLOR="Red"]<>[/COLOR] 0) Then Exit Loop ' > changed to <>
      mwcCarry = Buffer.mwc.Carry
    Loop Until (mwcCarry <> mwcSoph - 1) And (mwcCarry [COLOR="Red"]<>[/COLOR] 0) ' > changed to <>
  End If
  GoSub gsStoreSeq

**David Roberts** · 6 Oct 2008, 02:39 PM

OOPS

CASE -1 changed to CASE 6, there is a CASE <= -1

Thanks to John Gleason for pointed that out to me.

**David Roberts** · 7 Oct 2008, 12:34 PM

CryptoRandom revisited

: This additional Case for trueRandom.inc requires CC5 and/or PB9.

SDK
Client: Included in Windows XP, Windows 2000 Professional, Windows NT Workstation 4.0, Windows Me, Windows 98, Windows 95 OSR2 and later.

In post #3 above replace the Code section headed 'Global GetCrypto As ICryptoRand' with the following - everthing else holds.

Code:

Global GetCrypto As ICryptoRand

Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" _
      ( hProv As Long, zContainer As Asciiz, zProvider As Asciiz, _
         ByVal dwProvType As Dword, ByVal dwFlags As Dword ) As Long
Declare Function CryptReleaseContext Lib "advapi32.dll" Alias "CryptReleaseContext" _
      ( ByVal hProv As Long, ByVal dwFlags As Dword ) As Long
Declare Function CryptGenRandom Lib "advapi32.dll" Alias "CryptGenRandom" _
      ( ByVal hProv As Long, ByVal dwLen As Dword, pbBuffer As Byte) As Long

Type mwcParams
  Mult As Word
  Random As Long
  Carry As Long
End Type

Union CryptoBuffer
 sDummy As String * 10
 mwc As mwcParams
End Union

Class CCryptoRand

  Instance hProv As Dword
  
  Class Method Create
    Local Prov_Rsa_Full, Flags As Dword
    Dim MS_Def_Prov As Asciiz * 50
    
    Prov_Rsa_Full = 1
    Flags = &hF0000000
    MS_Def_Prov = "Microsoft Base Cryptographic Provider v1.0"
    
    CryptAcquireContext( hProv, ByVal %Null, ByVal %Null, Prov_Rsa_Full, Flags )
    CryptAcquireContext( hProv, ByVal %Null, MS_Def_Prov, Prov_Rsa_Full, Flags )
  End Method
  
  Class Method Destroy
    CryptReleaseContext hProv, 0
  End Method
  
  Interface ICryptoRand: Inherit IUnknown
    
    Method Bytes( x As CryptoBuffer) As Long
      Dim BinaryByte(10) As Byte
      Local BinarySize As Dword
      
      BinarySize = 10
      
      CryptGenRandom( ByVal hProv, ByVal BinarySize,  BinaryByte(0))
            
      x.sDummy = Peek$( VarPtr( BinaryByte(0) ), BinarySize )
      
    End Method
    
  End Interface

End Class

Announcement

Forum Guidelines

Rnd2 revisited

Rnd2 revisited

Comment

Comment

Comment

Comment