Deutsch
Forum

Crypto-Programmübertragung scheitert

 
- Seite 1 -



p.specht
Auf der Seite ´Rosetta Code´ "http://rosettacode.org/wiki/Categoryrogramming_Tasks" werden Standardaufgaben der Informatik in den unterschiedlichsten Programmiersprachen gelöst. Ich wollte die sog. ISAAC-Cypher "http://rosettacode.org/wiki/The_ISAAC_Cipher" in XProfan (11.2a free) umsetzen und habe mich dabei eng an die PASCAL-Musterlösung gehalten. Irgendwas geht aber schief: Kodierung und Dekodierung funktionieren sowohl in MOD als auch in XOR-Technik, aaaaaber die verschlüsselten Strings stimmen mit der Pascal-Lösung aus unerfindlichen Gründen nur in den ersten paar Bytes überein.
Anbei der fehlerbehaftete XProfan-Code samt Zusatz-Check auf korrekte Verschlüsselung. Mir steht das Hirn. Bitte hat jemand einen Tipp für mich?
WindowTitle "PROGRAM RosettaIsaac V0.02"
'XProfan 11.2a Version Alpha0.04
Cls
Var iMode&=0
Def &iEncrypt 0
Def &iDecrypt 1
Def &true 1
Def &false 0
// TASK globals
VAR msg$ = "a Top Secret secret"
var key$ = "this is my secret key"
// Main Globals
var  xctx$ = ""// XOR ciphertext
var  mctx$ = ""// MOD ciphertext
var  xptx$ = ""// XOR decryption (plaintext)
var  mptx$ = ""// MOD decryption (plaintext)
// ISAAC var: Isaac acts on globals here
// 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&
'  // DEBUG ONLY
'DECLARE NCOUNT&

PROC ISAAC

    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&=&Loop

        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

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

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 'In XProfan globaly!
    clear aa&,bb&,cc&
    a&=$9e3779b9// the golden ratio
    b&=a&:c&=a&:d&=a&:e&=a&:f&=a&:g&=a&:h&=a&

    Whileloop 0,3// scramble it

        Mix

    Endwhile

    i&=0

    REPEAT// fill in mm[]

        IF flag&// use all the information in the 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 make all of the seed affect all 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[]
            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 in the first set of results
    randcnt&=0// prepare to use the first set of results

Endproc

Proc iSeed :parameters seed$,flag&

    // Seed ISAAC with a given string.
    // The string can be any size. The first 256 values will be used.
    declare i&,m&
    '  whileloop 0,255:i&=&Loop
    '    mm&[i&]=0
    '  endwhile
    mm&[]=0
    m&=Len(seed$)-1

    whileloop 0,255:i&=&Loop

        // in case seed has less than 256 elements

        If i&>m&

            randrsl&[i&]=0
            // Pascal strings are 1-based

        ELSE

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

        Endif

    ENDwhile

    // initialize ISAAC with seed
    iRandInit(flag&)

ENDproc// iSeed

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 iRandom&

Endproc

Proc iRandA// Get a random character in printable ASCII range

    return (iRandom() MOD 95)+32

ENDproc

// Convert an ASCII string to a hexadecimal string

Proc Ascii2Hex :parameters s$

    declare i&,Ascii2Hex$
    Ascii2Hex$=""

    whileloop len(s$):i&=&Loop

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

    endwhile

    return Ascii2Hex$

ENDProc// Ascii2Hex

proc Vernam : parameters msg$

    // XOR encrypt on random stream. Output: ASCII string
    Declare i&,vernam$
    Vernam$=""

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

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

    endwhile

    return vernam$

ENDproc// Vernam

Proc LetterNum :parameters letter$,start$

    // Get position of the letter in chosen alphabet
    return Ord(letter$) - Ord(start$)

ENDproc// LetterNum

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

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

    Declare n&
    Case m& = &iDecrypt: shift& = -shift&
    n& = LetterNum(ch$, start$) + shift&
    n& = n& MOD modulo&
    Case n&<0:n& = n&+modulo&
    return Chr$(Ord(start$) + n&)

ENDproc// Caesar

// Vigenere MOD 95 encryption & decryption. Output: ASCII string

PROC Vigenere :parameters msg$,m&

    Declare i&,Vigenere$
    Vigenere$ = ""

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

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

    endwhile

    return Vigenere$

ENDproc// Vigenere

'Main Program
BEGIN:
// 1) seed ISAAC with the key
iSeed(key$, &true)
// 2) Encryption
// a) XOR (Vernam)
xctx$ = Vernam(msg$)
// b) MOD (Vigenere)
mctx$ = Vigenere(msg$, &iEncrypt)
// 3) Decryption
iSeed(key$, &true)
// a) XOR (Vernam)
xptx$ = Vernam(xctx$)
// b) MOD (Vigenere)
mptx$ = Vigenere(mctx$, &iDecrypt)
// program output
Print
print "Message: ", msg$
print "Key    : ", key$
Print "XOR    : ", Ascii2Hex(xctx$),"  Chk",Ascii2Hex(xctx$)="1C0636190B1260233B35125F1E1D0E2F4C5422"
Print "MOD    : ", Ascii2Hex(mctx$),"  Chk",Ascii2Hex(xctx$)="734270227D36772A783B4F2A5F206266236978"
Print "XOR dcr: ", xptx$
Print "MOD dcr: ", mptx$
waitinput
END
'Check Output:
'
'Message: a Top Secret secret
'Key    : this is my secret key
'XOR    : 1C0636190B1260233B35125F1E1D0E2F4C5422
'MOD    : 734270227D36772A783B4F2A5F206266236978
'XOR dcr: a Top Secret secret
'MOD dcr: a Top Secret secret
'ISAAC stands for "Indirection, Shift, Accumulate, Add, and Count" which are the principal bitwise operations employed.
'To date - and that's after more than 20 years of existence - ISAAC has not been broken (unless GCHQ or NSA did it, but dont tell).
'ISAAC thus deserves a lot more attention than it has received, and it would be salutary to see it more universally implemented.
'If the initial internal state is all zero, after ten calls the values of aa, bb,
'and cc in hexadecimal will be d4d3f473, 902c0691, and 0000000a.
 
So Computer sind halt auch nur Menschen...
18.02.2020  
 



« Dieser Beitrag wurde als Lösung gekennzeichnet. »


p.specht

Geschafft: Die 2. Checksumme stimmte wegen einer falsch benannten Variable nicht. Nun scheint es zu funktionieren - was man allerdings erst nach vielen Tests annehmen kann. Deshalb bleibt die Sache vorläufig im Beta-Stadium. Sollten Fehler auftauchen, bitte hier melden!
Gruss
WindowTitle "PROGRAM RosettaISAAC V2.2-beta"
'(PD) Public Domain, transposed to XProfan-11.2a in
'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 in any way
' you wish, and it is free.  No warrantee."
'-----------------------------------------------------------------------------
'[Rosetta Text:] ISAAC stands for "Indirection, Shift, Accumulate, Add, and Count"
'which are the principal bitwise operations employed. To date - after 24 years of
'existence ISAAC has not been broken (unless GCHQ or NSA did it, but dont tell us).
'ISAAC thus deserves a lot more attention than it has received, and it would be
'salutary to see it 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 &true 1
Def &false 0
// TASK globals
Var msg$ = "a Top Secret secret"// Recommended max 4095 Byte
var key$ = "this is my secret key"// Max. 256 Byte are 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 be globals in 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

    'If the initial internal state is all zero, after ten calls the values of
    'aa, bb, and cc in hexadecimal will be 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&=&Loop

        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

    // Additional: prepare to use the 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 'In XProfan globaly!
    clear aa&,bb&,cc&
    a&=$9e3779b9// the golden ratio
    b&=a&:c&=a&:d&=a&:e&=a&:f&=a&:g&=a&:h&=a&

    Whileloop 0,3// scramble it

        Mix

    Endwhile

    i&=0

    REPEAT// fill in mm[]

        IF flag&// use all the information in the 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 make all of the seed affect all 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[]
            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 in the first set of results
    randcnt&=0// prepare to use the first set of results

Endproc

Proc iSeed :parameters seed$,flag&

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

    Whileloop 0,255:i&=&Loop

        // in case seed has less than 256 elements

        If i&>m&

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

        Else

            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 if(iRandom&<0,iRandom&+2^32,iRandom&*1)'=float

Endproc

Proc iRandA// Get a random character in printable ASCII range

    return intf(modf(iRandom(),95)+32)

ENDproc

// Convert an ASCII string to a hexadecimal string

Proc Ascii2Hex :parameters s$

    Declare i&,Ascii2Hex$
    Ascii2Hex$=""

    Whileloop len(s$):i&=&Loop

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

    Endwhile

    return Ascii2Hex$

EndProc// Ascii2Hex

Proc Vernam :parameters msg$

    // XOR encrypt on random stream. Output: ASCII string
    Declare i&,vernam$
    Vernam$=""

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

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

    endwhile

    return vernam$

Endproc// Vernam

Proc LetterNum :parameters letter$,start$

    // Get position of the letter in chosen alphabet
    return Ord(letter$) - Ord(start$)

Endproc// LetterNum

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

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

    Declare n&
    Case m& = &iDecrypt: shift& = -shift&
    n& = LetterNum(ch$, start$) + shift&
    n& = n& MOD modulo&
    Case n&<0:n& = n&+modulo&
    return Chr$(Ord(start$) + n&)

Endproc// Caesar

// Vigenere MOD 95 encryption & decryption. Output: ASCII string

Proc Vigenere :parameters msg$,m&

    Declare i&,Vigenere$
    Vigenere$ = ""

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

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

    endwhile

    return Vigenere$

Endproc// Vigenere

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

proc sgn :parameters x!

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

endproc

proc floor :parameters x!

    ' Gaussklammer-Funktion
    case abs(x!)<(10^-35):return 0
    case 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: https://de.wikipedia.org/wiki/Modulo
    case abs(x!)<10^-35:return 0
    case 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()
    case abs(x!)<(10^-35):return 0
    case 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)
    case 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
 
So Computer sind halt auch nur Menschen...
21.02.2020  
 




p.specht
Verdacht bestätigt: MOD funktioniert mit negativen Werten, indem es selbst negativ wird. Pascal-MOD arbeitet auf Unsigned-Integers, wird also nie negativ. Mittels einiger Kopfstände geht das nun auch in XProfan (mein MODf() arbeitet auf Floats und wird auch nicht negativ), sodaß zumindest die erste Prüfsumme (die für die XOR-Methode) nun mit der Pascal-Vorlage übereinstimmt.

Bin also weiter am tüfteln...
 
XProfan 11
So Computer sind halt auch nur Menschen...
19.02.2020  
 




Georg
Teles
Super

ich war gerade dabei, den Code durchzuforsten weil meine Materie ist es nicht.
Mein erster Gedanke war auch der MOD.
 
XProfan X2
TC-Programming [...] 
XProfan 10.0 - XProfan X2 - XProfan X3 - XProfan X4
19.02.2020  
 




p.specht

Geschafft: Die 2. Checksumme stimmte wegen einer falsch benannten Variable nicht. Nun scheint es zu funktionieren - was man allerdings erst nach vielen Tests annehmen kann. Deshalb bleibt die Sache vorläufig im Beta-Stadium. Sollten Fehler auftauchen, bitte hier melden!
Gruss
WindowTitle "PROGRAM RosettaISAAC V2.2-beta"
'(PD) Public Domain, transposed to XProfan-11.2a in
'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 in any way
' you wish, and it is free.  No warrantee."
'-----------------------------------------------------------------------------
'[Rosetta Text:] ISAAC stands for "Indirection, Shift, Accumulate, Add, and Count"
'which are the principal bitwise operations employed. To date - after 24 years of
'existence ISAAC has not been broken (unless GCHQ or NSA did it, but dont tell us).
'ISAAC thus deserves a lot more attention than it has received, and it would be
'salutary to see it 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 &true 1
Def &false 0
// TASK globals
Var msg$ = "a Top Secret secret"// Recommended max 4095 Byte
var key$ = "this is my secret key"// Max. 256 Byte are 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 be globals in 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

    'If the initial internal state is all zero, after ten calls the values of
    'aa, bb, and cc in hexadecimal will be 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&=&Loop

        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

    // Additional: prepare to use the 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 'In XProfan globaly!
    clear aa&,bb&,cc&
    a&=$9e3779b9// the golden ratio
    b&=a&:c&=a&:d&=a&:e&=a&:f&=a&:g&=a&:h&=a&

    Whileloop 0,3// scramble it

        Mix

    Endwhile

    i&=0

    REPEAT// fill in mm[]

        IF flag&// use all the information in the 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 make all of the seed affect all 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[]
            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 in the first set of results
    randcnt&=0// prepare to use the first set of results

Endproc

Proc iSeed :parameters seed$,flag&

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

    Whileloop 0,255:i&=&Loop

        // in case seed has less than 256 elements

        If i&>m&

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

        Else

            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 if(iRandom&<0,iRandom&+2^32,iRandom&*1)'=float

Endproc

Proc iRandA// Get a random character in printable ASCII range

    return intf(modf(iRandom(),95)+32)

ENDproc

// Convert an ASCII string to a hexadecimal string

Proc Ascii2Hex :parameters s$

    Declare i&,Ascii2Hex$
    Ascii2Hex$=""

    Whileloop len(s$):i&=&Loop

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

    Endwhile

    return Ascii2Hex$

EndProc// Ascii2Hex

Proc Vernam :parameters msg$

    // XOR encrypt on random stream. Output: ASCII string
    Declare i&,vernam$
    Vernam$=""

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

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

    endwhile

    return vernam$

Endproc// Vernam

Proc LetterNum :parameters letter$,start$

    // Get position of the letter in chosen alphabet
    return Ord(letter$) - Ord(start$)

Endproc// LetterNum

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

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

    Declare n&
    Case m& = &iDecrypt: shift& = -shift&
    n& = LetterNum(ch$, start$) + shift&
    n& = n& MOD modulo&
    Case n&<0:n& = n&+modulo&
    return Chr$(Ord(start$) + n&)

Endproc// Caesar

// Vigenere MOD 95 encryption & decryption. Output: ASCII string

Proc Vigenere :parameters msg$,m&

    Declare i&,Vigenere$
    Vigenere$ = ""

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

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

    endwhile

    return Vigenere$

Endproc// Vigenere

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

proc sgn :parameters x!

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

endproc

proc floor :parameters x!

    ' Gaussklammer-Funktion
    case abs(x!)<(10^-35):return 0
    case 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: https://de.wikipedia.org/wiki/Modulo
    case abs(x!)<10^-35:return 0
    case 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()
    case abs(x!)<(10^-35):return 0
    case 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)
    case 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
 
So Computer sind halt auch nur Menschen...
21.02.2020  
 



Antworten


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

185 Betrachtungen

Unbenanntvor 0 min.
Normann Strübli vor 11 Tagen
Jörg Sellmeyer vor 12 Tagen
Georg Teles vor 13 Tagen
p.specht vor 15 Tagen
Mehr...

Themeninformationen

Dieses Thema hat 2 Teilnehmer:

p.specht (3x)
Georg Teles (1x)


AGB  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Impressum  |  Mart  |  Support  |  Suche

Ein Projekt aller XProfaner, die es gibt!


Mein XProfan
Private Nachrichten
Eigenes Ablageforum
Themen-Merkliste
Eigene Beiträge
Eigene Themen
Zwischenablage
Abmelden
 Deutsch English Français Español Italia
Übersetzungen

Datenschutz


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie