String Encryption/Decryption

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

String Encryption/Decryption

Post by Guimauve »

Hello Everyone,

This is the modified String Encrytion/Decryption of NicTheQuick original source code. I have made 4 procedures from the original. I hope these procedures will be usefull for someone.

Best Regards
Guimauve

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : String Encryption/Decryption
; File Name : String Encryption-Decryption.pb
; File Version : 1.0.0
; Programmation : OK
; Programmed by : NicTheQuick
; Modified by : Guimauve
; Date : 11-05-2003
; Last Update : 24-05-2010
; Coded for PureBasic : 4.50
; Plateform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  
#ENCRYPTED_STRING_MAX_RND = 5
#ENCRYPTED_STRING_PRESET = 127 
  
Procedure.s StringEncryption(String.s)
  
  Max = Len(String)
  
  For Index = 1 To Max
    
    ASCII.l = Asc(Mid(String, Index, 1)) 
    
    If Index = 1 
      PrevASCII.l = #ENCRYPTED_STRING_PRESET
    Else 
      PrevASCII.l = Asc(Mid(String, Index - 1, 1)) 
    EndIf 
    
    Num_01.l = Random(#ENCRYPTED_STRING_MAX_RND - 1) + 1 
    Num_02.l = (255 + PrevASCII - ASCII) * Num_01 
    Num_01 = (Random(100) * (#ENCRYPTED_STRING_MAX_RND + 1)) + Num_01 
    Value.l = Num_02 + (Num_01 << 16)
    Encrypted.s = Encrypted + RSet(Str(Value), 10, "0") + " "
    
  Next 
  
  ProcedureReturn Encrypted
EndProcedure 
  
Procedure.s StringDecryption(String.s)
  
  StartASCII.l = #ENCRYPTED_STRING_PRESET
  
  Max = CountString(String, " ")
  
  For index = 1 To Max
    
    Value.l = Val(StringField(String, Index, " "))        
    Num_01.l = Value >> 16
    Num_02.l = Value & $FFFF 
    Num_01 = Mod(Num_01, #ENCRYPTED_STRING_MAX_RND + 1) 
    Num_02 = (Num_02 / Num_01) - 255 
    StartASCII - Num_02 
    
    Decrypted.s = Decrypted + Chr(StartASCII) 
    
  Next 
  
  ProcedureReturn Decrypted 
EndProcedure 
  
Procedure WriteEncryptedString(FileID.l, String.s)
  
  Max = Len(String)
  WriteLong(FileID, Max)
  
  For Index = 1 To Max
    
    ASCII.l = Asc(Mid(String, Index, 1)) 
    
    If Index = 1 
      PrevASCII.l = #ENCRYPTED_STRING_PRESET 
    Else 
      PrevASCII.l = Asc(Mid(String, Index - 1, 1)) 
    EndIf 
    
    Num_01.l = Random(#ENCRYPTED_STRING_PRESET - 1) + 1 
    Num_02.l = (255 + PrevASCII - ASCII) * Num_01 
    Num_01 = (Random(100) * (#ENCRYPTED_STRING_PRESET + 1)) + Num_01 
    Value.l = Num_02 + (Num_01 << 16)
    WriteLong(FileID, Value)
    
  Next 
  
EndProcedure 
  
Procedure.s ReadEncryptedString(FileID.l)
  
  StartASCII.l = #ENCRYPTED_STRING_PRESET
  Max = ReadLong(FileID)
  
  For Index = 1 To Max
    
    Value.l = ReadLong(FileID)     
    Num_01.l = Value >> 16
    Num_02.l = Value & $FFFF 
    Num_01 = Mod(Num_01, #ENCRYPTED_STRING_PRESET + 1) 
    Num_02 = (Num_02 / Num_01) - 255 
    StartASCII - Num_02 
    
    Decrypted.s = Decrypted + Chr(StartASCII) 
    
  Next 
  
  ProcedureReturn Decrypted 
EndProcedure 
  
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< !!! WARNING - TESTING CODE !!! <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  
For Index = 1 To 5
  
  Text.s = "Feel The Pure Power !"
  Encrypted.s = StringEncryption(Text)
  Decrypted.s = StringDecryption(Encrypted)
  Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
  Debug "; Test No." + Str(Index)
  Debug ""
  Debug Text 
  Debug Encrypted
  Debug Decrypted
  Debug ""
  
Next 
  
Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
Debug "; Test Write/Read on file"
Debug ""
  
If CreateFile(0, "Testing.dat")
  
  WriteEncryptedString(0, Text)
  
  CloseFile(0)
  
EndIf 
  
If ReadFile(1, "Testing.dat")
  
  Text2.s = ReadEncryptedString(1)
  CloseFile(1)
  
EndIf 
  
Debug Text2
  
; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
Top
Karbon
PureBasic Expert
PureBasic Expert
Posts: 2010
Joined: Mon Jun 02, 2003 1:42 am
Location: Ashland, KY
Contact:
Contact Karbon

Re: String Encryption/Decryption

Post by Karbon »

This is more of an encoding than an encryption since there is no "key" element used in either the encoding or decoding. Not that it matters in practice, it still works if you just want to obscure some text. It's important to note a few things, namely that it isn't string encryption and that it will only work with ASCII text.

Thanks!
-Mitchell
Check out kBilling for all your billing software needs!
http://www.k-billing.com
Code Signing / Authenticode Certificates (Get rid of those Unknown Publisher warnings!)
http://codesigning.ksoftware.net
Top
User avatar
Guimauve
Enthusiast
Enthusiast
Posts: 742
Joined: Wed Oct 22, 2003 2:51 am
Location: Canada

Re: String Encryption/Decryption

Post by Guimauve »

Karbon wrote:This is more of an encoding than an encryption since there is no "key" element used in either the encoding or decoding. Not that it matters in practice, it still works if you just want to obscure some text. It's important to note a few things, namely that it isn't string encryption and that it will only work with ASCII text.

Thanks!
Yes you are right encoding vs encryption but I already have a function set named Write/Right EncodedString() so I need to use a different name for them. But about the Unicode I have tested the functions with ASCII and Unicode compiler option without any problems. If you get an error or if you found a bug it is possible for you to show the evidence here.

Best Regards.
Guimauve
Top
User avatar
utopiomania
Addict
Addict
Posts: 1655
Joined: Tue May 10, 2005 10:00 pm
Location: Norway

Re: String Encryption/Decryption

Post by utopiomania »

Here's another one that works with unicode:

Code: Select all

#PROV_RSA_FULL = 1
#CRYPT_NEWKEYSET = 8 
#CRYPT_EXPORTABLE = 1 
#CALG_MD5 = 4 << 13 | 0 | 3 
#CALG_RC4 = 3 << 13 | 4 << 9 | 1
#MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0" 

procedure encrypt(*mem, length, password$) 
  if cryptAcquireContext_(@hProv, #NULL, #NULL, #PROV_RSA_FULL, 0) = 0 
    cryptAcquireContext_(@hProv, #NULL, #NULL, #PROV_RSA_FULL, #CRYPT_NEWKEYSET) 
  endIf 
  cryptCreateHash_(hProv, #CALG_MD5, 0, 0, @hHash) 
  cryptHashData_(hHash, password$, Len(password$), 0) 
  cryptDeriveKey_(hProv, #CALG_RC4, hHash, #CRYPT_EXPORTABLE, @hKey) 
  cryptEncrypt_(hKey, 0, #TRUE, #NULL, *mem, @length, length) 
  cryptDestroyKey_(hKey) 
  cryptDestroyHash_(hHash) 
  cryptReleaseContext_(hProv, 0) 
endProcedure 

procedure decrypt(*mem, length, password$) 
  if cryptAcquireContext_(@hProv, #NULL, #NULL, #PROV_RSA_FULL, 0) = 0 
    cryptAcquireContext_(@hProv, #NULL, #NULL, #PROV_RSA_FULL, #CRYPT_NEWKEYSET) 
  endIf 
  cryptCreateHash_(hProv, #CALG_MD5, 0, 0, @hHash) 
  cryptHashData_(hHash, password$, len(password$), 0) 
  cryptDeriveKey_(hProv, #CALG_RC4, hHash, #CRYPT_EXPORTABLE, @hKey) 
  cryptDecrypt_(hKey, 0, #TRUE, 0, *mem, @length) 
  cryptDestroyKey_(hKey) 
  cryptDestroyHash_(hHash) 
  cryptReleaseContext_(hProv, 0) 
endProcedure 

e.s = "1089338MSHMFSFSYUS3783264P973AS3M3R8YSN4RTR67NSZ187TS3T170SEMS3298YMYMAY31"
lim = len(e) * 2
*mem = allocateMemory(lim)
*ptr = *mem
copyMemoryString(@e, @*ptr)

debug peekS(*mem)
encrypt(*mem, lim, "abcd")
debug peekS(*mem)
decrypt(*mem, lim, "abcd")
debug peekS(*mem)

end
Top
User avatar
Guimauve
Enthusiast
Enthusiast
Posts: 742
Joined: Wed Oct 22, 2003 2:51 am
Location: Canada

Re: String Encryption/Decryption

Post by Guimauve »

utopiomania wrote:Here's another one that works with unicode:
And Windows Only.

My computers run Ubuntu only. Windows is gone long long time ago !

Anyway thanks, your solution maybe usefull for someone else, I'm sure.

Best regards.
Guimauve
Top
Post Reply

Return to “Tricks 'n' Tips”