' (C) Harm ten Napel 1993



' Pbasic program DES.BAS  Version 2.00.



' Sample DES (Data Encryption Standard) Power basic program.



' DES.BAS uses the method outlined in "Computer Networks" by A.S. Tanenbaum.

' DES is basically a monoalphabetic substitution cipher using a 64 bit

' character. It has 19 distinct stages. The decryption can be done with

' the same password, the stages must then be carried out in reverse order.

'

' The ciphertext corresponding to the plaintext of 64 zeros and a key of

' 64 zeros is: 8CA64DE9C1B123A7 (hex) (a password with 8 zero bytes is the

' default password).

'

' See book for more details.

'

'

' Warning: US federal regulations prevent non US governement users from

' using the algorithm (which marks this as dubious and all the more funnny).



' Alterations compared with previous DES.BAS / DEDES.BAS.

' No functional changes, this version is slightly faster, partially because

' password conversion from string to array and the initial transposition

' have been removed from the loops and partially because of further speed

' improving which involved rewriting of some code (mainly in f and desalg).



' v.2 further speed improvement through file i/o in 256 byte blocks



' works only on 386 with coprocessor



' june95 : error in transpose corrected which truncated password to 7 bytes

' consequently this latest version is not compatible with previous versions



$CPU 80386

$FLOAT NPX

$OPTIMIZE SPEED

$LIB ALL-

$OPTION CNTLBREAK ON



' Function declarations:



DECLARE FUNCTION MYBIN$ (n%)

' (converts numbers 0 - 255 to 8-character 'binary' string)



DECLARE FUNCTION desalg$ (a$)

' Main algorithm, A$ is 8-byte block of plaintext.



' Three more procedures from Tanenbaums book:



DECLARE SUB f (i%, a%(), x%())

DECLARE SUB transpose (datax%(), T%(), n%)

DECLARE SUB mrotate (keyx%())



DECLARE SUB stob (a$, mbits%())                 'String to array of 64 'bits'.

DECLARE SUB btos (mbits%(), a$)                 'Reverse of stob()

DECLARE SUB letbe (target%(), source%(), LAST%) 'copy procedure

DECLARE SUB init (x() AS INTEGER, n%)           'initialazation of trans-

DECLARE SUB sboxinit (b() AS INTEGER)           'positions and S-boxes.



' Dimension array for the S-Boxes:

DIM s(1 TO 8, 1 TO 64) AS shared INTEGER



' Start initialization:



RESTORE InitialTrl

DIM InitialTr(1 TO 64) AS shared INTEGER

init InitialTr(), 64



RESTORE FinalTrl

DIM FinalTr(1 TO 64) AS shared INTEGER

init FinalTr(), 64



RESTORE swappyl

DIM swappy(1 TO 64) AS shared INTEGER

init swappy(), 64



RESTORE KeyTr1l

DIM KeyTr1(1 TO 56) AS shared INTEGER

init KeyTr1(), 56



RESTORE KeyTr2l

DIM KeyTr2(1 TO 48) AS shared INTEGER

init KeyTr2(), 48



RESTORE etrl

DIM etr(1 TO 48) AS shared INTEGER

init etr(), 48



RESTORE ptrl

DIM ptr(1 TO 32) AS shared INTEGER

init ptr(), 32



sboxinit s()



RESTORE rotsl

DIM rots(1 TO 16) AS shared INTEGER

init rots(), 16



DIM plaintext(1 TO 64) AS shared INTEGER

DIM ciphertext(1 TO 64) AS shared INTEGER



DIM XR(1 TO 56) AS shared INTEGER            'Used in mrotate() procedure.



DIM EF(1 TO 64) AS shared INTEGER            'Three 64 bit vectors used in

DIM ikeyf(1 TO 64) AS shared INTEGER         'procedure f().

DIM yf(1 TO 64) AS shared INTEGER



DIM ades(1 TO 64) AS shared INTEGER          'Three 64 bit vectors for

DIM bdes(1 TO 64) AS shared INTEGER          'temporary storage in main

DIM xdes(1 TO 64) AS shared INTEGER          'function desalg$().



DIM XT(1 TO 64)   AS shared INTEGER          'temporary storage in transpose()



DIM P2(1 TO 64)   AS shared INTEGER          '64 bit vector for password.



main:                                    'Start of program, handles input,

CLS                                      'file handling etc.

RESTORE mynamel

myname$ = ""

FOR n% = 1 TO 23

 READ c%

 myname$ = myname$ + CHR$(c% MOD 128)

NEXT n%

PRINT : PRINT

PRINT "DES data encryption.   Ver. 2.00 (486)", myname$: PRINT

parm$ = ltrim$(rtrim$(COMMAND$))+" "

IF LEN(parm$) > 1 THEN

 Plainf$ = LTRIM$(RTRIM$(LEFT$(parm$, INSTR(parm$, " "))))

 PRINT " Input filename : "; Plainf$

ELSE

INPUT " Input filename : ", plainf$

END IF

if len(plainf$)=0 then

 print : print "Error, enter a DOS compatible filename."

 system

end if

OPEN plainf$ FOR RANDOM AS 1

lof1& = LOF(1)

IF lof1& = 0 THEN

 CLOSE #1

 KILL plainf$

 PRINT : PRINT "Input file does not exist, program aborted.";

 SYSTEM

ELSE

 IF lof1& > 9999999 THEN PRINT : PRINT "Inputfile too big, program aborted.": SYSTEM

 CLOSE #1

 OPEN plainf$ for binary access read as #1

END IF



cipherf$ = ""

sp0% = 0: sp% = 0

DO

 sp0% = sp%

 sp% = INSTR(sp% + 1, plainf$, "\")

LOOP WHILE sp% > 0

bplainf$ = RIGHT$(plainf$, LEN(plainf$) - (sp0%))

PRINT "Filename stored : "; bplainf$

pp% = INSTR(sp0% + 1, plainf$, ".")

IF pp% = 0 THEN

 dcipherf$ = plainf$ + ".DES"

ELSE

 dcipherf$ = LEFT$(plainf$, pp% - 1) + ".DES"

END IF

PRINT "        Default : "; dcipherf$

INPUT "Output filename : ", cipherf$

IF cipherf$ = "" THEN cipherf$ = dcipherf$

OPEN cipherf$ FOR RANDOM AS 2

IF LOF(2) > 0 THEN

 CLOSE #2

 PRINT : PRINT "Output file already exists, program aborted."

 SYSTEM

ELSE

 CLOSE #2

 OPEN cipherf$ FOR binary AS 2

END IF



PW$ = ""

LOCATE 9, 1

INPUT ; "       Password : ", PW$

LOCATE 9, 8: PRINT "Password : "; STRING$(8, 15); STRING$(10, " ")

IF (LEN(PW$) < 8) THEN PW$ = PW$ + STRING$(8 - LEN(PW$), 0)

PW$ = LEFT$(PW$, 8)



stob PW$, P2()

transpose P2(), KeyTr1(), 56     'Mix up key and reduce to 56 bits.

ciphertekst$ = ""

blocks& = lof1& \ 256



'Create a random string with upper ASCII values.



w = RND(-INT(TIMER))

anything$ = ""

FOR i% = 1 TO 12

 anything$ = anything$ + CHR$(128 + INT(127 * RND(1)))

NEXT i%



'Definition of header, see also comment below.

'Sourcefile length and name encoded in three 8 bit blocks into encoded file,

'avoid known plaintext game by adding some random characters.



header$ = "#" + LTRIM$(STR$(lof1&))

header$ = "DES" + LEFT$(anything$, 8 - LEN(header$)) + header$

header$ = header$ + RIGHT$(anything$, 12 - LEN(bplainf$)) + "#" + bplainf$



cheader$=desalg$(left$(header$,8))+desalg$(MID$(header$,9,8))+desalg$(right$(header$,8))



put$ #2, cheader$



'Here the main encryption starts, dividing

'the input file in 8 character blocks

'and encrypting them one by one.



LOCATE 10, 8:  PRINT ; "Progress :   0 %";



inblock$=space$(256)



FOR n& = 1 TO blocks&

 get$ #1,256,inblock$

 outblock$=""

  for b%=1 to 256 step 8

   outblock$ = outblock$+desalg$(mid$(inblock$,b%,8))

  next    

  Put$ #2, outblock$

  LOCATE 10, 19: PRINT ; USING "###"; (n& / blocks&) * 100;

NEXT n&



rest1 = lof1& MOD 256

rest2 = lof1& MOD 8

rest  = rest1-rest2



IF rest1 > 0 THEN

 outblock$=""

 get$ #1,rest1,inblock$

 if rest2 > 0 then

  inblock$=inblock$+left$(anything$,(8-rest2))

 end if

 for b%=1 to len(inblock$) step 8

  outblock$ = outblock$+desalg$(mid$(inblock$,b%,8))

 next    

 Put$ #2, outblock$

END IF



CLOSE

LOCATE 10, 19: PRINT "100 %  Ready"

PRINT : PRINT "DES encryption succesfully completed, returning to system."

PRINT

SYSTEM



'                 Important notes for Decryption.

'

' Note that random characters are added to the inputfile to make the last

' block of 64 bits complete, how this problem is generally solved is unclear,

' the decryption algorithm must take into account any such non standard

' additions to create a usable encryption / decryption scheme.

' Here the Header consists of 24 bytes of encoded information

' which decoded is: DES???#<lenght>???#<filename>.

' ??? are ASCII characters above 128 so lenght and original filename can

' be recovered easily by the decription algorithm. With lenght known the

' random characters possibly added can simply be neglected.





' Standard values to initialize the tables:



InitialTrl:

DATA 58,50,42,34,26,18,10,02,60,52,44,36,28,20,12,04

DATA 62,54,46,38,30,22,14,06,64,56,48,40,32,24,16,08

DATA 57,49,41,33,25,17,09,01,59,51,43,35,27,19,11,03

DATA 61,53,45,37,29,21,13,05,63,55,47,39,31,23,15,07



FinalTrl:

DATA 40,08,48,16,56,24,64,32,39,07,47,15,55,23,63,31

DATA 38,06,46,14,54,22,62,30,37,05,45,13,53,21,61,29

DATA 36,04,44,12,52,20,60,28,35,03,43,11,51,19,59,27

DATA 34,02,42,10,50,18,58,26,33,01,41,09,49,17,57,25



swappyl:

DATA 33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48

DATA 49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64

DATA 01,02,03,04,05,06,07,08,09,10,11,12,13,14,15,16

DATA 17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32



KeyTr1l:

DATA 57,49,41,33,25,17,09,01,58,50,42,34,26,18,10,02

DATA 59,51,43,35,27,19,11,03,60,52,44,36

DATA 63,55,47,39,31,23,15,07,62,54,46,38,30,22,14,06

DATA 61,53,45,37,29,21,13,05,28,20,12,04



KeyTr2l:

DATA 14,17,11,24,01,05,03,28,15,06,21,10,23,19,12,04,26,08,16,07,27,20,13,02

DATA 41,52,31,37,47,55,30,40,51,45,33,48,44,49,39,56,34,53,46,42,50,36,29,32



etrl:

DATA 32,01,02,03,04,05,04,05,06,07,08,09,08,09,10,11,12,13,12,13,14,15,16,17

DATA 16,17,18,19,20,21,20,21,22,23,24,25,24,25,26,27,28,29,28,29,30,31,32,01



ptrl:

DATA 16,07,20,21,29,12,28,17,01,15,23,26,05,18,31,10

DATA 02,08,24,14,32,27,03,09,19,13,30,06,22,11,04,25



sboxesl:

DATA 14,04,13,01,02,15,11,08,03,10,06,12,05,09,00,07

DATA 00,15,07,04,14,02,13,01,10,06,12,11,09,05,03,08

DATA 04,01,14,08,13,06,02,11,15,12,09,07,03,10,05,00

DATA 15,12,08,02,04,09,01,07,05,11,03,14,10,00,06,13



DATA 15,01,08,14,06,11,03,04,09,07,02,13,12,00,05,10

DATA 03,13,04,07,15,02,08,14,12,00,01,10,06,09,11,05

DATA 00,14,07,11,10,04,13,01,05,08,12,06,09,03,02,15

DATA 13,08,10,01,03,15,04,02,11,06,07,12,00,05,14,09



DATA 10,00,09,14,06,03,15,05,01,13,12,07,11,04,02,08

DATA 13,07,00,09,03,04,06,10,02,08,05,14,12,11,15,01

DATA 13,06,04,09,08,15,03,00,11,01,02,12,05,10,14,07

DATA 01,10,13,00,06,09,08,07,04,15,14,03,11,05,02,12



DATA 07,13,14,03,00,06,09,10,01,02,08,05,11,12,04,15

DATA 13,08,11,05,06,15,00,03,04,07,02,12,01,10,14,09

DATA 10,06,09,00,12,11,07,13,15,01,03,14,05,02,08,04

DATA 03,15,00,06,10,01,13,08,09,04,05,11,12,07,02,14



DATA 02,12,04,01,07,10,11,06,08,05,03,15,13,00,14,09

DATA 14,11,02,12,04,07,13,01,05,00,15,10,03,09,08,06

DATA 04,02,01,11,10,13,07,08,15,09,12,05,06,03,00,14

DATA 11,08,12,07,01,14,02,13,06,15,00,09,10,04,05,03



DATA 12,01,10,15,09,02,06,08,00,13,03,04,14,07,05,11

DATA 10,15,04,02,07,12,09,05,06,01,13,14,00,11,03,08

DATA 09,14,15,05,02,08,12,03,07,00,04,10,01,13,11,06

DATA 04,03,02,12,09,05,15,10,11,14,01,07,06,00,08,13



DATA 04,11,02,14,15,00,08,13,03,12,09,07,05,10,06,01

DATA 13,00,11,07,04,09,01,10,14,03,05,12,02,15,08,06

DATA 01,04,11,13,12,03,07,14,10,15,06,08,00,05,09,02

DATA 06,11,13,08,01,04,10,07,09,05,00,15,14,02,03,12



DATA 13,02,08,04,06,15,11,01,10,09,03,14,05,00,12,07

DATA 01,15,13,08,10,03,07,04,12,05,06,11,00,14,09,02

DATA 07,11,04,01,09,12,14,02,00,06,10,13,15,03,05,08

DATA 02,01,14,07,04,10,08,13,15,12,09,00,03,05,06,11



rotsl:

DATA 1,1,2,2,2,2,2,2,1,2,2,2,2,2,2,1        'The sum of these is 28 so

                                            'the password is restored

mynamel:                                    'automatically after 16 steps.

DATA 40,67,41,32,72,46,74,46,32,116,101

DATA 110,32,78,97,112,101,108,32,49,57,57,51



SUB btos (mbits() AS INTEGER, a$)

a$ = ""

FOR i% = 1 TO 8

 w% = 0

 FOR j% = 1 TO 8

  w% = w% + ((mbits(((i% - 1) * 8) + j%)) * (2 ^ (8 - j%)))

 NEXT j%

 a$ = a$ + CHR$(w%)

NEXT i%

END SUB



FUNCTION desalg$ (a$)

 temp$ = ""

 stob a$, plaintext()                    'Convert input to array.

 letbe ades(), plaintext(), 64           'Copy plaintext to ades().

 transpose ades(), InitialTr(), 64       'Initial transposition.

 FOR i% = 1 TO 16                        'Here come the 16 iterations.

  letbe bdes(), ades(), 64               'ades() contains current ciphertext.

  FOR j% = 1 TO 32

   ades(j%) = bdes(j% + 32)              'Current left taken from old right.

  NEXT j%

  f i%, ades(), xdes()                   'Compute xdes()=f(r[i%-1],k[i%])

  FOR j% = 1 TO 32                       '( see f() ).

   ades(j% + 32) = (bdes(j%) + xdes(j%)) MOD 2

  NEXT j%

 NEXT i%

 transpose ades(), swappy(), 64          'Swap left and right halves.

 transpose ades(), FinalTr(), 64         'Final transposition.

 letbe ciphertext(), ades(), 64

 btos ciphertext(), temp$                'Convert output to string.

 desalg$ = temp$

END FUNCTION



SUB f (i%, a() AS INTEGER, x() AS INTEGER)

h% = i%: letbe EF(), a(), 64

transpose EF(), etr(), 48                 'Expand e to 48 bits.

FOR j% = 1 TO rots(h%)                    'Rotate password 1 or 2 left

 mrotate P2()                             'according to rots().

NEXT j%

letbe ikeyf(), P2(), 64: transpose ikeyf(), KeyTr2(), 48

FOR j% = 1 TO 48

 yf(j%) = (EF(j%) + ikeyf(j%)) MOD 2

NEXT j%

FOR k% = 1 TO 8

 k6% = 6 * k%: k4% = 4 * k%

 r% = (32 * yf(k6% - 5)) + (16 * yf(k6%)) + (8 * yf(k6% - 4)) + (4 * yf(k6% - 3)) + (2 * yf(k6% - 2)) + yf(k6% - 1) + 1

 x(k4% - 3) = (s(k%, r%) \ 8) MOD 2: x(k4% - 2) = (s(k%, r%) \ 4) MOD 2

 x(k4% - 1) = (s(k%, r%) \ 2) MOD 2: x(k4%) = s(k%, r%) MOD 2

NEXT k%

transpose x(), ptr(), 32

END SUB



SUB init (x() AS INTEGER, n%)

 FOR i% = 1 TO n%

  READ x(i%)

 NEXT i%

END SUB



SUB letbe (target() AS INTEGER, source() AS INTEGER, LAST%)

FOR i% = 1 TO LAST%

 target(i%) = source(i%)

NEXT i%

END SUB



FUNCTION MYBIN$ (n%)

LOCAL ST$

p% = n%

ST$=""

FOR i% = 1 TO 8

 IF (p% MOD 2) THEN

  ST$ = "1" + ST$

 ELSE

  ST$ = "0" + ST$

 END IF

 p% = p% \ 2

NEXT i%

MYBIN$ = ST$

END FUNCTION



SUB mrotate (keyr() AS INTEGER)     '1 bit left rotate on two 28 bit units.

letbe XR(), keyr(), 56

FOR i% = 1 TO 55

 XR(i%) = XR(i% + 1)

NEXT i%

XR(28) = keyr(1): XR(56) = keyr(29)

letbe keyr(), XR(), 56

END SUB



SUB sboxinit (b() AS INTEGER)

RESTORE sboxesl

FOR i% = 1 TO 8

 FOR j% = 1 TO 64

  READ b(i%, j%)

 NEXT j%

NEXT i%

END SUB



SUB stob (a$, mbits() AS INTEGER)

FOR i% = 1 TO 8

 b$ = MYBIN$(ASC(MID$(a$, i%, 1)))

 FOR j% = 1 TO 8

  mbits(((i% - 1) * 8) + j%) = ASC(MID$(b$, j%, 1)) - 48

 NEXT j%

NEXT i%

END SUB



SUB transpose (datax() AS INTEGER, T() AS INTEGER, n%)

letbe XT(), datax(), 64

FOR i% = 1 TO n%

 datax(i%) = XT(T(i%))

NEXT i%

END SUB