Продолжение листинга 18.3

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 % завершено"
PRINT: PRINT "Шифрование по алгоритму DES завершено."
PRINT
SYSTEM

' Данные и функции

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

Продолжение листинга 18.3

KeyTr2l:
DATA 14,17,11,24,01,05,03,28,15,06,21,10,23,19,12,04

DATA 26,08,16,07,27,20,13,02,41,52,31,37,47,55,30,40
DATA 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
DATA 12,13,12,13,14,15,16,17,16,17,18,19,20,21,20,21

DATA 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

Продолжение листинга 18.3

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

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$, ades()
transpose ades(), InitialTr(), 64
FOR i% = 1 TO 16
letbe bdes(), ades(), 64
FOR j% = 1 TO 32
ades(j%) = bdes(j% + 32)
NEXT j%
f i%, ades(), xdes()
FOR j% = 1 TO 32
ades(j% + 32) = (bdes(j%) + xdes(j%)) MOD 2

Продолжение листинга 18.3

NEXT j%
NEXT i%
transpose ades(), swappy(), 64
transpose ades(), FinalTr(), 64
btos ades(), temp$
desalg$ = temp$
END FUNCTION

SUB f (i%, a() AS INTEGER, x() AS INTEGER)
h% = i%: letbe EF(), a(), 64
transpose EF(), etr(), 48
FOR j% = 1 TO rots(h%)
mrotate P2()
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

Продолжение листинга 18.3

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)
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