key$="Passwort79"



Bank=CreateBank(1024)
PokeByte Bank,0,Asc("T")
PokeByte Bank,1,Asc("e")
PokeByte Bank,2,Asc("s")
PokeByte Bank,3,Asc("t")

Print "-----------------------"

rc4 Bank, key$

Print Chr$(PeekByte(Bank,0))
Print Chr$(PeekByte(Bank,1))
Print Chr$(PeekByte(Bank,2))
Print Chr$(PeekByte(Bank,3))

Print "-----------------------"

rc4 Bank, key$

Print Chr$(PeekByte(Bank,0))
Print Chr$(PeekByte(Bank,1))
Print Chr$(PeekByte(Bank,2))
Print Chr$(PeekByte(Bank,3))
WaitKey



Function rc4(Bank,key$)
 Local sbox[255], keyh[255]
 For i = 0 To 255
  sbox[i] = i : kptr = kptr + 1
  keyh[i] = Asc(Mid$(key$, kptr, 1))
  kptr = kptr Mod Len(key$)
 Next

 For i = 0 To 255
  j = (j + sbox[i] + keyh[i]) Mod 256
  swap = sbox[i] : sbox[i] = sbox[j] : sbox[j] = swap
 Next

 BankLang=BankSize(Bank)-1
 
 For x = 1 To BankLang
  i = x Mod 256
  j = (j + sbox[i]) Mod 256
  PokeByte Bank,X-1,PeekByte(Bank,X-1)Xor sbox[(sbox[i] + sbox[j]) Mod 256]
 Next
End Function

Dim founds2(0)
Dim founds(0)
Dim scanvals4(0)
Dim oldoffset4(0)
Dim founds4(0)
Dim scanvals8(0,1)
Dim oldoffset8(0)
Dim founds8(0)
Dim scanvals16(0,3)
Dim oldoffset16(0)
Dim founds16(0)
Dim scanvals32(0,7)
Dim oldoffset32(0)
Dim founds32(0)

Function CrunchBank(source,dest$,packrate=4)

 ;
 ; Initialisierung.
 ;

 If packrate<1 Then packrate=1
 If packrate>4 Then packrate=4
 ;If packrate=1 Then processbar#=100
 ;If packrate=2 Then processbar#=298.0/10
 ;If packrate=3 Then processbar#=298.0/30
 ;If packrate=4 Then processbar#=298.0/60


 Dim founds2(65535):Dim founds(256)
 Dim scanvals4(1020):Dim oldoffset4(1020):Dim founds4(1020)
 Dim scanvals8(2040,1):Dim oldoffset8(2040):Dim founds8(2040)
 Dim scanvals16(4080,3):Dim oldoffset16(4080):Dim founds16(4080)
 Dim scanvals32(8160,7):Dim oldoffset32(8160):Dim founds32(8160)

 If Lower$(Right$(dest$,4))<>".bbc" Then dest$=dest$+".bbc"


 packs=0
 blocksize=2600
 origoffset=0
 l=BankSize(source)
origsize=l
 If l<blocksize And l>99 Then blocksize=100


 ; Destination File Storen weil offset so gewählt oder File zu klein ist.

 If l<100 Or packrate=1 Then
  neu=WriteFile(dest$)
  WriteInt neu,$00434242
  WriteByte neu,1  ; Packs auf "1"
  WriteInt neu,l   ; Angepasste Blocksize
  WriteInt neu,l   ; Unpacklen
  WriteByte neu,0  ; Ungepackt Speichern
  WriteBytes(source,neu,0,l)
  CloseFile neu
  Return 0
 EndIf




 bnk1=CreateBank(blocksize+3)
 bnk2=CreateBank(blocksize+3)
 scan=CreateBank(127+1) ; max. bis 127
 destbnk=CreateBank(l+100000)
 origbnk=CreateBank(l+100000)

 ; Load the OrigFile into MEMORY!

 CopyBank source,0,origbnk,0,l


 ;
 ; CrunchProzess starten.
 ;

 Repeat ; Packschleife

  packs=packs+1
  l=origsize
  origoffset=0
  destoffset=4
  PokeInt destbnk,0,l
  blocks=l/blocksize:rest=l-(blocks*blocksize)

  For loop=1 To blocks

    CopyBank origbnk,origoffset,bnk1,1,blocksize
    origoffset=origoffset+blocksize

    ;
    ; Scanvalue für aktuellen Block suchen. ($01 - $FF) (Blocksize = 2600 Bytes)
    ;

    scanvalue=256

    Dim founds(256)
    For q=1 To blocksize
      wert=PeekByte(bnk1,q)
      If founds(wert)=0 Then founds(wert)=1
    Next
    For i=1 To 256
      If founds(i)=0:scanvalue=i:Exit:EndIf
    Next

    ;
    ; Häufigst vorkommenden gleichwertigen Bytes suchen. (z.B. $FCE2)
    ;

    lowest=blocksize:nextcheck=0
    bytes=0   ; Bleibt "0" wenn packen des Blocks nicht mehr möglich ist!

    If scanvalue<256

      If packs>14
        packsize=blocksize:summe=0
        Dim founds2(65535)
        For z=1 To blocksize
          bits=PeekShort(bnk1,z)
          founds2(bits)=founds2(bits)+1
          If founds2(bits)>summe:summe=founds2(bits):word=bits:EndIf
          If PeekShort(bnk1,z+1)=bits Then z=z+1
        Next
        If summe>2
          packsize=packsize-(summe*2)+summe
          packsize=packsize+2+2
          If packsize=<lowest
            lowest=packsize
            bytes=2
            nextcheck=1
            PokeShort scan,1,word
          EndIf
        EndIf
      Else
        nextcheck=1
      EndIf

      If nextcheck=1 And packs<15
        packsize=blocksize:summe=0:nextcheck=0
        Dim scanvals4(1020):Dim oldoffset4(1020):Dim founds4(1020)
        For z=1 To blocksize-3
          a=PeekByte(bnk1,z+0):b=PeekByte(bnk1,z+1)
          c=PeekByte(bnk1,z+2):d=PeekByte(bnk1,z+3)
          x=PeekInt(bnk1,z+0)
          tst=0
          chksum=a+b+c+d
          If scanvals4(chksum)=x Then If z>oldoffset4(chksum)+3 Then tst=1
          If scanvals4(chksum)=0 Then If founds4(chksum)=0 Then tst=1
          If tst=1
            founds4(chksum)=founds4(chksum)+1
            scanvals4(chksum)=x:oldoffset4(chksum)=z
            If founds4(chksum)>summe:summe=founds4(chksum):bits=z:EndIf
          EndIf
        Next
        If summe>1
          packsize=packsize-(summe*4)+summe
          packsize=packsize+2+4
          If packsize=<lowest
            lowest=packsize
            bytes=4
            nextcheck=1
            langword1=PeekInt(bnk1,bits)
            PokeInt scan,1,langword1
          EndIf
        EndIf
      EndIf

      If nextcheck=1 And packs<14
        packsize=blocksize:summe=0:nextcheck=0
        Dim scanvals8(2040,1):Dim oldoffset8(2040):Dim founds8(2040)
        For z=1 To blocksize-7
          a=PeekByte(bnk1,z+0):b=PeekByte(bnk1,z+1)
          c=PeekByte(bnk1,z+2):d=PeekByte(bnk1,z+3)
          e=PeekByte(bnk1,z+4):f=PeekByte(bnk1,z+5)
          g=PeekByte(bnk1,z+6):h=PeekByte(bnk1,z+7)
          x=PeekInt(bnk1,z+0):y=PeekInt(bnk1,z+4)
          tst=0
          chksum=a+b+c+d+e+f+g+h
          If scanvals8(chksum,0)=x Then If scanvals8(chksum,1)=y Then If z>oldoffset8(chksum)+7 Then tst=1
          If scanvals8(chksum,0)=0 Then If scanvals8(chksum,1)=0 Then If founds8(chksum)=0 Then tst=1
          If tst=1
            founds8(chksum)=founds8(chksum)+1
            scanvals8(chksum,0)=x:scanvals8(chksum,1)=y:oldoffset8(chksum)=z
            If founds8(chksum)>summe:summe=founds8(chksum):bits=z:EndIf
          EndIf
        Next
        If summe>1
          packsize=packsize-(summe*8)+summe
          packsize=packsize+2+8
          If packsize=<lowest
            lowest=packsize
            bytes=8
            nextcheck=1
            langword1=PeekInt(bnk1,bits+0)
            langword2=PeekInt(bnk1,bits+4)
            PokeInt scan,1,langword1
            PokeInt scan,5,langword2
          EndIf
        EndIf
      EndIf

      If nextcheck=1 And packs<15
        packsize=blocksize:summe=0:nextcheck=0
        Dim scanvals16(4080,3):Dim oldoffset16(4080):Dim founds16(4080)
        For z=1 To blocksize-15
          a=PeekByte(bnk1,z+0):b=PeekByte(bnk1,z+1)
          c=PeekByte(bnk1,z+2):d=PeekByte(bnk1,z+3)
          e=PeekByte(bnk1,z+4):f=PeekByte(bnk1,z+5)
          g=PeekByte(bnk1,z+6):h=PeekByte(bnk1,z+7)
          i=PeekByte(bnk1,z+8):j=PeekByte(bnk1,z+9)
          k=PeekByte(bnk1,z+10):l=PeekByte(bnk1,z+11)
          m=PeekByte(bnk1,z+12):n=PeekByte(bnk1,z+13)
          o=PeekByte(bnk1,z+14):p=PeekByte(bnk1,z+15)
          x=PeekInt(bnk1,z+0):y=PeekInt(bnk1,z+4)
          v=PeekInt(bnk1,z+8):w=PeekInt(bnk1,z+12)
          tst=0
          chksum=a+b+c+d+e+f+g+h+i+j+k+l+m+n+o+p
          If scanvals16(chksum,0)=x Then If scanvals16(chksum,1)=y Then If scanvals16(chksum,2)=v Then If scanvals16(chksum,3)=w Then If z>oldoffset16(chksum)+15 Then tst=1
          If scanvals16(chksum,0)=0 Then If scanvals16(chksum,1)=0 Then If scanvals16(chksum,2)=0 Then If scanvals16(chksum,3)=0 Then If founds16(chksum)=0 Then tst=1
          If tst=1
            founds16(chksum)=founds16(chksum)+1
            scanvals16(chksum,0)=x:scanvals16(chksum,1)=y:scanvals16(chksum,2)=v:scanvals16(chksum,3)=w:oldoffset16(chksum)=z
            If founds16(chksum)>summe:summe=founds16(chksum):bits=z:EndIf
          EndIf
        Next
        If summe>1
          packsize=packsize-(summe*16)+summe
          packsize=packsize+2+16
          If packsize=<lowest
            lowest=packsize
            bytes=16
            nextcheck=1
            langword1=PeekInt(bnk1,bits+0)
            langword2=PeekInt(bnk1,bits+4)
            langword3=PeekInt(bnk1,bits+8)
            langword4=PeekInt(bnk1,bits+12)
            PokeInt scan,1,langword1
            PokeInt scan,5,langword2
            PokeInt scan,9,langword3
            PokeInt scan,13,langword4
          EndIf
        EndIf
      EndIf

      If nextcheck=1 And packs<4
        packsize=blocksize:summe=0:nextcheck=0
        Dim scanvals32(8160,7):Dim oldoffset32(8160):Dim founds32(8160)
        For z=1 To blocksize-31
          a=PeekByte(bnk1,z+0):b=PeekByte(bnk1,z+1)
          c=PeekByte(bnk1,z+2):d=PeekByte(bnk1,z+3)
          e=PeekByte(bnk1,z+4):f=PeekByte(bnk1,z+5)
          g=PeekByte(bnk1,z+6):h=PeekByte(bnk1,z+7)
          i=PeekByte(bnk1,z+8):j=PeekByte(bnk1,z+9)
          k=PeekByte(bnk1,z+10):l=PeekByte(bnk1,z+11)
          m=PeekByte(bnk1,z+12):n=PeekByte(bnk1,z+13)
          o=PeekByte(bnk1,z+14):p=PeekByte(bnk1,z+15)
          a1=PeekByte(bnk1,z+16):b1=PeekByte(bnk1,z+17)
          c1=PeekByte(bnk1,z+18):d1=PeekByte(bnk1,z+19)
          e1=PeekByte(bnk1,z+20):f1=PeekByte(bnk1,z+21)
          g1=PeekByte(bnk1,z+22):h1=PeekByte(bnk1,z+23)
          i1=PeekByte(bnk1,z+24):j1=PeekByte(bnk1,z+25)
          k1=PeekByte(bnk1,z+26):l1=PeekByte(bnk1,z+27)
          m1=PeekByte(bnk1,z+28):n1=PeekByte(bnk1,z+29)
          o1=PeekByte(bnk1,z+30):p1=PeekByte(bnk1,z+31)
          x=PeekInt(bnk1,z+0):y=PeekInt(bnk1,z+4)
          v=PeekInt(bnk1,z+8):w=PeekInt(bnk1,z+12)
          v1=PeekInt(bnk1,z+16):w1=PeekInt(bnk1,z+20)
          v2=PeekInt(bnk1,z+24):w2=PeekInt(bnk1,z+28)
          tst=0
          chksum=a+b+c+d+e+f+g+h+i+j+k+l+m+n+o+p+a1+b1+c1+d1+e1+f1+g1+h1+i1+j1+k1+l1+m1+n1+o1+p1
          If scanvals32(chksum,0)=x Then If scanvals32(chksum,1)=y Then If scanvals32(chksum,2)=v Then If scanvals32(chksum,3)=w
            If scanvals32(chksum,4)=v1 Then If scanvals32(chksum,5)=w1 Then If scanvals32(chksum,6)=v2 Then If scanvals32(chksum,7)=w2
              If z>oldoffset32(chksum)+31 Then tst=1
            EndIf
          EndIf
          If scanvals32(chksum,0)=0 Then If scanvals32(chksum,1)=0 Then If scanvals32(chksum,2)=0 Then If scanvals32(chksum,3)=0
            If scanvals32(chksum,4)=0 Then If scanvals32(chksum,5)=0 Then If scanvals32(chksum,6)=0 Then If scanvals32(chksum,7)=0
              If founds32(chksum)=0 Then tst=1
            EndIf
          EndIf
          If tst=1
            founds32(chksum)=founds32(chksum)+1:oldoffset32(chksum)=z
            scanvals32(chksum,0)=x:scanvals32(chksum,1)=y:scanvals32(chksum,2)=v:scanvals32(chksum,3)=w
            scanvals32(chksum,4)=v1:scanvals32(chksum,5)=w1:scanvals32(chksum,6)=v2:scanvals32(chksum,7)=w2
            If founds32(chksum)>summe:summe=founds32(chksum):bits=z:EndIf
          EndIf
        Next
        If summe>1
          packsize=packsize-(summe*32)+summe
          packsize=packsize+2+32
          If packsize=<lowest
            lowest=packsize
            bytes=32
            nextcheck=1
            langword1=PeekInt(bnk1,bits+0)
            langword2=PeekInt(bnk1,bits+4)
            langword3=PeekInt(bnk1,bits+8)
            langword4=PeekInt(bnk1,bits+12)
            langword5=PeekInt(bnk1,bits+16)
            langword6=PeekInt(bnk1,bits+20)
            langword7=PeekInt(bnk1,bits+24)
            langword8=PeekInt(bnk1,bits+28)
            PokeInt scan,1,langword1
            PokeInt scan,5,langword2
            PokeInt scan,9,langword3
            PokeInt scan,13,langword4
            PokeInt scan,17,langword5
            PokeInt scan,21,langword6
            PokeInt scan,25,langword7
            PokeInt scan,29,langword8
          EndIf
        EndIf
      EndIf

    EndIf

    ;
    ; Mit dem Packen beginnen... (...wenn Packen des Blocks möglich ist)
    ;

    If bytes>0
      pos=0
      For i=1 To blocksize
        result=0
; ------------------------------------------------------------------------
        If i=<blocksize-bytes+1 ; Falls Pack-Schleifen noch möglich sind
          If PeekShort(bnk1,i)=PeekShort(scan,1)
            If bytes=2  ; CompareMemory durchführen!
              result=1
            Else
              result=1
              For z=0 To bytes-1 Step 4
                a=PeekInt(bnk1,i+z)
                b=PeekInt(scan,z+1)
                If a<>b Then result=0:Exit
              Next
            EndIf
            If result ;                Schleife wird gepackt
              i=i+bytes-1:pos=pos+1
              PokeByte bnk2,pos,scanvalue
            EndIf
          EndIf
        EndIf
; ------------------------------------------------------------------------
        If result=0       ; keine schleife, nur 1 Byte decrunchen
          pos=pos+1
          PokeByte bnk2,pos,PeekByte(bnk1,i)
        EndIf
; ------------------------------------------------------------------------
      Next

      PokeByte destbnk,destoffset,scanvalue
      destoffset=destoffset+1
      PokeByte destbnk,destoffset,bytes
      destoffset=destoffset+1
      CopyBank scan,1,destbnk,destoffset,bytes
      destoffset=destoffset+bytes
      CopyBank bnk2,1,destbnk,destoffset,pos ; Gepackten Block Speichern!
      destoffset=destoffset+pos
    EndIf

    If bytes=0
      PokeByte destbnk,destoffset,0
      destoffset=destoffset+1
      CopyBank bnk1,1,destbnk,destoffset,blocksize ; Ungepackten Block Speichern!
      destoffset=destoffset+blocksize
    EndIf

  Next

  If rest>0
    CopyBank origbnk,origoffset,destbnk,destoffset,rest
    destoffset=destoffset+rest
  EndIf

  CopyBank destbnk,0,origbnk,0,destoffset
  x=origsize
  y=destoffset
  origsize=destoffset
  If y>x Or y<blocksize Then Exit
  u#=100
  u#=u#/x
  u#=u#*y
  gain#=100-u#

  If packrate=2 And gain#<10 Then crunchout=crunchout+1;:t#=t#+processbar#
  If packrate=3 And gain#<10 Then crunchout=crunchout+1;:t#=t#+processbar#
  If packrate=4 And gain#<10 Then crunchout=crunchout+1;:t#=t#+processbar#


  If packrate=2 And crunchout=10 Then Exit
  If packrate=3 And crunchout=30 Then Exit
  If packrate=4 And crunchout=60 Then Exit

 Until packs=255

 neu=WriteFile(dest$)
 WriteInt neu,$00434242
 WriteByte neu,packs
 WriteInt neu,blocksize
 WriteBytes(origbnk,neu,0,origsize)
 CloseFile neu
 FreeBank bnk1
 FreeBank bnk2
 FreeBank scan
 FreeBank origbnk
 FreeBank destbnk
End Function

Function SaveBank(Bank,DateiName$)
 FileNr=WriteFile(DateiName$)
 If FileNr=0 Then Return False

 WriteBytes Bank,FileNr,0, BankSize(Bank)

 CloseFile FileNr
 Return True
End Function