POSL_Cryption v1.1
Posted: Thu Jan 25, 2007 2:41 pm
Code updated for 5.20+
Easy Text en/decryption. Very fast and safe.
-EDIT-
Chr(10), Chr(13) masking included for FileIO
Easy Text en/decryption. Very fast and safe.
-EDIT-
Chr(10), Chr(13) masking included for FileIO
Code: Select all
; -------------------------------------------------------------------------
; PBOSL_CRYPTION Library For Purebasic v1.2 PB4
;
; (c) 2004-2006 dige
;
; This library is free software; you can redistribute it and/or
; modify it under the terms of the GNU Lesser General Public
; License as published by the Free Software Foundation; either
; version 2.1 of the License, Or (at your option) any later version.
;
; This library is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY Or FITNESS For A PARTICULAR PURPOSE. See the GNU
; Lesser General Public License For more details.
; ------------------------------------------------------------------------
;{ Important informations
; BASED ON:
; - CryptMem ( "Lawineneffekt" Cryption Algorithm ) by Mischa Brandt
; REMARKS:
; This Lib uses a lot of String-Operations.
; So be carefull with Threads
; Keysize for en/decryption have to be more than 24 Bytes!
;}
;{ Procedures Internal
CompilerIf #PB_Compiler_Unicode
CompilerError "only works in ascii mode"
CompilerEndIf
Procedure.l CryptMemory ( *source, ssize.l, *phrase, spsize.l, mode ); Mode 1->Encrypt (+4Bytes); Mode 0->Decrpyt (-4Bytes)
; By Mischa Brandt
If spsize<24 Or ssize <= 0
ProcedureReturn -1
EndIf
If mode=0 : ssize-4 : EndIf
If ssize % 4 : Size = ssize/4 * 4 + 4 : Else : Size = ssize : EndIf
If spsize % 4
krest = spsize % 4
psize = spsize/4 * 4 + 4
Else
psize = spsize
EndIf
If mode : m = 1 : Else : m = -1 : EndIf
orglen = psize/4
Dim target.l(Size/4-1)
If mode
CopyMemory(*source,@target(),ssize)
Else
law = PeekL(*source)
CopyMemory(*source+4,@target(),ssize)
EndIf
Dim key.l(orglen)
Dim lawkey.l(orglen-1)
Dim klength.l(psize-1)
CopyMemory(*phrase,@key(),spsize)
;Letzten Long-Wert vervollständigen, falls erforderlich
If krest
For i=psize-krest To psize-1
PokeB(@key()+i,PeekB(@key()+a)+PeekB(@key()+a+5))
a+5
Next i
EndIf
;Letztes Schlüsselglied ergänzen
For i=0 To orglen-1
key(orglen) + key(i)
Next i
;Höchstes Byte des Schlüssels ermitteln
For i=0 To psize-1
klength(i) = PeekB(@key()+i) & 255
If klength(i) > max
max =klength(i)
EndIf
Next i
;Alles Schlüsselbytes überkreuz verknüpfen
maxbyte=psize-1
For i=0 To psize-1
PokeB(@key()+i,PeekB(@key()+i)+PeekB(@key()+maxbyte))
maxbyte-1
Next i
;Alle Schlüsselbytes entsprechend ihres Wertes verpaaren
For i=0 To psize-1
source.b=PeekB(@key()+i)
targetpos=source + i
If targetpos>psize
targetpos = targetpos % psize
ElseIf targetpos<0
targetpos = psize + (targetpos % psize)
EndIf
If targetpos = psize
targetpos=0
EndIf
target.b=PeekB(@key()+targetpos)
PokeB(@key()+i,source+target)
maxbyte-1
Next i
;Zusätzlichen Checksummenwert berechnen
For i=0 To orglen-1
base+key(i)
Next i
;Schlüssellängen berechnen
norm=1 : ncp = 1
For i=0 To psize-1
kl.f = klength(i)* psize / max
klength(i) = (kl)/4
If last
If klength(i)=lastval
If norm=lastval
norm+ncp
If norm=orglen-1 Or norm=1
ncp * -1
EndIf
klength(i)=norm
Else
klength(i)=norm
EndIf
norm + ncp
If norm=orglen-1 Or norm=1
ncp * -1
EndIf
EndIf
EndIf
If klength(i)=0
klength(i)+1
EndIf
lastval=klength(i)
last=1
Next i
;Alle Startschlüssel-Longwerte mit einem zweiten kombinieren
stop = orglen-1 : mutate = orglen/2
For k=0 To orglen-1
For x=0 To stop
P=mutate:If P=x:P=x+1:EndIf
key(k) + key(P) + base
lawkey(k) = key(k)
mutate-1
If mutate=0
mutate = orglen-1
EndIf
Next x
Next k
;Lawine revers
If mode=0
For k=0 To orglen-1
law = law ! lawkey(k)
Next k
For i=0 To Size/4-1
target(i) = target(i) ! lawkey(fs)
fs+1:If fs=orglen-1:fs=0:EndIf
target(i) = target(i) ! law
Next i
EndIf
;Hauptschleife
stop = psize/2
mutate = orglen/2
For i=0 To Size/4-1
law + target(i)
target(i) - (key(k) + base) * m
k+1
If k>=klength(stop)
k=0:stop-1
If stop=0
stop=psize-1
Else
For x=0 To klength(stop)
P=mutate:If P=x:P=x+1:EndIf
key(x) + key(P)
mutate+1
If mutate=orglen
mutate = 1
EndIf
Next x
EndIf
EndIf
Next i
;Lawine
If mode
For i=0 To Size/4-1
target(i) = target(i) ! law
target(i) = target(i) ! lawkey(fs)
fs+1:If fs=orglen-1:fs=0:EndIf
Next i
For k=0 To orglen-1
law = law ! lawkey(k)
Next k
*newmemory=AllocateMemory(ssize+4)
If *newmemory
PokeL(*newmemory,law)
CopyMemory(@target(),*newmemory+4,ssize)
EndIf
Else
*newmemory = AllocateMemory(ssize)
If *newmemory
CopyMemory(@target(),*newmemory,ssize)
EndIf
EndIf
Dim target.l(0)
Dim key.l(0)
Dim lawkey.l(0)
Dim klength(0)
ProcedureReturn *newmemory
EndProcedure
;}
;{ Procedures External
ProcedureDLL.s DG_MemoryToStr ( *source, ssize ) ; Convert Memory to String
; Convert a range of memory to a save string
; 0 -> \0
; ' -> \1 For SQL Usage
; The worst case (everthing is #NULL) blows up the size to doublesize
Protected Text.s
If ssize > 0
*mem = AllocateMemory( ssize * 2 )
If *mem
*source_end = *source + ssize
*ptr.Byte = *mem - 1
For *a.Byte = *source To *source_end
*ptr + 1
If *a\b = '\' : *ptr\b = '\' : *ptr + 1 : *ptr\b = '\' ; Replace Marker "\" by "\\"
ElseIf *a\b = 0 : *ptr\b = '\' : *ptr + 1 : *ptr\b = '0' ; Terminate #NULL
ElseIf *a\b = 39: *ptr\b = '\' : *ptr + 1 : *ptr\b = '1' ; Make SQL Safe
ElseIf *a\b = 10: *ptr\b = '\' : *ptr + 1 : *ptr\b = '2' ; FileSafe
ElseIf *a\b = 13: *ptr\b = '\' : *ptr + 1 : *ptr\b = '3' ; FileSafe
Else : *ptr\b = *a\b ; Just Copy the Byte
EndIf
Next
; Cut of String at the real end
; *ptr\b = 0
ssize = *ptr - *mem
Text = PeekS(*mem, ssize)
FreeMemory(*mem)
EndIf
EndIf
ProcedureReturn Text
EndProcedure
ProcedureDLL.l DG_StrToMemory ( Text.s, *dest, ssize.l ) ; ReConvert String to Memory
; Daten aus String in Original umwandeln
Protected StrEnde.l
If ssize > 1
*StrEnde = @Text + ssize
*ptr.Byte = *dest - 1
For *a.Byte = @Text To *StrEnde
*ptr + 1
; Search Marker
If *a\b = '\'
If *a < *StrEnde
; Check next Byte
*a + 1
If *a\b = '0'
*ptr\b = 0
ElseIf *a\b = '1'
*ptr\b = 39
ElseIf *a\b = '2'
*ptr\b = 10
ElseIf *a\b = '3'
*ptr\b = 13
ElseIf *a\b = '\'
*ptr\b = '\'
Else
; Unknown Marker!!! should never happen
*ptr\b = *a\b
EndIf
Else
; Simple Copy Byte
*ptr\b = *a\b
EndIf
ElseIf *a < *StrEnde
; Simple Copy Byte
*ptr\b = *a\b
EndIf
Next
ssize = *ptr - *dest
EndIf
ProcedureReturn ssize
EndProcedure
ProcedureDLL.s DG_EnCryptText ( Text.s, key.s ) ; Encrypt String
; Text encryption and convert to string
; Encrypted mem is 4 Bytes longer!
Protected ssize.l, *mem
ssize = Len(Text)
If ssize
*mem = CryptMemory( @Text, ssize, @key, Len(key), #True )
If *mem <> -1
ssize + 4
Text = DG_MemoryToStr ( *mem, ssize )
FreeMemory( *mem )
EndIf
EndIf
ProcedureReturn Text
EndProcedure
ProcedureDLL.s DG_DeCryptText ( Text.s, ssize, key.s ) ; DeCrypt String, ssize = #PB_Any -> Len(Text)
; Convert string to original memory and decrypt
; decrypt memsize is 4 bytes shorter
Protected *mem, *source
If ssize = #PB_Any
ssize = Len(Text)
EndIf
If ssize > 0
*source = AllocateMemory(ssize+1)
If *source
ssize = DG_StrToMemory( Text, *source, ssize )
If ssize > 4
*mem = CryptMemory( *source, ssize, @key, Len(key), #Null )
If *mem <> -1
; 4 Bytes decrease from encryption
ssize - 4
Text = PeekS( *mem, ssize )
FreeMemory( *mem )
EndIf
EndIf
FreeMemory( *source )
EndIf
EndIf
ProcedureReturn Text
EndProcedure
;}
;{ Debug Stuff
dummy.s = "Feel the Pure Power!"
; Keysize must greater than 23 chars!
key.s = RSet ("1234567890", 24)
dummy = DG_EnCryptText( dummy, key )
Debug "Encrypted String: " + dummy
dummy = DG_DeCryptText( dummy, #PB_Any, key )
Debug "Decrypted String: " + dummy
;}