'===========================================================================
' Subject: KEYFILE GENERATOR                  Date: 06-04-93 (23:08)       
'  Author: Rommie Brewer                      Code: QB, QBasic, PDS        
'  Origin: FidoNet QUIK_BAS Echo            Packet: MISC.ABC
'===========================================================================
'   As promised 87 years ago, here is a simple key-file generation
' program.  It is designed to keep honest people honest, as any
' hacker can break it by either breaking the code or patching the
' original program to bypass the registration checking.
'   As written, this will generate a simple key and includes the
' code to check that the key can be decoded.  Several things need
' to be done before it is used in 'real life'.  I'll list them in a
' minute.

' What it does:
'   1 - Generates a key file that includes a CRC check and an
'       embedded registration name and serial number.
'     - The first two lines of this file show the registration
'       name and serial number.  These lines are not used by the
'       program and can be changed without affecting the programs
'       operation as long as total line length is not changed.
'       They are included so you can do a quick check of who that
'       key is for.  This allows you to make several keys at once
'       and then sort out who gets which one (you would need to
'       include a routine to change the key file name after each
'       generation.
'     - The remaining space is filled by randomly generated ASCII
'       characters, with the TIMER function used to seed the random
'       generator.
'     - The display name and serial number are then encrypted and
'       the letters scattered about the random ASCII.
'     - A 16 bit CRC check is performed, and the value is encrypted
'       and and put into an area not included in the CRC check.
'
'   2 - Generates a historical record, with enough information to
'       generate an identical key at a later date. (This prevents a
'       couple of people from registering a program and getting a
'       key, then requesting a replacement key and comparing the
'       differences in order to break the encryption.)
'     - This data includes the registration name, serial number,
'       date the key is generated, and the seed for the random
'       generator.
'
' What it needs to be usable:
'   1 - Better routines for getting the display name and serial
'       number.  I decided to not waste bandwidth on examples that
'       others have already made.
'   2 - Larger areas for the display name and serial number.  I
'       limited these also for space
'   3 - Places for an address in the historical file
'   4 - Routines to compare names and serial numbers for dupes
'   5 - Routine to look through historical file and select one and
'       generate a replacement key based on the information found.
'   6 - A field for different levels of registration.  That is easy
'       to add using the procedures demonstrated.
'   7 - A drop-dead date for temporary keys.  I suggest that the
'       number of days since some arbitrary date be selected as the
'       base date (1 Jan 1900 ??) and then a value be added with
'       the days after the base date as the drop dead date.  Using
'       the same basedate in the generator and the actual program,
'       an imbedded 'total days' number can be made with each temp
'       key.  Use the system date to get 'current total days'.
'       This prevents someone from hacking a new month into the
'       temp key.
'   8 - Change the encryption value of 64 to 'your' value, between
'       64 and 100.
' So, without further comment (HA!), here it is.  Comments?

' Onwards....


'------------------
' generate registration keys for programs

DECLARE FUNCTION crc16% (target$)

' define structure file 1 - which holds your list of past keys
TYPE KeyRecord
   Regno AS STRING * 10
   RegName AS STRING * 30
   Datereg AS STRING * 10
   Rndseed AS LONG
   LnTrn AS STRING * 2

END TYPE
DIM FileBuffer AS KeyRecord
  FileBuffer.LnTrn = CHR$(13) + CHR$(10)
DIM namepoint(20), serpt(20)
namlength = 5
seriallength = 5

' open file 1 as past keys
CLS

GOSUB oldkey

GOSUB getrandseed:  ' get a seed value for the random function

GOSUB opnkey: ' open the new KeyFile.Dat to write in the values

' get display name for key file.  Replace this routine with a better one
INPUT "What display name do you want to use "; Dspnam$
Dspnam$ = LEFT$(Dspnam$ + SPACE$(namlength), seriallength)

' get serial/registration number.  Replace this routine, also.
INPUT "What is the serial number "; srnmbr$
srnmbr$ = LEFT$(srnmbr$ + SPACE$(seriallength), seriallength)

' check on dupes of names and numbers

' get date of registration
   FileBuffer.Datereg = DATE$

' put info into file one and update
   FileBuffer.Regno = srnmb$
   FileBuffer.RegName = Dspnam$
   FileBuffer.Rndseed = rseed
   FileBuffer.LnTrn = CHR$(13) + CHR$(10)
   totrec = totrec + 1
   PUT #1, totrec, FileBuffer
   GET #1, 1, FileBuffer
   FileBuffer.Rndseed = totrec
   PUT #1, 1, FileBuffer


' generate key - file 2

' pad name with spaces to center
   namspac = LEN(Dspnam$)
   namfre = 80 - namspac - 2
   line1$ = SPACE$(namfre / 2) + Dspnam$ + SPACE$(namfre / 2) + CHR$(13) + CHR$(10)
' put in Key File for your info only.  You use to confirm which key you
' are sending to who, by using a doc viewer
LSET fuline$ = line1$
PUT #2, 1

' pad serial with spaces to center
   serspac = LEN(srnmbr$)
   serfre = 80 - serspac - 2
   line2$ = SPACE$(serfre / 2) + srnmbr$ + SPACE$(serfre / 2) + CHR$(13) + CHR$(10)

  ' put in file 2 as second line
LSET fuline$ = line2$
PUT #2, 2

' close out the two lines and re-open data file as 1 byte
GOSUB keyfill

  ' fill file 2 with random values
RANDOMIZE (-rseed)

  FOR x = 161 TO 500
      LSET PtFilr$ = CHR$(RND * 255)
      PUT #2, x
   NEXT x

' read locations for name letters
RESTORE namdatpt

  FOR x = 1 TO namlength
     READ namepoint(x)
  NEXT x

 FOR x = 1 TO namlength
'   convert name digit coded letter
  mp$ = CHR$((ASC(MID$(Dspnam$, x, 1)) + 64))
  LSET PtFilr$ = mp$
   PUT #2, namepoint(x)
 NEXT x

' read location for serial number
RESTORE serldatpt
  FOR x = 1 TO seriallength
    READ serpt(x)
  NEXT x

 FOR x = 1 TO seriallength
   sp$ = CHR$((ASC(MID$(srnmbr$, x, 1)) + 64))
   LSET PtFilr$ = sp$
   PUT #2, serpt(x)
 NEXT x

' calculate the CRC
testcr$ = ""
 FOR x = 161 TO 450
 GET #2, x
 testcr$ = testcr$ + PtFilr$
NEXT x

' calculate the crc, convert to a string so you can hide it
crcnumber = crc16(testcr$)
PRINT "crc checks as "; crcnumber
crcname$ = STR$(crcnumber)
crcname$ = LEFT$(LTRIM$(crcname$) + "aAbBcCdDeEfFgGhHiIjJkKlL", 10)

'PRINT "crc word = "; crcname$; "  and value "; VAL(crcname$)
' put the CRC at point 460 , incrementing the value of each letter
'   so it doesn't stand out as a number
FOR x = 460 TO 469
  LSET PtFilr$ = CHR$(ASC(MID$(crcname$, x - 459, 1)) + 64)
  PUT #2, x
NEXT x

' ----
' This is the part that would be in the program being protected.  It
' is put here to demonstrate the program works.
' The data points and file opening routines would need to be copied,
' also.


' retrieve the stored CRC
rechk$ = ""
FOR x = 460 TO 469
  GET #2, x
  rechk$ = rechk$ + CHR$(ASC(PtFilr$) - 64)
NEXT x
crcchk2 = VAL(rechk$):  ' the stored CRC value


' calculate the CRC
testcr$ = ""
 FOR x = 161 TO 450
 GET #2, x
 testcr$ = testcr$ + PtFilr$
NEXT x
crcnumber = crc16(testcr$)

IF crcchk2 = crcnumber THEN
  PRINT "They match as "; crcnumber
     Dspnam$ = ""
     FOR x = 1 TO namlength
'      convert digit coded letter to name
       GET #2, namepoint(x)
       mp$ = CHR$((ASC(PtFilr$) - 64))
       Dspnam$ = Dspnam$ + mp$
     NEXT x
       PRINT "Display Name is "; Dspnam$

  ELSE PRINT "No Match: something was changed ";
       PRINT crcnumber; " "; crcchk2

END IF

CLOSE
END


oldkey:
CLOSE #1
OPEN "oldkey.dat" FOR RANDOM AS #1 LEN = LEN(FileBuffer)
GET #1, 1, FileBuffer
  ' check if there is a data file.  If not, start one.
  IF INSTR(FileBuffer.Regno, "Start") = 0 THEN
    FileBuffer.Regno = "Start"
    FileBuffer.RegName = "No-Name"
    FileBuffer.Datereg = DATE$
    FileBuffer.Rndseed = 1
    FileBuffer.LnTrn = CHR$(13) + CHR$(10)
    PUT #1, 1, FileBuffer
    totrec = 1
  END IF
totrec = FileBuffer.Rndseed:  ' total registrations on file

RETURN


opnkey: ' open the new key file
CLOSE #2
OPEN "NewKey.DAT" FOR RANDOM AS #2 LEN = 80
  FIELD #2, 80 AS fuline$
RETURN

keyfill:
CLOSE #2
OPEN "NewKey.dat" FOR RANDOM AS #2 LEN = 1
FIELD #2, 1 AS PtFilr$
RETURN



getrandseed: ' get the random seed
rseed = INT(TIMER)
rseed = ABS(rseed)

RETURN

' below are the data areas where you specify the location inside the random
' generated area for the storage of your values.  For demo purposes, I am
' limiting the number of values so it is easy to visually check there are
' not any locations specified twice.  In actual practice, I suggest you
' write a random list - in order - on a piece of paper and scratch the
' values off as you put them here.

namdatpt: ' random data points for the name
DATA 241, 152, 423, 367, 275

serldatpt: ' random locations for the serial number
DATA 342, 467, 199, 300, 400

FUNCTION crc16% (target$)
STATIC Initialized%, CRCTable%()
' 05-25-93  Douglas Lusher  16bit CRC calculation  1:282/7
IF Initialized% GOTO CalcCRC16

REDIM CRCTable%(255)
FOR Ptr% = 0 TO 255
  CRC& = Ptr% * &H100&
  FOR Bit% = 0 TO 7
    Carry% = ((CRC& AND &H8000) <> 0)
    'Carry% is True if Bit 16 is set
    CRC& = (CRC& * 2) AND &HFFFF&
    'shift the low 16 bits one place left
    CRC& = CRC& XOR (Carry% AND &H1021)
    'if there was a carry, then XOR in the bitmask
  NEXT
  CRCTable%(Ptr%) = (CRC& - 32768) XOR &H8000
  'change the long int to an unsigned int for the table
NEXT
Initialized% = -1

CalcCRC16:

HiByte% = 0
LoByte% = 0
FOR Ptr% = 1 TO LEN(target$)
  Char% = ASC(MID$(target$, Ptr%))
  CRC& = CRCTable%(HiByte% XOR Char%) XOR LoByte%
  CRC& = CRC& * &H100
  HiByte% = (CRC& AND &HFF0000) \ &H10000
  LoByte% = ((CRC& AND &HFF00&) - 32768) XOR &H8000
NEXT
crc16% = HiByte% OR LoByte%

END FUNCTION
