unit DES;
{
Этот модуль - реализация американского федерального
стандарта шифрования информации.
Перед началом работы обязательно должны быть вызваны
процедуры DESInit - для инициализации модуля (один раз)
и KeyInit - при изменении пароля и/или начале работы с
новым файлом данных. При передаче в качестве пароля
пустой строки используется ключ DefaultKey.
Операции объединяются по OR и обозначают следующее:
* opDecrypt: расшифровка,
* opEncrypt: зашифровка,
* opECB : поблочное (8 символов) кодирование без зацепления
* opCBC : непрерывное кодирование с зацеплением.
Параметры процедуры Handle:
Area : указатель на начало обрабатываемой области,
NumberOfBlocks: количество обрабатываемых 8-байтовых блоков.
Замечание: зашифрованные по opCBC данные НЕ архивируются из-за
отсутствия повторяющихся данных.
}
interface
const opDecrypt=1; opEncrypt=0; opECB=0; opCBC=2;
procedure DESInit;
procedure KeyInit(Operation:byte; Key:string);
procedure Handle(Area:pointer; NumberOfBlocks:word);
implementation
type TBlock=array[0..7]of byte;
const Ignited:boolean=false;
var Keys:array[0..15]of TBlock;
CurKey:TBlock;
CurOper:byte;
Net:array[0..3,0..4095]of byte;
p48:array[0..3,0.. 255]of TBlock;
Link:TBlock;
procedure DESInit; assembler;
const
s:array[0..7,0..63]of byte=(
(224,64,208,16,32,240,176,128,48,160,96,192,80,144,0,112,
0,240,112,64,224,32,208,16,160,96,192,176,144,80,48,128,
64,16,224,128,208,96,32,176,240,192,144,112,48,160,80,0,
240,192,128,32,64,144,16,112,80,176,48,224,160,0,96,208),
(15,1,8,14,6,11,3,4,9,7,2,13,12,0,5,10,
3,13,4,7,15,2,8,14,12,0,1,10,6,9,11,5,
0,14,7,11,10,4,13,1,5,8,12,6,9,3,2,15,
13,8,10,1,3,15,4,2,11,6,7,12,0,5,14,9),
(160,0,144,224,96,48,240,80,16,208,192,112,176,64,32,128,
208,112,0,144,48,64,96,160,32,128,80,224,192,176,240,16,
208,96,64,144,128,240,48,0,176,16,32,192,80,160,224,112,
16,160,208,0,96,144,128,112,64,240,224,48,176,80,32,192),
(7,13,14,3,0,6,9,10,1,2,8,5,11,12,4,15,
13,8,11,5,6,15,0,3,4,7,2,12,1,10,14,9,
10,6,9,0,12,11,7,13,15,1,3,14,5,2,8,4,
3,15,0,6,10,1,13,8,9,4,5,11,12,7,2,14),
(32,192,64,16,112,160,176,96,128,80,48,240,208,0,224,144,
224,176,32,192,64,112,208,16,80,0,240,160,48,144,128,96,
64,32,16,176,160,208,112,128,240,144,192,80,96,48,0,224,
176,128,192,112,16,224,32,208,96,240,0,144,160,64,80,48),
(12,1,10,15,9,2,6,8,0,13,3,4,14,7,5,11,
10,15,4,2,7,12,9,5,6,1,13,14,0,11,3,8,
9,14,15,5,2,8,12,3,7,0,4,10,1,13,11,6,
4,3,2,12,9,5,15,10,11,14,1,7,6,0,8,13),
(64,176,32,224,240,0,128,208,48,192,144,112,80,160,96,16,
208,0,176,112,64,144,16,160,224,48,80,192,32,240,128,96,
16,64,176,208,192,48,112,224,160,240,96,128,0,80,144,32,
96,176,208,128,16,64,160,112,144,80,0,240,224,32,48,192),
(13,2,8,4,6,15,11,1,10,9,3,14,5,0,12,7,
1,15,13,8,10,3,7,4,12,5,6,11,0,14,9,2,
7,11,4,1,9,12,14,2,0,6,10,13,15,3,5,8,
2,1,14,7,4,10,8,13,15,12,9,0,3,5,6,11));
{------------------------}
p48i:array[0..47]of byte=
(24,15,6,19,20,28,20,28,11,27,16,0,
16,0,14,22,25,4,25,4,17,30,9,1,
9,1,7,23,13,31,13,31,26,2,8,18,
8,18,12,29,5,21,5,21,10,3,24,15);
asm
db $eb,$23,$50,$6f,$72,$74,$69,$6f,$6e,$73,$20,$43,$6f,$70,$79
db $72,$69,$67,$68,$74,$20,$28,$63,$29,$20,$31,$39,$39,$34,$20
db $62,$79,$20,$41,$72,$70,$69
mov cx,1000h
lea si,Ignited
cmp [si],cl
jnz @1
cli
cld
inc byte ptr [si]
lea di,Net
@3:push di
push cx
mov dx,1000h
sub dx,cx
mov al,dl
call @2
xchg ax,dx
mov cl,6
shr ax,cl
call @2
mov dh,al
mov cx,4
lea si,s
xor bx,bx
@4:mov bl,dh
mov al,[bx+si]
mov bl,dl
or al,[bx+si+64]
mov [di],al
add si,80h
add di,1000h
loop @4
pop cx
pop di
inc di
loop @3
lea di,p48
push ds
pop es
push di
xor ax,ax
mov cx,4*256*8/2
rep stosw
pop di
xor dx,dx
@5:lea si,p48i
mov ah,80h
mov ch,48
@6:lodsb
sub al,dl
jc @7
cmp al,8
jnc @7
mov cl,al
mov al,80h
shr al,cl
test dh,al
jz @7
or [di],ah
@7:ror ah,1
cmp ah,2
jnz @8
mov ah,80h
inc di
@8:dec ch
jnz @6
inc dh
jnz @5
add dl,8
cmp dl,32
jc @5
jmp @1
@2:mov bh,al
and al,20h
mov bl,al
mov al,bh
and al,1
mov cl,4
shl al,cl
or bl,al
mov al,bh
and al,1eh
shr al,1
or al,bl
retn
@1:sti
end;
{=================================}
procedure KeyInit(Operation:byte; Key:string); assembler;
var A:TBlock;
const
DefaultKey:TBlock=($01,$23,$45,$67,$89,$ab,$cd,$ef);
{------------------------}
pc1:array[0..55]of byte=
(56,48,40,32,24,16,8,0,57,49,41,33,25,17,
9,1,58,50,42,34,26,18,10,2,59,51,43,35,
62,54,46,38,30,22,14,6,61,53,45,37,29,21,
13,5,60,52,44,36,28,20,12,4,27,19,11,3);
{------------------------}
pc2:array[0..47]of byte=
(13,16,10,23,0,4,2,27,14,5,20,9,
22,18,11,3,25,7,15,6,26,19,12,1,
40,51,30,36,46,54,29,39,50,44,32,47,
43,48,38,55,33,52,45,41,49,35,28,31);
asm
cli
cld
mov al,Operation
mov [CurOper],al
push ds
pop es
lea di,CurKey
push ds
lds si,Key
lodsb
and al,al
jz @@5
push ax
push di
xor ax,ax
stosw
stosw
stosw
stosw
pop di
pop ax
mov dl,al
dec ax
mov cl,3
shr al,cl
mov cl,al
inc cl
@@3:push di
mov ch,8
@@4:lodsb
shl al,1
xor es:[di],al
dec dl
jz @@7
inc di
dec ch
jnz @@4
@@7:pop di
dec cl
jnz @@3
pop ds
jmp @@6
@@5:pop ds
lea si,DefaultKey
movsw
movsw
movsw
movsw
@@6:xor ax,ax
push ds
pop es
lea di,Link
stosw
stosw
stosw
stosw
push ss
pop es
lea di,A
push di
stosw
stosw
stosw
stosw
pop di
push di
mov bh,80h
mov ch,56
lea si,pc1
@3: lodsb
mov cl,3
mov bl,al
shr al,cl
push si
lea si,CurKey
add si,ax
and bl,7
mov cl,bl
mov al,80h
shr al,cl
test [si],al
pop si
jz @1
or ss:[di],bh
@1: ror bh,1
jnc @2
inc di
@2: dec ch
jnz @3
lea di,Keys
push ds
pop es
push di
mov cl,16*8/2
xor ax,ax
rep stosw
pop di
test Operation,1
jz @10
add di,15*8
@10:mov dx,1001h
@14:mov ch,24
mov bh,80h
lea si,pc2
@9: mov al,[si]
add al,dl
cmp al,28
jc @4
sub al,28
@4: mov cl,3
mov bl,al
shr al,cl
push si
lea si,A
add si,ax
and bl,7
mov cl,bl
mov al,80h
shr al,cl
test ss:[si],al
pop si
jz @5
or [di],bh
@5: mov al,[si+24]
add al,dl
cmp al,56
jc @6
sub al,28
@6: mov cl,3
mov bl,al
shr al,cl
push si
lea si,A
add si,ax
and bl,7
mov cl,bl
mov al,80h
shr al,cl
test ss:[si],al
pop si
jz @7
or [di+4],bh
@7: shr bh,1
cmp bh,2
jnz @8
mov bh,80h
inc di
@8: inc si
dec ch
jnz @9
add di,4
test Operation,1
jz @11
sub di,16
@11:inc dl
mov al,dh
cmp al,16
jz @12
cmp al,9
jz @12
cmp al,2
jz @12
inc dl
@12:dec dh
jnz @14
sti
end;
{=================================}
procedure Encrypt(var Block:TBlock); assembler;
var C,B,A:TBlock;
asm
cli
push ss
pop es
push ds
lds si,Block
lea di,A
push di
xor ax,ax
stosw
stosw
stosw
stosw
pop di
mov ax,140h
mov cl,8
@h:push di
mov ch,8
@l:push ax
@i:test [si],al
jz @e
or es:[di],ah
@e:inc di
ror al,1
jc @f
ror al,1
@f:dec ch
jnz @i
pop ax
rol ah,1
pop di
inc si
loop @h
pop ds
lea si,B
mov cl,2
lea di,A
@x:mov ch,4
mov dl,7
@4:push cx
mov al,dl
cbw
mov bx,ax
mov al,ss:[bx+di]
and al,1
mov cl,7
shl al,cl
mov ch,al
inc dl
cmp dl,8
jc @3
mov dl,4
@3:mov bl,dl
mov al,ss:[bx+di]
push ax
and al,0f8h
shr al,1
or al,ch
mov ss:[si],al
inc si
pop ax
and al,1fh
mov cl,3
shl al,cl
mov ch,al
inc bx
cmp bl,8
jc @d
mov bl,4
@d:mov al,ss:[bx+di]
and al,80h
mov cl,5
shr al,cl
or al,ch
mov ss:[si],al
inc si
pop cx
dec ch
jnz @4
sub di,4
loop @x
mov cl,16
lea ax,Keys
mov si,8
push bp
lea bp,B
@a:push cx
lea dx,p48
lea di,Net
mov cl,4
@5:push cx
mov bx,[bp+si]
xchg ax,di
xor bx,[di]
xchg ax,di
shr bh,1
shr bh,1
mov ch,bh
mov cl,4
shl bx,cl
and bx,0fc0h
or bl,ch
mov bl,[di+bx]
xor bh,bh
mov cx,3
shl bx,cl
xchg di,dx
push ax
push si
and si,8
xor si,8
mov cl,4
@y:mov ax,[di+bx]
xor [bp+si],ax
inc bx
inc bx
inc si
inc si
loop @y
pop si
pop ax
xchg di,dx
add di,1000h
add dx,800h
inc si
inc si
inc ax
inc ax
pop cx
loop @5
and si,0fh
pop cx
loop @a
pop bp
lea si,B
lea di,A
push di
mov ch,8
@v:mov ax,ss:[si]
and ax,7878h
mov cl,3
shr ah,cl
shl al,1
or al,ah
mov ss:[di],al
inc di
inc si
inc si
dec ch
jnz @v
pop si
les di,Block
push di
xor ax,ax
stosw
stosw
stosw
stosw
pop di
mov ax,140h
mov cl,8
@m:push di
mov ch,8
@g:test ss:[si],ah
jz @k
or es:[di],al
@k:inc di
rol ah,1
dec ch
jnz @g
ror al,1
jc @j
ror al,1
@j:pop di
inc si
loop @m
sti
end;
{=================================}
procedure Handle(Area:pointer; NumberOfBlocks:word); assembler;
const WasHere:Byte=$ff;
var Tmp:TBlock;
asm
cld
mov cx,NumberOfBlocks
mov al,CurOper
les di,Area
test al,2
jnz @1
@2:push cx
call @6
pop cx
add di,8
loop @2
jmp @3
@1:mov dx,ds
cmp WasHere,al
jz @B
mov WasHere,al
lea si,CurKey
call @A
@B:test al,1
jnz @4
@5:push cx
call @8
call @6
mov dx,es
mov si,di
call @A
pop cx
add di,8
loop @5
jmp @3
@4:push cx
mov dx,es
lea bx,Tmp
mov si,di
call @9
call @6
call @8
mov dx,ss
lea si,Tmp
call @A
pop cx
add di,8
loop @4
jmp @3
@6:push di
push es
push di
call Encrypt
pop di
retn
@8:push ds
push ss
pop ds
lea si,Link
push di
mov cx,4
@7:lodsw
xor es:[di],ax
inc di
inc di
loop @7
pop di
pop ds
retn
@A:lea bx,Link
@9:push es
push di
push ds
mov ds,dx
mov di,bx
push ss
pop es
movsw
movsw
movsw
movsw
pop ds
pop di
pop es
retn
@3:
end;
end.
|
