XProfan

Titre de la fenêtre "PROGRAM RosettaISAAC V2.6-beta"
'(PD) Public Domain, transposed to XProfan-11.2a dans
'Feb. 2020 by P.Specht(AT)gmx.at, Vienna/Austria/EU
'-----------------------------------------------------------------------------
'[The Improved] Random Number Generator ISAAC (C) by Bob Jenkins,
' March 1996, Public Domain, C-Source Intro: "You may use this code dans any way
' you wish, and il is free.  No warrantee."
'-----------------------------------------------------------------------------
'[Rosetta Text:] ISAAC stands for "Indirection, Shift, Accumulate, Ajouter, and Count"
'which sont le principal bitwise operations employed. To date - after 24 years of
'existence ISAAC has not been broken (unless GCHQ or NSA did il, but dont tell us).
'ISAAC thus deserves a lot more attention than il has received, and il would être
'salutary to lac il more universally implemented.
'-----------------------------------------------------------------------------
GOTO "FloatMaths"
// uses MODf() on uInt instead of XProfan's MOD Operator
START:
CLS
Var iMode&=0
Def &iEncrypt 0
Def &iDecrypt 1
Def &vrai 1
Def &faux 0
// TASK globals
Var msg$ = "Das est un long Geheimtext avec einer Longueur de len Byte!"'"a Top Secret secret"// Recommended max 4095 Byte
var clé$ = "Goodbye sur Wiedersehen Arrevederci Bonne nuit Tschüss!"'"this is my secret key"// Max. 256 Byte sont used
// Main Globals
var  xctx$ = »
// XOR ciphertext
var  mctx$ = »
// MOD ciphertext
var  xptx$ = »
// XOR decryption (plaintext)
var  mptx$ = »
// MOD decryption (plaintext)
// ISAAC vars have to être globals dans XProfan:
// external results
declare randrsl&[255]
declare randcnt&
// internal state
declare  mm&[255]
declare  aa&,bb&,cc&
// inter proc
declare a&,b&,c&,d&,e&,f&,g&,h&

PROC ISAAC

    // PSEUDO RANDOM GENERATOR
    'Si le initial internal state is espace zero, after ten calls le values of
    'aa, bb, and cc dans hexadecimal veux être d4d3f473, 902c0691, and 0000000a.
    declare i&,x&,y&
    inc cc&// cc just gets incremented once per 256 results
    inc bb&,cc&// then combined with bb

    Whileloop 0,255:i&=&Boucle

        x&=mm&[i&]

        SELECT (i& MOD 4)

            caseof 0:aa&=XOR(aa&,(aa&<<13))

            caseof 1:aa&=XOR(aa&,(aa&>>6))

            caseof 2:aa&=XOR(aa&,(aa&<<2))

            caseof 3:aa&=XOR(aa&,(aa&>>16))

        ENDSELECT

        aa&= mm&[(i&+128) MOD 256]+aa&
        y&= mm&[(x&>>2) MOD 256]+aa&+bb&
        mm&[i&]=y&
        bb&=mm&[(y&>>10) MOD 256]+x&
        randrsl&[i&]=bb&

    Endwhile

    // Additionally  prepare to use le first set of results
    randcnt&=0

ENDPROC

Proc Mix

    a&=XOR(a&,(b&<<11)):inc d&,a&:inc b&,c&
    b&=XOR(b&,(c&>>2)):inc e&,b&:inc c&,d&
    c&=XOR(c&,(d&<<8)):inc f&,c&:inc d&,e&
    d&=XOR(d&,(e&>>16)):inc g&,d&:inc e&,f&
    e&=XOR(e&,(f&<<10)):inc h&,e&:inc f&,g&
    f&=XOR(f&,(g&>>4)):inc a&,f&:inc g&,h&
    g&=XOR(g&,(h&<<8)):inc b&,g&:inc h&,a&
    h&=XOR(h&,(a&>>9)):inc c&,h&:inc a&,b&

ENDPROC

Proc iRandInit :parameters flag&

    declare i&':init a,b,c,d,e,f,g,h 'dans XProfan globaly!
    clear aa&,bb&,cc&
    a&=$9e3779b9// le golden ratio
    b&=a&:c&=a&:d&=a&:e&=a&:f&=a&:g&=a&:h&=a&

    Whileloop 0,3// scramble il

        Mix

    Endwhile

    i&=0

    REPEAT

        // fill dans mm[]

        IF flag&

            // use espace le information dans le seed
            a&=a&+randrsl&[i&]
            b&=b&+randrsl&[i&+1]
            c&=c&+randrsl&[i&+2]
            d&=d&+randrsl&[i&+3]
            e&=e&+randrsl&[i&+4]
            f&=f&+randrsl&[i&+5]
            g&=g&+randrsl&[i&+6]
            h&=h&+randrsl&[i&+7]

        ENDIF

        Mix()
        ' mm[] using a-h
        mm&[i&]=a&
        mm&[i&+1]=b&
        mm&[i&+2]=c&
        mm&[i&+3]=d&
        mm&[i&+4]=e&
        mm&[i&+5]=f&
        mm&[i&+6]=g&
        mm&[i&+7]=h&
        inc i&,8

    UNTIL i& > 255

    IF flag&

        // do a second pass to faire espace of le seed affect espace of mm
        i&=0

        REPEAT

            a&=a&+mm&[i&]
            b&=b&+mm&[i&+1]
            c&=c&+mm&[i&+2]
            d&=d&+mm&[i&+3]
            e&=e&+mm&[i&+4]
            f&=f&+mm&[i&+5]
            g&=g&+mm&[i&+6]
            h&=h&+mm&[i&+7]
            Mix()
            mm&[i&]=a&
            mm&[i&+1]=b&
            mm&[i&+2]=c&
            mm&[i&+3]=d&
            mm&[i&+4]=e&
            mm&[i&+5]=f&
            mm&[i&+6]=g&
            mm&[i&+7]=h&
            inc i&,8

        UNTIL i& > 255

    ENDif

    ISAAC
    // fill dans le first set of results
    randcnt&=0
    // prepare to use le first set of results

ENDPROC

Proc iSeed :parameters seed$,flag&

    // Seed ISAAC with a given string.
    // The string can être any size. The first 256 values veux être used.
    declare i&,m&
    mm&[]=0
    m&=Len(seed$)-1

    Whileloop 0,255:i&=&Boucle

        // dans cas seed has less than 256 elements

        Si i&>m&

            randrsl&[i&]=0
            // Pascal strings sont 1-based, like dans XProfan

        D'autre

            randrsl&[i&]=Ord(mid$(seed$,i&+1,1))

        Endif

    Endwhile

    // initialize ISAAC with seed
    iRandInit(flag&)

ENDPROC

Proc iRandom

    // Get a random 32-bit value 0..MAXINT
    declare iRandom&
    iRandom& = randrsl&[randcnt&]
    inc randcnt&

    IF randcnt&>255

        ISAAC
        randcnt&=0

    ENDif

    return si(iRandom&<0,iRandom&+2^32,iRandom&*1)
    '= float

ENDPROC

Proc iRandA

    // Get a random character dans printable ASCII la gamine
    return intf(modf(iRandom(),95)+32)

ENDproc

Proc Ascii2Hex :parameters s$

    Déclarer i&,Ascii2Hex$
    Ascii2Hex$=»

    Whileloop len($ S):i&=&Boucle

        Ascii2Hex$=Ascii2Hex$+Right$("0"+hex$(Ord(mid$(s$,i&,1))),2)

    Endwhile

    return Ascii2Hex$

ENDPROC

Proc Vernam :parameters msg$

    // XOR encrypt on random stream. Output à ASCII string
    Déclarer i&,vernam$
    Vernam$=»

    whileloop len(msg$) : i&=&Boucle

        Vernam$=Vernam$+Chr$(xor(iRandA(),Ord(mid$(msg$,i&,1))))

    endwhile

    return vernam$

ENDPROC

Proc LetterNum : parameters letter$,start$

    // Get position of le letter dans chosen alphabet
    return Ord(letter$) - Ord(start$)

ENDPROC

// Caesar-shift a character <shift> places by Generalized Vigenere

Proc Caesar : parameters m&,ch$,shift&,modulo&,start$

    Déclarer n&
    Cas m& = &iDecrypt: shift& = -shift&
    n& = LetterNum(ch$, start$) + shift&
    n& = n& MOD modulo&
    Cas n&<0:n& = n&+modulo&
    return Chr$(Ord(start$) + n&)

ENDPROC

// EoCaesar
// Vigenere MOD 95 encryption & decryption. Output à ASCII string

Proc Vigenere

    parameters msg$,m&
    Déclarer i&,Vigenere$
    Vigenere$ = »

    whileloop len(msg$):i&=&Boucle

        Vigenere$ = Vigenere$ + Caesar(m&, mid$(msg$,i&,1), iRandA(), 95, " ")

    endwhile

    return Vigenere$

ENDPROC

BEGIN:
'Main Program
// 1) seed ISAAC with le clé
iSeed(clé$, &vrai)
// 2) Encryption
// a) XOR (Vernam)
xctx$ = Vernam(msg$)
// b) MOD (Vigenere)
mctx$ = Vigenere(msg$, &iEncrypt)
// 3) Decryption
iSeed(clé$, &vrai)
// clé sentence, 0=totally new 1=useAllpreviouseRandoms
// a) XOR (Vernam)
xptx$ = Vernam(xctx$)
// b) MOD (Vigenere)
mptx$ = Vigenere(mctx$, &iDecrypt)
// program output
Imprimer
imprimer "Message: ", msg$
imprimer "Key    : ", clé$
Imprimer "XOR    : ", Ascii2Hex(xctx$)
Imprimer "MOD    : ", Ascii2Hex(mctx$)
Imprimer "XOR dcr: ", xptx$
Imprimer "MOD dcr: ", mptx$
'Check Output:
'Message: a Top Secret secret
'Key    : this is my secret clé
'XOR    : 1C0636190B1260233B35125F1E1D0E2F4C5422
'MOD    : 734270227D36772A783B4F2A5F206266236978
'XOR dcr: a Top Secret secret
'MOD dcr: a Top Secret secret
waitinput
FIN
FloatMaths:

proc sgn :parameters x!

    ' Signum-Funktion: -1,0,+1
    return (x!>0)-(x!<0)

endproc

proc floor :parameters x!

    ' Gaussklammer-Funktion
    cas abs(x!)<(10^-35):return 0
    cas x!>0:return intf(x!)
    return (abs(x!-intf(x!)) < 10^-35)-intf(abs(x!-1))

endproc

proc ceil :parameters x!

    ' Ceiling-Funktion
    return -1*floor(-1*x!)

endproc

proc modf :parameters x!,y!

    ' Q  de.wikipedia.org/wiki/Modulo
    cas abs(x!)<10^-35:return 0
    cas abs(y!)<10^-35:return x!
    return sgn(y!)*abs(x!-y!*floor(x!/y!))

endproc

proc remn :parameters x!,y!

    ' Q: https://de.wikipedia.org/wiki/Modulo = Remnant()
    cas abs(x!)<(10^-35):return 0
    cas abs(y!)<(10^-35):return x!
    return sgn(x!)*abs(x!-y!*floor(x!/y!))

endproc

proc IsNeg :parameters x!

    return byte(Addr(x!),7)&%10000000>>7

endproc

proc frac :parameters x!

    var s!=sgn(x!)
    x!=abs(x!)
    x!=x!-round(x!,0)
    cas x!<0:x!=1+x!
    return s!*x!

endproc

proc intf :parameters x!

    var s!=sgn(x!)
    x!=abs(x!)
    x!=x!-frac(x!)
    return s!*x!

endproc

GOTO "START"
ProgEnd