ExecFile("http://www.blitzforum.de/posting.php?mode=reply&t=8076")

;generate code
Const max_bytes= 3 ;anzahl der einzukodieren bytes
Const stringsize= 8 ;länge des codierten strings (min. 2 * max_bytes + 2 für checksumwerte)
               ;je grösser der string wird umso unmöglicher wird es einen checksum wert zu erraten,
               ;dafür wird es einfacher für hacker aus der checksum schlau zu werden und eine möglickkeit
               ;zu ersinnen die checksum zu reproduzieren     

Type bytearray     ;in dieses typefield können die werte reingeschrieben werden und übergeben werden
   Field byte[max_bytes]
End Type

;---------------hauptschleife mit zeichen einlesen und ausgeben---------------
;einlesen der werte
bytes_to_code.bytearray= New bytearray

bytes_to_code\byte[1]= Asc( Mid(Input("byte1: "),1,1) )

byte23$= Input("byte2u3: ")

bytes_to_code\byte[2]= Asc( Mid(byte23$,1,1) )
bytes_to_code\byte[3]= Asc( Mid(byte23$,2,1) )


Print "Eingegebene bytes: "

Print Chr(bytes_to_code\byte[1])
Print Chr(bytes_to_code\byte[2])
Print Chr(bytes_to_code\byte[3])

Print "" : Print ""

;generierung des codes
code$= generatecodestring$(bytes_to_code)
Print "generierter code lautet: "+code$

Print "" : Print ""

Repeat
codeeingabe$= Input(" korrekten code eingeben("+stringsize+" Zeichen) :")

If Input= "" End

;decodierung des codes
bytesdecode.bytearray= decodestring(codeeingabe$)

If bytesdecode <> Null
   Print "Code korrekt,die werte lauten: "
   Print Chr(bytesdecode\byte[1])
   Print Chr(bytesdecode\byte[2])
   Print Chr(bytesdecode\byte[3])      
   WaitKey()
   End
Else
   Print "code falsch"
EndIf

Forever

;-------------Hauptschleife ende ; Codegenerierung anfang -----------------;


Function byte_is_writeable(byte)
   ;teste ob das byte eine Zahl oder ein buchstabe ist

   ;entweder grosse od. kleine buchstaben (od. beide) müssen dabeisein
   If byte >= Asc("0") And byte <= Asc("9")  ;ausklammern um zahlen im generierten code zu verbieten
      Return True
   EndIf
   If byte >= Asc("A") And byte <= Asc("Z")  ;ausklammern um grossschreibung im generierten code zu verbieten
      Return True
   EndIf
   If byte >= Asc("a") And byte <= Asc("z")  ;ausklammern um kleinschreibung im generierten code zu verbieten
      Return True
   EndIf
   
   Return False
End Function

Function checkvar$()
   block= Rand(0,2)
   Select block
   Case 0:
      Return Chr(Rand(48,57))
   Case 1:
      Return Chr(Rand(65,90))
   Case 2:
      Return Chr(Rand(97,122))   
   End Select
End Function


Function generatecodestring$(bytes.bytearray)
   Local code$= ""
   Local byte,b,bytecounter



   For b= 0 To max_bytes-1
      byte= bytes\byte[b+1]
      bytecounter= 0
      Repeat
         byte= byte+27
         If byte >=256 byte= byte-256      
         bytecounter= bytecounter+1
      Until byte_is_writeable(byte)
      
      
      bytecounter= bytecounter+64
      code$= code$+ Chr(byte) + Chr(bytecounter)
   Next
   
;----mache eine checksum mit der random funktion-----
   
;erzeuge reproduzierbaren randseed um code wiederherzustellen
   randseed= 0
   For b= 0 To max_bytes-1
      randseed= randseed*1000
      randseed= randseed+ Asc(Mid(code$,1+b*2,1)) + Asc(Mid(code$,2+b*2,1))
   Next
   
   SeedRnd randseed
   
;erzeuge füllwerte
   For b= max_bytes*2 To stringsize-1
      code$= code$+ checkvar$()            
   Next

   Return code$   
End Function


;----------- Codegenerierung ende ; Decodierung anfang ---------------

Function decodestring.bytearray(code$)
   Local bytes.bytearray
;erzeugt ein bytearray type und speichert die im code enthaltenen werte hinein
;bei falschem code wird NULL zurückgegeben




;erzeuge randseed aus dem erhaltenen code um auf korrektheit zu prüfen
   randseed= 0
   For b= 0 To max_bytes-1
      randseed= randseed*1000
      randseed= randseed+ Asc(Mid(code$,1+b*2,1)) + Asc(Mid(code$,2+b*2,1))
   Next
   
   SeedRnd randseed
   
;kontrolliere checkwerte
   For b= max_bytes*2+1 To stringsize
      var$= Mid (code$, b,1)
      var2$= checkvar$()
      If var$ <> var2$
         Return Null
      EndIf            
   Next
   
   
;restauriere bytes
   bytes.bytearray= New bytearray

   For b= 0 To max_bytes-1
      counter= Asc(Mid(code$,b*2+2))-64
      byte= Asc(Mid(code$,b*2+1))
   
      For b2= 1 To counter
         byte= byte-27
         If byte < 0 byte = byte+256      
      Next      
      bytes\byte[b+1]= byte       
   Next
      
   Return bytes
End Function