Read Write XOR Encoded String - V2.0.0

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
Guimauve
Enthusiast
Enthusiast
Posts: 742
Joined: Wed Oct 22, 2003 2:51 am
Location: Canada

Read Write XOR Encoded String - V2.0.0

Post by Guimauve »

Hello everyone,

Just a tiny XOR Encoded lib. This tiny lib just don't deserve a Nobel price.

Have fun !

Best regards.
Guimauve

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project Name : Read/Write XOR Encoded String
; File Name : Read Write XOR Encoded String.pb
; File version: 1.0.0
; Programmation : OK
; Programmed by : Guimauve
; Date : 11-06-2011
; Update : 11-06-2011
; PureBasic code : 4.60 Beta 3
; Plateform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Macro Looping(P_Number, P_Minimum, P_Maximum)
  
  P_Number = P_Number + 1
  
  If P_Number > P_Maximum
  
    P_Number = P_Minimum
    
  EndIf
 
EndMacro

Procedure.s XOREncodeString(Key.s, Text.s)

  KeyLength = Len(Key)
  TextLength = Len(Text)
  
  For Index = 1 To TextLength
    
    Looping(KeyIndex, 1, KeyLength)
    Encoded.s = Encoded + Chr(Asc(Mid(Text, Index, 1)) ! ~Asc(Mid(Key, KeyIndex, 1)))
    
  Next
  
  ProcedureReturn Encoded
EndProcedure

Procedure WriteXOREncodedString(FileID.l, Key.s, Text.s)

  KeyLength = Len(Key)
  TextLength = Len(Text)
  
  WriteLong(FileID, TextLength)
  
  For Index = 1 To TextLength
    
    Looping(KeyIndex, 1, KeyLength)
    WriteCharacter(FileID, Asc(Mid(Text, Index, 1)) ! ~Asc(Mid(Key, KeyIndex, 1)))
    
  Next

EndProcedure

Procedure.s ReadXOREncodedString(FileID.l, Key.s)

  KeyLength = Len(Key)
  TextLength = ReadLong(FileID)
  
  For Index = 1 To TextLength
    
    Looping(KeyIndex, 1, KeyLength)
    Encoded.s = Encoded + Chr(ReadCharacter(FileID) ! ~Asc(Mid(Key, KeyIndex, 1)))
    
  Next
  
  ProcedureReturn Encoded
EndProcedure

Key.s = "PureBasic 4.60 Beta 3"
Text.s = "I like the super sexy Nordic goddesses !"

Encoded.s = XOREncodeString(Key, Text)
Decoded.s = XOREncodeString(Key, Encoded)

Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Straight String Test"
Debug ""
Debug Text
Debug Encoded
Debug Decoded
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Binary File Test"
Debug "Original : " + Text

If CreateFile(0, "Test.Enc")
  WriteXOREncodedString(0, Key, Text)
  CloseFile(0)
EndIf 

If ReadFile(1, "Test.Enc")
  Debug "From file : " + ReadXOREncodedString(1, Key)
  CloseFile(1)
  DeleteFile("Test.Enc")
EndIf 

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
Last edited by Guimauve on Mon Jun 13, 2011 8:59 pm, edited 1 time in total.
Top
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Read Write XOR Encoded String

Post by netmaestro »

Nice little piece of code and useful for low-risk applications; Thanks for posting!
BERESHEIT
Top
User avatar
Guimauve
Enthusiast
Enthusiast
Posts: 742
Joined: Wed Oct 22, 2003 2:51 am
Location: Canada

Re: Read Write XOR Encoded String

Post by Guimauve »

Hello everyone,

This is the V2.0.0, more safe encoding result and a default Key to solve the problem for the empty Key.

Have fun !

Best regards.
Guimauve

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project Name : Read/Write XOR Encoded String
; File Name : Read Write XOR Encoded String.pb
; File version: 2.0.0
; Programmation : OK
; Programmed by : Guimauve
; Date : 11-06-2011
; Update : 13-06-2011
; PureBasic code : 4.60 Beta 3
; Plateform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure.s XOREncodeString(Key.s, Text.s)
  
  If Key = ""
    Key = "XOREncode"
  EndIf 
  
  KeyLength = Len(Key)
  TextLength = Len(Text)
  
  For TextIndex = 1 To TextLength
    
    For KeyIndex = 1 To KeyLength
      Char.c = Asc(Mid(Text, TextIndex, 1)) ! ~Asc(Mid(Key, KeyIndex, 1))
    Next
    
    Encoded.s = Encoded + Chr(Char)
    
  Next
  
  ProcedureReturn Encoded
EndProcedure

Procedure WriteXOREncodedString(FileID.l, Key.s, Text.s)
  
  If Key = ""
    Key = "XOREncode"
  EndIf 
  
  KeyLength = Len(Key)
  TextLength = Len(Text)
  WriteLong(FileID, TextLength)
  
  For TextIndex = 1 To TextLength

    For KeyIndex = 1 To KeyLength
      Char.c = Asc(Mid(Text, TextIndex, 1)) ! ~Asc(Mid(Key, KeyIndex, 1))
    Next
    
    WriteCharacter(FileID, Char)
    
  Next
  
EndProcedure

Procedure.s ReadXOREncodedString(FileID.l, Key.s)
  
  If Key = ""
    Key = "XOREncode"
  EndIf 
  
  KeyLength = Len(Key)
  TextLength = ReadLong(FileID)
  
  For TextIndex = 1 To TextLength
    
    CharEncoded.c = ReadCharacter(FileID)
    
    For KeyIndex = 1 To KeyLength
      Char.c = CharEncoded ! ~Asc(Mid(Key, KeyIndex, 1))
    Next
    
    Encoded.s = Encoded + Chr(Char)
    
  Next  

  ProcedureReturn Encoded
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
; <<<<< !!! WARNING - YOU ARE NOW IN A TESTING ZONE - WARNING !!! <<<<< 
; <<<<< !!! WARNING - THIS CODE SHOULD BE COMMENTED - WARNING !!! <<<<< 
; <<<<< !!! WARNING - BEFORE THE FINAL COMPILATION. - WARNING !!! <<<<< 
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 

Key.s = "PureBasic 4.60 Beta 3"
Text.s = "I like the super sexy Nordic goddesses !"

Encoded.s = XOREncodeString(Key, Text)
Decoded.s = XOREncodeString(Key, Encoded)

Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Straight String Test"
Debug ""
Debug Text
Debug Encoded
Debug Decoded
Debug ""
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Binary File Test"
Debug "Original : " + Text

If CreateFile(0, "Test.Enc")
  WriteXOREncodedString(0, Key, Text)
  CloseFile(0)
EndIf 

If ReadFile(1, "Test.Enc")
  Debug "From file : " + ReadXOREncodedString(1, Key)
  CloseFile(1)
  DeleteFile("Test.Enc")
EndIf 

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
Top
Post Reply

Return to “Tricks 'n' Tips”