Code: Select all
#define CrLf Chr(10, 13)
#define enc 1
#define dec -1
' ------------------------------------------------------------
Function KnuthRange( Byval seed As UlongInt, Byref BeenHere As Boolean ) As Ubyte
#define IRange( f, l ) Int( _Rand/2^64*( (l+1) - (f) ) + (f) )
Static As Ulongint _Rand
If BeenHere = False Then
_Rand = seed
BeenHere =True
End If
_Rand = 6364136223846793005ull * _Rand + 1442695040888963407ull
Return IRange(0,255)
End Function
Sub EncDec( Byref message As String, Byval seed as Ulongint, Byval rounds As Ulong, ByVal flag As Long )
Dim As ULong k = Len(message), temp
Dim As Boolean bh
For i As Ulong = 1 to rounds
For j As Ulong = 1 To k
temp = KnuthRange( seed, bh )
message[j-1] = Asc(message, j) + temp*IIf( (temp <= 128), flag, -flag ) ' Random addition/subtraction
Next
Next
End Sub
' ------------------------------------------------------------
' Example usage
Dim s As String
Dim As Double t
s = "The time has come the walrus said" + CrLf
s += "to talk of many things" + CrLf
s += "of shoes, and ships, and sealing wax," + CrLf
s += "of cabbages, and kings," + CrLf
s += "and why the sea is boiling hot," + CrLf
s += "and whether pigs have wings."
Print s + CrLf
t = Timer
EncDec( s, 123456789, 10, enc ) ' Note enc for encryption
t = Timer - t
Print s + CrLf
EncDec( s, 123456789, 10, dec ) ' Note dec for decryption
Print s
Print
Print Int(t*1000000);" microseconds"
Sleep
Code: Select all
''Provoni's original idea for a 3 Step Text Encryption algorithm.
''Transposition first, then xor and substitution.
''It uses 3 key seeds numbers instead of 1: even if the method would be known it
''would be resistant to brute-force attacks if the seeds are long enough.
''Maximum seed for the default FreeBASIC random number generator should be 2^32.
function encrypt(s as string,s1 as double,s2 as double,s3 as double)as string
dim as integer i,j,l=len(s)
dim as integer txt(l-1),key(l-1)
randomize s1
for i=0 to l-1 'make key array with numbers from 0 to length-1
key(i)=i
next i
for i=1 to l*l 'shuffle key order
swap key(int(rnd*l)),key(int(rnd*l))
next i
for i=0 to l-2 step 2 'use key to transpose plaintext
swap s[key(i)],s[key(i+1)]
next i
randomize s2
for i=0 to l-1
s[i]=s[i]xor(int(rnd*31)+1) 'xor step
next i
randomize s3
for i=0 to l-1
s[i]+=int(rnd*10) 'one-time pad style substitution
next i
return s
end function
function decrypt(s as string,s1 as double,s2 as double,s3 as double)as string
dim as integer i,l=len(s)
dim as integer key(l-1)
randomize s3
for i=0 to l-1
s[i]-=int(rnd*10) 'one-time pad style substitution
next i
randomize s2
for i=0 to l-1
s[i]=s[i]xor(int(rnd*31)+1) 'xor step
next i
randomize s1
for i=0 to l-1 'make key array with numbers from 0 to length-1
key(i)=i
next i
for i=1 to l*l 'shuffle key order
swap key(int(rnd*l)),key(int(rnd*l))
next i
for i=0 to l-2 step 2 'use key to transpose plaintext
swap s[key(i)],s[key(i+1)]
next i
return s
end function
'screenres 640,480,32
? encrypt("The age of AI has begun. Transformers: more than meets the eye.",123456789,987654321,123454321)
? decrypt(encrypt("The age of AI has begun. Transformers: more than meets the eye.",123456789,987654321,123454321),123456789,987654321,123454321)
sleep