RC4

[thyphoon]

I forget the link !

It's best to stick with original authors if at all possible.

http://www.purebasic.fr/german/viewtopic.php?t=11347

Thanks ! In my code I write "by Frogger" but i forget Frogger is the auhtors ...:p I will be attention last time

[harkon]

Sorry for this long post, but this is pretty much a complete RC4 implementation adapted over the years for the different BASIC compilers I've used. It includes the ability to do strings, binary data, and files

This is the HK_RC4.pbi include file

Code: Select all

;CREDITS
;   originally interpreted by from QB source written by Scott Spiker
;    to QB, VBDOS, VB4, VB6 and then PureBasic by Harold Koenig
;to encrypt/decrypt a string one must first move the string to a *MemoryID
;ie:
; *DatablockID=AllocateMemory(StringByteLength(StringToEncrypt$))
; PokeS(*DatablockID,StringToEncrypt$)
; *EncryptedblockID=Rc4Data(*DatablockID,@EncryptionKey$) ;encryption is done in place so alternatly
;   Rc4Data(*DatablockID,EncryptionKey$) ;once executed the datablock is encrypted in place
;to the *DatablockID needs to be created using AllocateMemory() or ReAllocateMemory()
;
;to encrypt/decrypt file all that is needed are filenames and a key$
;ie:
; Rc4File(SourceFileName$, DestinationFileName$, @EncryptionKey$)
;if SourceFileName$ = DestinationFileName$ then the SourceFile is encrypted/decrypted in place
;
;_ added ability to handle unicode for the key$
;_  the key is translated to ascii value 
;_ In the Rc4File proc:
;_  file/data encoded with unicode disabled will properly decode with unicode enabled
;_  if standard US-keys are used to enter the key$ the opposite will be true as well
;_ In the Rc4Data proc:
;  if a unicode string is encoded it will also be decoded as such, however the data
;_  _should be faithfully encoded and decoded as the original was.
;

;EnableExplicit

Procedure hk_Rc4KeyInit(*Key)

  ;dim swap box and key schedule arrays  
  Global Dim hk_Rc4swap(255)
  Global Dim hk_Rc4key(255)
  
  Protected KeyLen.i
  Protected KeyPtr.w
  Protected index.w
  Protected swapval.w
  Protected byteval.c
  Protected bytesize.w  
  
  bytesize=SizeOf(byteval)  ;accomodates unicode character size in key$ (byteval is type .c
  KeyLen=MemoryStringLength(*Key)*bytesize
  For index=0 To 255
    hk_Rc4swap(index)=index
    byteval=PeekC(*Key+KeyPtr)&$FF ;this gets the 0-255 byte value even if compiled in unicode
    hk_Rc4key(index)=byteval
    KeyPtr+bytesize
    If KeyPtr=KeyLen
      KeyPtr=0
    EndIf
  Next index
    ;initialize swap box with key schedule
  For index=0 To 255
    swapval=(swapval+hk_Rc4swap(index)+hk_Rc4key(index)) % 256
    Swap hk_Rc4swap(index), hk_Rc4swap(swapval)
  Next index
  index=0
  swapval=0
  
  ;clean up memory, we're done with hk_Rc4key()
  For index=0 To 255
    hk_Rc4key(index)=$0
  Next index
  ReDim hk_Rc4key(0)  ;clean up keybox

EndProcedure


Procedure hk_Rc4(*InBuff)
  ;define variables used
  Protected index.w
  Protected swapval.w
  Protected MemLen.i
  Protected MemPtr.i
  Protected inchar.b
  Protected kkey.w
  Protected temp.w 
  
  ;Rc4 Routine
  ;this will encrypt data at *InBuff in place
  MemLen=MemorySize(*InBuff)
  For MemPtr=0 To MemLen-1
    inchar=PeekB(*InBuff+MemPtr)
    index=(index+1) % 256
    swapval=(swapval+hk_Rc4swap(index)) % 256
    Swap hk_Rc4swap(index), hk_Rc4swap(swapval)
    temp=(hk_Rc4swap(index) + hk_Rc4swap(swapval)) % 256
    kkey=hk_Rc4swap(temp)
    PokeB(*InBuff+MemPtr,inchar ! kkey)
  Next MemPtr  
EndProcedure


Procedure hk_Rc4Data(*InBuff,*Key)
  hk_Rc4KeyInit(*Key)
  ;call Rc4 Routine
  ;*InBuff is ciphered in place so no return value is necessary
  hk_Rc4(*InBuff)
EndProcedure


Procedure.w hk_Rc4File(InputFileName.s, OutputFileName.s, *Key)
  Protected *Buffer
  Protected blocksize.w
  Protected sizeread.w
  Protected inplace.w
  Protected Result.w
  Protected filepos_old.q
  Protected filepos_new.q
  Protected infileID.i
  Protected outfileID.i
  
  hk_RC4KeyInit(*Key)
  ;Rc4 Routine
  blocksize=4096  ;defines data block size to read from disk 4096 is a good default
  *Buffer=AllocateMemory(blocksize)
 
  If InputFileName=OutputFileName
    inplace=1
    Else
    inplace=0
  EndIf
  ;if done in place just open one file for read/write
  ; otherwise open source for read and dest for write
  If inplace
    infileID=ReadFile(#PB_Any,InputFileName) ;test if file exists
      If Not infileID
        ProcedureReturn #False
      EndIf
      CloseFile(infileID)
      infileID=OpenFile(#PB_Any,InputFileName)  ;open file for r/w access
      If Not infileID
        ProcedureReturn #False
      EndIf      
    Else
    infileID=ReadFile(#PB_Any,InputFileName)
      If Not infileID
        ProcedureReturn #False
      EndIf
    outfileID= CreateFile(#PB_Any,OutputFileName) 
      If Not outfileID
        ProcedureReturn #False
      EndIf
  EndIf
  
  Repeat
    filepos_old=Loc(infileID)
    sizeread=ReadData(infileID,*Buffer,blocksize)  ;get size amount of data
    filepos_new=Loc(infileID)    
    hk_Rc4(*Buffer)
    If inplace
      FileSeek(infileID,filepos_old)
      WriteData(infileID,*Buffer,sizeread)
      FileSeek(infileID,filepos_new)
      Else
      WriteData(outfileID,*Buffer,sizeread)
    EndIf  
  Until Eof(infileID)
  If infileID
    CloseFile(infileID)
  EndIf
  If outfileID
    CloseFile(outfileID)
  EndIf 
  ProcedureReturn #True
   
EndProcedure

And the test. You can run this in either unicode or not and get the corect result.

Code: Select all

EnableExplicit

IncludeFile "HK_RC4.pbi"


Procedure.w MakeFile(Filename.s)
  Define filelength.i
  Define defaultchar.c
  Define *Buffer
  Define done.w
  Define x.w
  Define sizeleft.q
  
  *Buffer=AllocateMemory(4096)
  defaultchar=Asc("1")
  For x=0 To 4095
    PokeB(*Buffer+x,defaultchar)
  Next x
  
  If Not CreateFile(0,Filename)
    ProcedureReturn 0
  EndIf
  filelength=1000000
  Repeat
    sizeleft=filelength-Loc(0)
    If sizeleft>4096
      WriteData(0,*Buffer,4096)
      Else
      WriteData(0,*Buffer,sizeleft)
      done=1
    EndIf
  Until done
  CloseFile(0)
  ProcedureReturn 1
EndProcedure


Define Filename.s
Define *rc4buffer
Define x.w
Define s.s

Filename="testfile.tst"

If ReadFile(0,Filename)
  Debug "found source file"
  CloseFile(0)
  Else
  If Not Makefile(Filename)
   Debug "Error creating source file"
   End
  EndIf
EndIf

If Not hk_RC4File(Filename,Filename,@"TEST KEY")
  Debug "Encryption went bad"
EndIf

File encryption/decryption can be done either in place where the infile and outfile are the same, or they can be different if rerquired. Data/strings are always encrypted/decrypted in place where the input buffer is the output buffer.

[DoubleDutch]

Thanks!

[harkon]

It is a great pleasure to give back when I can. I hope you find it useful.

[rotacak]

Can someone help me how to use this encoding for string and how to create result to be compatible with hex version? Can be tested there: http://rc4.online-domain-tools.com/

[infratec]

Hi,

I implemented it like written on wikipedia:

Code: Select all

;
; RC4 according to
; https://en.wikipedia.org/wiki/RC4
; 


CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
CompilerEndIf

Global Dim RC4_S.a(255)

Procedure RC4_KeySchedulingAlgorithm(*Key, KeyLen.i)
  
  Protected.a i, j
  
  For i = 0 To 255
    RC4_S(i) = i
  Next i
  
  For i = 0 To 255
    j = (j + RC4_S(i) + PeekA(*key + (i % KeyLen)))
    Swap RC4_S(i), RC4_S(j)
  Next i
  
EndProcedure


; Procedure RC4_PseudoRandomGenerationAlgorithm(*Buff, BuffLen.i)
;   
;   Protected.a i, j, z
;   Protected.i n
;   
;   BuffLen - 1
;   
;   For n = 0 To BuffLen
;     i + 1
;     j + RC4_S(i)
;     Swap RC4_S(i), RC4_S(j)
;     z = RC4_S((RC4_S(i) + RC4_S(j)) & 255)
;     PokeA(*Buff + n, PeekA(*Buff + n) ! z)
;   Next n
;   
; EndProcedure


Procedure RC4_PseudoRandomGenerationAlgorithm(*Buff.Ascii, BuffLen.i)
  
  Protected.a i, j, z
  Protected.i n
  
  BuffLen - 1
  
  For n = 0 To BuffLen
    i + 1
    j + RC4_S(i)
    Swap RC4_S(i), RC4_S(j)
    z = RC4_S((RC4_S(i) + RC4_S(j)) & 255)
    
    ; the following Debug output is labeled 'Keystream' at the wiki page
    ;Debug RSet(Hex(z), 2, "0")
    
    *Buff\a = *Buff\a ! z
    *Buff + 1
  Next n
  
EndProcedure




Procedure RC4(*Data, DataLen.i, *Key, KeyLen.i)
  RC4_KeySchedulingAlgorithm(*Key, KeyLen)
  RC4_PseudoRandomGenerationAlgorithm(*Data, DataLen)
EndProcedure




CompilerIf #PB_Compiler_IsMainFile
  
  Define *Key, *Text, i.i, Cipher$
  
  
  Debug "Key: Key  Plaintext: Plaintext"
  
  *Key = Ascii("Key") ; includes terminating 0
  *Text = Ascii("Plaintext") ; includes terminating 0
  RC4(*Text, MemorySize(*Text) - 1, *Key, MemorySize(*Key) - 1)
  Cipher$ = ""
  For i = 0 To MemorySize(*Text) - 2 ; starting from 0 : -1, terminating 0 : -1 -> - 2
    Cipher$ + RSet(Hex(PeekA(*Text + i)), 2, "0")
  Next i
  Debug Cipher$
  RC4(*Text, MemorySize(*Text) - 1, *Key, MemorySize(*Key) - 1)
  Debug PeekS(*Text, -1, #PB_Ascii)
  Debug ""
  FreeMemory(*Text)
  FreeMemory(*Key)
  
  
  Debug "Key: Wiki  Plaintext: pedia"
 
  *Key = Ascii("Wiki") ; includes terminating 0
  *Text = Ascii("pedia") ; includes terminating 0
  RC4(*Text, MemorySize(*Text) - 1, *Key, MemorySize(*Key) - 1)
  Cipher$ = ""
  For i = 0 To MemorySize(*Text) - 2 ; starting from 0 : -1, terminating 0 : -1 -> - 2
    Cipher$ + RSet(Hex(PeekA(*Text + i)), 2, "0")
  Next i
  Debug Cipher$
  RC4(*Text, MemorySize(*Text) - 1, *Key, MemorySize(*Key) - 1)
  Debug PeekS(*Text, -1, #PB_Ascii)
  Debug ""
  FreeMemory(*Text)
  FreeMemory(*Key)
  
  
  Debug "Key: Secret  Plaintext: Attack at dawn"
 
  *Key = Ascii("Secret") ; includes terminating 0
  *Text = Ascii("Attack at dawn") ; includes terminating 0
  RC4(*Text, MemorySize(*Text) - 1, *Key, MemorySize(*Key) - 1)
  Cipher$ = ""
  For i = 0 To MemorySize(*Text) - 2 ; starting from 0 : -1, terminating 0 : -1 -> - 2
    Cipher$ + RSet(Hex(PeekA(*Text + i)), 2, "0")
  Next i
  Debug Cipher$
  RC4(*Text, MemorySize(*Text) - 1, *Key, MemorySize(*Key) - 1)
  Debug PeekS(*Text, -1, #PB_Ascii)
  Debug ""
  FreeMemory(*Text)
  FreeMemory(*Key)
  
CompilerEndIf

It generates the expected test vectors.

[infratec]

I modified RC4_PseudoRandomGenerationAlgorithm()
Maybe it's a bit faster now.

[rotacak]

Super, thanks!

[rotacak]

infratec: BTW, can you do also reverse way from hexa? For example from this?: *Text = UTF8("45A01F645FC35B383552544B9BF5"). Currently you decoding it from binnary format and hexa is only for viewing but not for decoding.

[infratec]

I don't understand what you want.
You tell that you want to convert string hex bytes, but then you write UTF8(string hex bytes)
which converts each single character to a byte in the buffer.

And all iof this has nothing to do with the RC4 routines.
They simply expects a buffer with data inside. You have to fill the buffer with what you want.

Maybe you want more something like this:

Code: Select all

HexString$ = "45A01F645FC35B383552544B9BF5"

Count = Len(HexString$) / 2
*Buffer = AllocateMemory(Count)
If *Buffer
  For i = 0 To Count
    Byte = Val("$" + Mid(HexString$, i * 2 + 1, 2))
    PokeA(*Buffer + i, Byte)
  Next i
  
  ShowMemoryViewer(*Buffer, Count)
  
  FreeMemory(*Buffer)
EndIf

[rotacak]

Yes, that is what I need, thanks. I using UTF8 instead of Ascii, like that:

Code: Select all

CompilerIf #PB_Compiler_IsMainFile
  
  Define *Key, *Text, i.i, Cipher$, Count, *Buffer, Byte
  
  Debug "Key: Secret  Plaintext: Attack at dawn"
 
  *Key = UTF8("Secret") ; includes terminating 0
  *Text = UTF8("Attack at dawn") ; includes terminating 0
  RC4(*Text, MemorySize(*Text) - 1, *Key, MemorySize(*Key) - 1)
  Cipher$ = ""
  For i = 0 To MemorySize(*Text) - 2 ; starting from 0 : -1, terminating 0 : -1 -> - 2
    Cipher$ + RSet(Hex(PeekA(*Text + i)), 2, "0")
  Next i
  Debug Cipher$
  
  Count = Len(Cipher$) / 2
  *Buffer = AllocateMemory(Count)
  If *Buffer
    For i = 0 To Count
      Byte = Val("$" + Mid(Cipher$, i * 2 + 1, 2))
      PokeA(*Buffer + i, Byte)
    Next i
    
    RC4(*Buffer, MemorySize(*Buffer) - 1, *Key, MemorySize(*Key) - 1)
    Debug "Decoded: " + PeekS(*Buffer, -1, #PB_UTF8)
    
    FreeMemory(*Buffer)
  EndIf

  FreeMemory(*Text)
  FreeMemory(*Key)
  
CompilerEndIf

Result is almost ok, just there is some garbage at the end:

Code: Select all

Decoded: Attack at daw�

What is wrong?

[infratec]

You don't think enough about that what you are doing ...

Code: Select all

RC4(*Buffer, MemorySize(*Buffer), *Key, MemorySize(*Key) - 1)
Debug "Decoded: " + PeekS(*Buffer, -1, #PB_UTF8)