PureBoard

Code: Alles auswählen

; -------------------------------------------------------------------------
;     PBOSL_CRYPTION Library For Purebasic v1.1 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
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 Save
        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 = '\'
            *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
;}