@MSGID: <20230801154322.00004c5c@mvps.org.invalid>
203216a7
@REPLY: <20230329124054.000070c5@mvps.org.invalid>
5e27a108
@REPLYADDR ObiWan <obiwan@mvps.org.invalid>
@REPLYTO 2:5075/128 ObiWan
@CHRS: CP866 2
@RFC: 1 0
@RFC-Message-ID:
<20230801154322.00004c5c@mvps.org.invalid>
@RFC-References:
<20230329124054.000070c5@mvps.org.invalid>
@TZUTC: 0200
@TID: FIDOGATE-5.12-ge4e8b94
:: On Wed, 29 Mar 2023 12:40:54 +0200
:: (microsoft.public.vb.general.discussion)
:: <20230329124054.000070c5@mvps.org.invalid>
:: ObiWan <obiwan@mvps.org.invalid> wrote:
 
> 1. call RNGinit with the desired seed
> 
> 2. read each byte "Binp" from the input stream (or block)
> 
> 3. call RNGint(0, 255) to generate a random value "R" between 0 and
> 255
> 
> 4. calculate the outbut byte this way Bout=(Binp Xor R)
> 
> 5. write the output byte "Bout" to its destination (file, network...)

and if one wants to have a robust crypto, use a better random
generator, the one below will fit pretty well, just paste the code
inside a class module and then use the class methods to generate your
random values, basically you`ll do something like

Dim mCRand As CISAAC
Dim alSeed(255) As Long
Dim i As Integer

Set mCRand = New CISAAC
For i=LBound(alSeed) To UBound(alSeed)
 alSeed(i)=
Next i
mCRand.Seed alSeed

and then call mCRand.RandLong or mCRand.RandByte to fetch your random
values and use them to encrypt/decrypt your data using XOR over an
infinitely long random key (from the generator)


Option Explicit

` ====================================================================
` CISAAC.cls :: ISAAC CSPRNG - VB6/VBA implementation
` ====================================================================
` http://burtleburtle.net/bob/rand/isaacafa.html
` https://en.wikipedia.org/wiki/ISAAC (cipher)
` https://rosettacode.org/wiki/The ISAAC Cipher
` ====================================================================


` ===================================================================
` PRIVATE DATA
` ===================================================================

` array sizes
Private Const ST SIZE = 2                 ` state array size
Private Const RM SIZE = 255               ` random pool size
Private Const PW SIZE = 30                ` power table size
Private Const CB SIZE = 3                 ` long to byte array size

` unsigned addition
Private Const MAXLONG        As Long = 2147483647
Private Const MAXLONG NEG    As Double = -2147483648#
Private Const MAXDBL         As Double = 4294967296#

` long value wrapper
Private Type tagLongVal
  lValue                      As Long
End Type

` long to byte array
Private Type tagByteVal
  cbByte(CB SIZE)             As Byte
End Type

Private malState(ST SIZE)     As Long       ` state (0=aa, 1=bb, 2=cc)
Private malMM(RM SIZE)        As Long       ` state table
Private malRandRsl(RM SIZE)   As Long       ` random pool
Private malPwr2(PW SIZE)      As Long       ` bit shift powers table
Private mlPoolIdx             As Long       ` random pool index
Private mtBytes               As tagByteVal ` random bytes (from long)
Private miByteIdx             As Integer    ` random byte index

` ===================================================================
` CLASS INSTANCE
` ===================================================================

` construct
Private Sub Class Initialize()
  ` fill up the powers of 2 table
  Call LoadPower2
End Sub

` destruct
Private Sub Class Terminate()
  Dim i As Long
  
  ` perform memory cleanup
  For i = LBound(malRandRsl) To UBound(malRandRsl)
    malRandRsl(i) = 0
    malMM(i) = 0
    If i <= UBound(malState) Then
      malState(i) = 0
    End If
    If i <= UBound(malPwr2) Then
      malPwr2(i) = 0
    End If
  Next i
  Erase malState
  Erase malRandRsl
  Erase malMM
  Erase malPwr2
  mlPoolIdx = 0
End Sub

` ===================================================================
` PUBLIC CODE
` ===================================================================

` seed ISAAC with the contents of vSeed, the latter may either
` be a string, a byte array or a long array, in either case the
` data is only used up to 256 (long integers) elements
Public Sub Seed(ByRef vSeed As Variant)
  Dim i As Long, l As Long
  Dim cbSeed() As Byte
  
  If VarType(vSeed) = vbString Then
    cbSeed = StrConv(vSeed, vbFromUnicode)
    RandSeed cbSeed
  Else
    RandSeed vSeed
  End If
End Sub

` return the next random value from the
` random pool as a *SIGNED* long value
Public Function RandLong() As Long
  `miByteIdx = -1
  RandLong = NextValue()
End Function

` return the next random value as a byte (0...255)
Public Function RandByte() As Byte
  Dim tLong As tagLongVal
  Dim cbVal As Byte

  ` check if we`ve bytes left
  If miByteIdx < 0 Then
    ` no bytes, repopulate
    tLong.lValue = NextValue()
    LSet mtBytes = tLong
    miByteIdx = CB SIZE
  End If
  ` return next byte from long
  cbVal = mtBytes.cbByte(miByteIdx)
  miByteIdx = miByteIdx - 1
  RandByte = cbVal
End Function

` return the next random byte as a printable char
Public Function RandChar() As Byte
  RandChar = RandByte() Mod 95 + 32
End Function

` ===================================================================
` PRIVATE CODE
` ===================================================================

` seed the RNG using the array
Private Sub RandSeed(ByRef vArr As Variant)
  Dim i As Long, l As Long

  ` fill the seed
  l = UBound(vArr)
  For i = LBound(malMM) To UBound(malMM)
    malMM(i) = 0
    If i > l Then
      malRandRsl(i) = 0
    Else
      malRandRsl(i) = vArr(i)
    End If
  Next
  ` init ISAAC
  Call RandInit(True)
  ` discard the first block to avoid weak states
  mlPoolIdx = UBound(malRandRsl)
End Sub

` initialize or reinitialize the RNG
Private Sub RandInit(ByVal bSeed As Boolean)
    Dim AA As Long, BB As Long, CC As Long, DD As Long
    Dim EE As Long, FF As Long, GG As Long, HH As Long
    Dim intIndex As Integer

    ` internal status
    malState(0) = 0
    malState(1) = 0
    malState(2) = 0
    
    ` golden ratio
    AA = &H9E3779B9
    BB = &H9E3779B9
    CC = &H9E3779B9
    DD = &H9E3779B9
    EE = &H9E3779B9
    FF = &H9E3779B9
    GG = &H9E3779B9
    HH = &H9E3779B9

    ` scramble
    For intIndex = 0 To 3
      Call Mix(AA, BB, CC, DD, EE, FF, GG, GG)
    Next intIndex

    ` seed/reseed the generator
    intIndex = 0
    While intIndex < 256
      If bSeed Then
        AA = uAdd(AA, malRandRsl(intIndex))
        BB = uAdd(BB, malRandRsl(intIndex + 1))
        CC = uAdd(CC, malRandRsl(intIndex + 2))
        DD = uAdd(DD, malRandRsl(intIndex + 3))
        EE = uAdd(EE, malRandRsl(intIndex + 4))
        FF = uAdd(FF, malRandRsl(intIndex + 5))
        GG = uAdd(GG, malRandRsl(intIndex + 6))
        HH = uAdd(HH, malRandRsl(intIndex + 7))
      End If
      Call Mix(AA, BB, CC, DD, EE, FF, GG, HH)
      malMM(intIndex) = AA
      malMM(intIndex + 1) = BB
      malMM(intIndex + 2) = CC
      malMM(intIndex + 3) = DD
      malMM(intIndex + 4) = EE
      malMM(intIndex + 5) = FF
      malMM(intIndex + 6) = GG
      malMM(intIndex + 7) = HH
      intIndex = intIndex + 8
    Wend

    ` reset/fill the mem array
    If bSeed Then
      intIndex = 0
      While intIndex < 256
        AA = uAdd(AA, malMM(intIndex))
        BB = uAdd(BB, malMM(intIndex + 1))
        CC = uAdd(CC, malMM(intIndex + 2))
        DD = uAdd(DD, malMM(intIndex + 3))
        EE = uAdd(EE, malMM(intIndex + 4))
        FF = uAdd(FF, malMM(intIndex + 5))
        GG = uAdd(GG, malMM(intIndex + 6))
        HH = uAdd(HH, malMM(intIndex + 7))
        Call Mix(AA, BB, CC, DD, EE, FF, GG, HH)
        malMM(intIndex) = AA
        malMM(intIndex + 1) = BB
        malMM(intIndex + 2) = CC
        malMM(intIndex + 3) = DD
        malMM(intIndex + 4) = EE
        malMM(intIndex + 5) = FF
        malMM(intIndex + 6) = GG
        malMM(intIndex + 7) = HH
        intIndex = intIndex + 8
      Wend
    End If
    
    ` fill the random pool with data, repeat
    ` the call to discard the first block
    Call ISAAC
    Call ISAAC
    miByteIdx = -1
End Sub

` return next random long from generator
` if pool is empty, calls the generator
` to fill it again with the next batch of
` random numbers
Private Function NextValue() As Long
  Dim lRand As Long
  
  lRand = malRandRsl(mlPoolIdx)
  mlPoolIdx = mlPoolIdx + 1
  If mlPoolIdx > UBound(malRandRsl) Then
    Call ISAAC
    mlPoolIdx = 0
  End If
  NextValue = lRand
End Function

` generate a block of 256 random long values
Private Sub ISAAC()
  Dim intIndex  As Integer
  Dim XX        As Long
  Dim YY        As Long
  Dim SW        As Long

  ` increment at start and once every 256 results
  malState(2) = uAdd(malState(2), 1)
  malState(1) = uAdd(malState(1), malState(2))
  
  ` fill the random pool and update internal state
  For intIndex = 0 To 255
    XX = malMM(intIndex)
    SW = (intIndex Mod 4)
    Select Case SW
      Case 0
        malState(0) = malState(0) Xor ShiftLong(malState(0), 13)
      Case 1
        malState(0) = malState(0) Xor ShiftLong(malState(0), -6)
      Case 2
        malState(0) = malState(0) Xor ShiftLong(malState(0), 2)
      Case 3
        malState(0) = malState(0) Xor ShiftLong(malState(0), -16)
    End Select
    malState(0) = uAdd(malMM((intIndex + 128) Mod 256&), malState(0))
    YY = uAdd(uAdd(malMM(Abs(ShiftLong(XX, -2)) Mod 256&),  
              malState(0)),  
              malState(1))
    malMM(intIndex) = YY
    malState(1) = uAdd(malMM(Abs(ShiftLong(YY, -10)) Mod 256&), XX)
    malRandRsl(intIndex) = malState(1)
  Next intIndex
  
  ` reset pool index
  mlPoolIdx = 0
End Sub

` shuffle values
Private Sub Mix(ByRef AA As Long, ByRef BB As Long, ByRef CC As Long,  
                ByRef DD As Long, ByRef EE As Long, ByRef FF As Long,  
                ByRef GG As Long, ByRef HH As Long)
  AA = AA Xor ShiftLong(BB, 11): DD = uAdd(DD, AA): BB = uAdd(BB, CC)
  BB = BB Xor ShiftLong(CC, -2): EE = uAdd(EE, BB): CC = uAdd(CC, DD)
  CC = CC Xor ShiftLong(DD, 8): FF = uAdd(FF, CC): DD = uAdd(DD, EE)
  DD = DD Xor ShiftLong(EE, -16): GG = uAdd(GG, DD): EE = uAdd(EE, FF)
  EE = EE Xor ShiftLong(FF, 10): HH = uAdd(HH, EE): FF = uAdd(FF, GG)
  FF = FF Xor ShiftLong(GG, -4): AA = uAdd(AA, FF): GG = uAdd(GG, HH)
  GG = GG Xor ShiftLong(HH, 8): BB = uAdd(BB, GG): HH = uAdd(HH, AA)
  HH = HH Xor ShiftLong(AA, -9): CC = uAdd(CC, HH): AA = uAdd(AA, BB)
End Sub

` ::::::::::::::::::::::::::::::::::::::
` UTILITY
` ::::::::::::::::::::::::::::::::::::::

` unsigned long addition
Private Function uAdd(ByVal lngValue1 As Long,  
                      ByVal lngValue2 As Long) As Long
  Dim dblTemp As Double

  dblTemp = CDbl(lngValue1) + CDbl(lngValue2)
  If dblTemp < MAXLONG NEG Then
    uAdd = CLng(MAXDBL + dblTemp)
  Else
    If dblTemp > MAXLONG Then
      uAdd = CLng(dblTemp - MAXDBL)
    Else
      uAdd = CLng(dblTemp)
    End If
  End If
End Function

` left/right shift a long value
Private Function ShiftLong(ByVal lngValue As Long,  
                           ByVal intBitCount As Integer) As Long
  Dim lngMask    As Long
  Dim lngSignBit As Long
         
  If intBitCount <> 0 Then
    Select Case intBitCount
      Case Is < -31
        lngValue = 0
      Case Is > 31
        lngValue = 0
      Case Is > 0
        lngMask = malPwr2(31 - intBitCount)
        lngSignBit = CBool(lngValue And lngMask) And &H80000000
        lngValue = lngValue And (lngMask - 1)
        lngValue = (lngValue * malPwr2(intBitCount)) Or lngSignBit
      Case Is < 0
        intBitCount = Abs(intBitCount)
        lngSignBit = (lngValue < 0) And malPwr2(31 - intBitCount)
        If intBitCount < 31 Then
          lngMask = Not (malPwr2(intBitCount) - 1)
        End If
        lngValue = (lngValue And &H7FFFFFFF) And lngMask
        lngValue = (lngValue \\ malPwr2(intBitCount)) Or lngSignBit
    End Select
  End If
  ShiftLong = lngValue
End Function

` precalculated powers of 2 used for bit shift
Private Sub LoadPower2()
  Dim i As Long, l As Long
  
  For i = LBound(malPwr2) To UBound(malPwr2)
    l = 2 ^ i
    malPwr2(i) = l
  Next i
End Sub


--- FIDOGATE 5.12-ge4e8b94
 * Origin: To protect and to server (2:5075/128)
SEEN-BY: 5001/100 5005/49 5015/255 5019/40 5020/715
848 1042 4441 12000
SEEN-BY: 5030/49 1081 5058/104 5075/128
@PATH: 5075/128 5020/1042 4441