A simple message encryption algorithm

[mrminecrafttnt]

It uses the timer command to generate the key - no password, only generated the key, i think it should be very easy to extend this..
Without the same key can the message never be decrypted..
The encryption self uses a simple

Code: Select all

char xor int(rnd*256)

here is the source code:

Code: Select all

dim as uinteger key = TIMER * 99999999999999 ' key generation
print "KEY :";KEY
randomize key 'set the key
dim as string message,enc_message

input "ENTER YOUR MESSAGE TO ENCRYPT :";message

'encryption routine
PRINT "*ENCRYPTION*"
enc_message = space(len(message))
for i as integer = 0 to len(message)-1
    enc_message[i] = message[i] xor int(rnd*256)
next
print "ENCRYPTED MESSAGE "
print enc_message
locate csrlin+1

'decryption routine
print "*DECRYPTION*"
Input "Enter the Key :";key
randomize key
message = space(len(enc_message))
for i as integer = 0 to len(message)-1
    message[i] = enc_message[i] xor int(rnd*256)
next

print "DECRYPTED MESSAGE : ";message

sleep

[D.J.Peters]

Only for fun a simple decoder ;-)

NOTE: you have to use dim key as ulong not integer (the key should have the same size on 32 and 64-bit OS !

your key has a linare solution (time) very bad idia and xor char[rnd*256] is a kind of 255 byte lookup tabel
and with OpenCL on a GPU you can test millons of them per second

Joshy

Code: Select all

' use a DVD or server with a large dictionary and a mass of GPU's
label_words:
data "she","the","they" '...
data "doing","done","don't" ' ...
data "write","say","read","swim","drive","eat" '...
data "ever","never","now","tomorrow" '...
data "lamp","light","table","tree" ' ...
data "" ' end of dictionary

dim shared as string dictionary()
dim as integer nWords

restore label_words
dim as string word
read word
while len(word)
  redim preserve dictionary(nWords)
  dictionary(nWords)=word
  nWords+=1
  read word
wend 
nWords-=1

dim as string  enc    = "<n0a–m>ÉHœàܬƒ¶o¤~ëw"
dim as integer nChars = len(enc)
dim as string  dec    = space(nChars)
dim as ulong   key = 3404000000 ' don't wait to long :-)
dim as integer nLoops,nWordsFound
dim as boolean flag,aborted
nChars-=1
print "decode: " & enc
while nWordsfound<3
  flag=true:nWordsfound=0:key+=1
  if key mod 10000=0 then
    print "probe key:" & key
    if asc(inkey())=27 then aborted=true : exit while
  end if 
  randomize key
  for i as integer=0 to nChars
    dec[i]=enc[i] xor int(rnd*256)
    if dec[i]<31 then flag=false
  next
  if flag=true then
    for i as integer = 0 to nWords
      if instr(dec,dictionary(i)) then nWordsFound+=1
    next
  end if 
  nLoops+=1
wend
beep
if aborted then
  print "aborted :-("
else
  print "found something"
  print "loops  : " & nLoops
  print "key    : " & key
  print "decoded: " & dec
end if 
sleep

[deltarho[1859]]

Here is a variation to the opening post.

One of the problems with using a FreeBASIC random number generator is that the secret seed is limited to 2^32 values. In the code below I am using RndMT where the seed is limited to 2^19937 - 1 values.

So that the encrypted message gets displayed without truncation, nulls in the encrypted string, I have used Paul Squires's FF_Remove function.

That 'Iif(RndMTR(0,-1), flag, -flag)' sees RndMTR() either added or subtracted, randomly.

To make life difficult for an attacker we could use seed = "m!/b6=rO?]4N{apju|srfN#>" which has about 157 bits of entropy and problematic for a brute force attack. We won't find "m!/b6=rO?]4N{apju|srfN#>" in a dictionary either.<laugh>

Home brewed encryption can be fun but we should never take it seriously. Encryption is the domain of cryptographers and to be reviewed by cryptanalysis.

Added: I don't need to say this, do I? Seed is to be input by the user and not hard wired as in the code below.

' Compile GUI application

Code: Select all

#include once "windows.bi"
#Include "RndMT.bi"

Declare Sub EncDec( As String, As String, As Long )
Declare Function FF_Remove( As String,  As String ) As String

Dim As String seed, s, displayS
Dim As Long i
       
  
  seed = "I am not young enough to know everything. Oscar Wilde"
  
  s = "1234567890-=!@#$%^&*()_+{}|[]\:;'<>?,./~`qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM"
   
  Messagebox( null, s, "Simple encryption", mb_ok )
  
  ' Encrypt
  EncDec( s, seed, 1 ) ' +1 is for encryption
  displayS = FF_Remove( s, Chr(0) )
  Messagebox( null, displayS, "Simple encryption", mb_ok )
  
  ' Decrypt
  EncDec( s, seed, -1 ) ' -1 is for decryption
  Messagebox( null, s, "Simple encryption", mb_ok )
  
Sub EncDec( message As String, seed As String, flag As Long )
Dim As Long i, j
Dim As Byte Dummy
Dim ptrs as zString Ptr

RandomizeRndMT("seed")

For j = 1 To 100 ' number Of rounds
  ptrs = StrPtr(message)
  For i = 1 To Len(message)
    Dummy = Asc( message, i ) + RndMTR(0,255)*Iif(RndMTR(0,-1), flag, -flag)
    *ptrs = Dummy
    ptrs += 1 
  Next
Next
End Sub

' By Paul Squires
Function FF_Remove( ByRef sMainString   As String, _
                    ByRef sMatchPattern As String _
                    ) As String

    Dim i As Integer 
    Dim s As String 
   
    If Len(sMainString) = 0 Then Return sMainString

    s = sMainString
    Do
        i = Instr(s, sMatchPattern)
        If i > 0 Then 
           s = Left(s, i - 1) & Mid(s, i + Len(sMatchPattern))
        End If   
    Loop Until i = 0
   
    Return s

End Function