'(C) Harm ten Napel 1993



'Pbasic program DEDES.BAS  Version 2.00.



'This program works in conjunction with DES.BAS, see listing of DES.BAS

'for more information.



$CPU 80386

$FLOAT NPX

$OPTIMIZE SPEED

$LIB ALL-

$OPTION CNTLBREAK ON



DECLARE FUNCTION MYBIN$ (n%)



DECLARE FUNCTION desalg$ (a$)



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

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

DECLARE SUB mrotate (keyx%())                    'Is now RIGHT rotation.



DECLARE SUB stob (a$, mbits%())

DECLARE SUB btos (mbits%(), a$)

DECLARE SUB letbe (target%(), source%(), last%)

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

DECLARE SUB sboxinit (b() AS INTEGER)



' 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



DIM EF(1 TO 64) AS shared INTEGER

DIM ikeyf(1 TO 64) AS shared INTEGER

DIM yf(1 TO 64) AS shared INTEGER



DIM ades(1 TO 64) AS shared INTEGER

DIM bdes(1 TO 64) AS shared INTEGER

DIM xdes(1 TO 64) AS shared INTEGER



DIM XT(1 TO 64)   AS shared INTEGER



DIM P2(1 TO 64) AS shared INTEGER



main:

CLS

RESTORE mynamel

myname$ = ""

FOR n% = 1 TO 23

 READ c%

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

NEXT n%

PRINT : PRINT

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

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

IF LEN(parm$) > 1 THEN

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

 PRINT "DES encrypted input filename : "; cipherf$

ELSE

 INPUT "DES encrypted input filename : ", cipherf$

END IF

if len(cipherf$)=0 then

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

 system

end if

OPEN cipherf$ FOR RANDOM AS 1

lof1& = LOF(1)

IF lof1& = 0 THEN

 CLOSE #1

 KILL cipherf$

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

 SYSTEM

ELSE

 CLOSE #1

 OPEN cipherf$ for binary access read as #1

END IF



PW$ = ""

LOCATE 6, 1

INPUT "                    Password : ", PW$

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

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

PW$ = LEFT$(PW$, 8)

PRINT "           Checking password : ";

stob PW$, P2()

transpose P2(), KeyTr1(), 56

get$ #1,24,cheader$

header$ = desalg$(LEFT$(cheader$, 8))

IF NOT (LEFT$(header$, 3) = "DES") THEN

 PRINT "Not OK": PRINT : PRINT "Password error or "; cipherf$; " is not a legitimate DES file."

 SYSTEM

ELSE

 PRINT "OK"

END IF

PRINT "        Checking file lenght :";

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

header$ = header$ + desalg$(RIGHT$(cheader$, 8))

pl% = INSTR(header$, "#")

le$ = MID$(header$, pl% + 1, (11 - pl%))

lf& = VAL(le$)

ev& = lf& + 24

IF (ev& MOD 8) THEN ev& = ev& + 8 - (ev& MOD 8)

rescue% = 0

IF (ev& <> lof1&) THEN

 PRINT " NOT OK!!  (possible data loss)"

 PRINT "        Original file length :"; lf&

 PRINT "           Input file lenght :"; lof1&

 PRINT " Input file lenght should be :"; ev&

 INPUT ; "Try to recover anyway? (y/n) : ", q$: IF (INSTR(q$, "N") OR (INSTR(q$, "n"))) THEN SYSTEM

 rescue% = 4: PRINT

ELSE

 PRINT lf&; ", OK"

END IF



pl% = INSTR(12, header$, "#")

oldplainf$ = RIGHT$(header$, 24 - pl%)

PRINT "           Original filename : "; oldplainf$;

OPEN oldplainf$ FOR RANDOM AS 2

IF INSTR(oldplainf$, ".") THEN

 PRINT " ([*.*] ";

ELSE

 PRINT " ([*] ";

END IF

IF LOF(2) > 0 THEN PRINT "already in directory";

PRINT ")"

CLOSE #2

plainf$ = ""

INPUT "            Output  filename : ", plainf$

IF plainf$ = "" THEN plainf$ = oldplainf$

plainf$ = RTRIM$(LTRIM$(plainf$))

IF INSTR(plainf$, "*.") THEN

 IF INSTR(oldplainf$, ".") THEN

  plainf$ = LEFT$(plainf$, INSTR(plainf$, "*.") - 1) + LEFT$(oldplainf$, INSTR(oldplainf$, ".")) + RIGHT$(plainf$, LEN(plainf$) - INSTR(plainf$, "*.") - 1)

 ELSE

  plainf$ = LEFT$(plainf$, INSTR(plainf$, "*.") - 1) + oldplainf$ + RIGHT$(plainf$, LEN(plainf$) - INSTR(plainf$, "*."))

 END IF

END IF

IF (RIGHT$(plainf$, 1) = "*") THEN

 IF plainf$ = "*" THEN

  plainf$ = oldplainf$

 ELSE

  IF (MID$(plainf$, LEN(plainf$) - 1, 1) = ".") THEN

   plainf$ = LEFT$(plainf$, INSTR(plainf$, ".") - 1) + RIGHT$(oldplainf$, LEN(oldplainf$) - INSTR(oldplainf$, ".") + 1)

  ELSE

   plainf$ = LEFT$(plainf$, LEN(plainf$) - 1) + oldplainf$

  END IF

 END IF

END IF

IF RIGHT$(plainf$, 1) = "\" THEN plainf$ = plainf$ + oldplainf$



OPEN plainf$ FOR RANDOM AS 2

IF LOF(2) > 0 THEN

 CLOSE #2

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

 SYSTEM

ELSE

 CLOSE #2

 OPEN plainf$ FOR BINARY AS 2

END IF



plaintekst$ = ""

blocks& = (LOF(1) \ 8) - 3



'Here the main decryption starts, dividing

'the input file in 8 character blocks

'and decrypting them one by one.



LOCATE rescue% + 11, 21: PRINT ; "Progress :   0 %";



bigblocks&=blocks& \ 32

large$=space$(256)

FOR m& = 1 TO bigblocks&

  outblock$=""

  get$ #1,256,large$

  for o%=1 to 256 step 8

   outblock$=outblock$+desalg$(mid$(large$,o%,8))

  next

  put$ #2,outblock$

  LOCATE rescue% + 11, 32: PRINT ; USING "###"; (m& / (bigblocks&+1)) * 100;

next



FOR n& = (bigblocks&*32)+1 TO blocks& - 1

 GET$ #1,8,ciphertekst$

 plaintekst$ = desalg$(ciphertekst$)

 PUT$ #2, plaintekst$

 LOCATE rescue% + 11, 32: PRINT ; USING "###"; (n& / blocks&) * 100;

NEXT n&

get$ #1,8,ciphertekst$

if len(ciphertekst$) > 0 then

   plaintekst$ = desalg$(ciphertekst$)

   IF rescue% THEN

     last$ = plaintekst$

   ELSE

     last$ = LEFT$(plaintekst$, lf& + 32 - LOF(1))

   END IF

   IF LEN(last$) > 0 THEN

      PUT$ #2, last$

   END IF

end if

CLOSE

LOCATE 11 + rescue%, 32: PRINT "100 %  Ready": PRINT

IF rescue% THEN

 PRINT "Use other tools to recover decrypted file, returning to system."

ELSE

 PRINT "DES decryption succesfully completed, returning to system."

END IF

SYSTEM



' 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



'test:

'DATA 140,166,77,233,193,177,35,167



mynamel:

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$, ciphertext()

 letbe ades(), ciphertext(), 64

 transpose ades(), InitialTr(), 64       'This is reverse of FinalTr().

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

 FOR i% = 16 TO 1 STEP -1

  letbe bdes(), ades(), 64

  f i%, bdes(), xdes()                   'Compute xdes()=f(l[i],k[i])

  FOR j% = 1 TO 32

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

  NEXT j%

  FOR j% = 33 TO 64

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

  NEXT j%

 NEXT i%

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

 letbe plaintext(), ades(), 64

 btos plaintext(), 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 mbits.

letbe ikeyf(), P2(), 64

transpose ikeyf(), KeyTr2(), 48

FOR j% = 1 TO rots(h%)                    'Note that rotation is for

 mrotate P2()                              'use in next step.

NEXT j%                                   'Total rots where 28 in DES.BAS,

                                          'here we proceed backwards.

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 il% = 1 TO last%

 target(il%) = source(il%)

NEXT il%

END SUB



FUNCTION MYBIN$ (n%)

STS$ = ""

p% = n%

 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 right rotate on two 28 bit units.

letbe XR(), keyr(), 56

FOR ir% = 56 TO 2 STEP -1

 XR(ir%) = XR(ir% - 1)

NEXT ir%

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

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, nt%)

letbe XT(), datax(), 64

FOR i% = 1 TO nt%

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

NEXT i%

END SUB