L     R
      1001 1001
 E/P( R ) = 11000011
  + K2      00100001
	=   11001001
	    1100  1001
  1100 --> S0[ 3,0 ] = 3 --> 11
  1001 --> S1[ 2,1 ] = 1 --> 01
              1101
 P4( 1101 ) = 1011
   + L        1001
	    = 0010

  ,R        = 1001

unit uBits;

interface

const                          {9, 8, 7, 6, 5, 4, 3, 2, 1, 0}  { биты       }
  P10: array [0..9]  of Byte = (2, 4, 1, 6, 3, 9, 0, 8, 7, 5); { модуль P10 }
   P8: array [0..7]  of Byte =       (5, 2, 6, 3, 7, 4, 9, 8); { модуль P8  }
   P4: array [0..3]  of Byte =                   (0, 1, 2, 3); { модуль P4 (в этом примере просто переворот)}

                              {0, 1, 2, 3, 4, 5, 6, 7} { биты }
   { модуль IP  }
   IP: array [0..7] of Byte = (1, 5, 2, 0, 3, 7, 4, 6);
   { модуль IP_ }
  IP_: array [0..7] of Byte = (3, 0, 2, 4, 6, 1, 7, 5);

   { модуль EP }              {0, 1, 2, 3, 4, 5, 6, 7} { биты }
  EP: array [0..7] of Byte =  (3, 0, 1, 2, 1, 2, 3, 0);

   { матрица кодирования S0 }
  S0: array [0..3, 0..3] of Byte = (
    (1, 0, 3, 2),
    (3, 2, 1, 0),
    (0, 2, 1, 3),
    (3, 1, 0, 2)
  );

  { матрица кодирования S1 }
  S1: array [0..3, 0..3] of Byte = (
    (2, 3, 1, 0),
    (1, 0, 2, 3),
    (0, 1, 3, 2),
    (3, 0, 2, 1)
  );

type
  TBit   = 0..1;
  TBit2  = array [0..1] of TBit;
  TBit4  = array [0..3] of TBit;
  TBit8  = array [0..7] of TBit;
  TBit10 = array [0..9] of TBit;

  { ф-я вернет бит bit_num числа value }
  function get_bit(const value: Integer; const bit_num: Byte): TBit;

  { пр-а установит бит bit_num числа value в значение bit_value }
  procedure set_bit(var value: Integer; const bit_num: Byte; const bit_value: TBit);

  { печать массива бит, длиной bits_count }
  procedure print_bits(const bits: array of TBit; const bits_count: Byte);

  { пр-а сохранит в массив bits биты числа value, нулевой бит = bits[0] }
  procedure int2bits(const value: Integer; var bits: array of TBit; const bits_count: Byte);

  { ф-я вернет десятичное значение, соотв. двоичному числу, хранящемуся в bits }
  function bits2int(const bits: array of TBit; const bits_count: Byte): Integer;

  { пр-а разбивает массив битов source длиной source_len
   на две части part1 и part1,
   пример:
          (* 0,1,2,3,4,5,6,7 *) -- индексы в массиве

   source = (1,1,0,0,1,0,1,0) = 01010011(2)

   part1 = (1, 0, 1, 0) = 0101(2)
   part2 = (1, 1, 0, 0) = 0011(2)
  }
  procedure cat_bits (
    const source: array of TBit;
    var part1, part2: array of TBit;
    const source_len: Byte
  );

  { пр-а "склеивает" 2 последовательности бит part1 и part2,
   длины которых равны part_len в одну последовательность destination,
   пример:

    part1 = (1, 1, 1, 0) = 0111(2)
    +
    part2 = (0, 0, 0, 1) = 1000(2)
    =
    destination = (0, 0, 0, 1, 1, 1, 1, 0) = 01111000
  }
  procedure concat_bits (
    const part1, part2: array of TBit;
    var destination: array of TBit;
    const part_len: Byte
  );

implementation

function get_bit(const value: Integer; const bit_num: Byte): TBit;
var
  buffer: array[0 .. 15] of TBit;
  i: integer;
begin
  fillchar(buffer, 16, 0);
  for i := 0 to pred(sizeof(value) * 8) do begin
    buffer[pred(sizeof(value) * 8) - i] := (value shr i) and $1;
  end;
  get_bit := buffer[pred(sizeof(value) * 8) - bit_num];
end;

procedure set_bit(var value: Integer; const bit_num: Byte;
 const bit_value: TBit);
var
  tmp: Integer;
begin
  tmp := round(exp(bit_num * ln(2)));

  if bit_value = 1 then
    value := value or tmp
  else if (value and tmp) = tmp then
    value := value xor tmp
end;

procedure print_bits(const bits: array of TBit; const bits_count: Byte);
var
  i: Byte;
begin
  writeln;
  for i := bits_count - 1 downto 0 do
    write(bits[i]);
end;

procedure int2bits(const value: Integer; var bits: array of TBit;
 const bits_count: Byte);
var
  i: Byte;
begin
  for i := 0 to bits_count - 1 do
    bits[i] := get_bit(value, i);
end;

function bits2int(const bits: array of TBit; const bits_count: Byte): Integer;
var
  i: Byte;
  value: Integer;
begin
  value := 0;
  for i := 0 to bits_count - 1 do
   set_bit(value, i, bits[i]);
  bits2int := value;
end;

procedure cat_bits (
    const source: array of TBit;
    var part1, part2: array of TBit;
    const source_len: Byte
);

var
  i, middle: Byte;
begin
  middle := source_len div 2 - 1;

  for i := middle + 1 to source_len - 1 do
    part1[i - middle - 1] := source[i];

  for i := 0 to middle do
    part2[i] := source[i];
end;

procedure concat_bits (
    const part1, part2: array of TBit;
    var destination: array of TBit;
    const part_len: Byte
);

var
  i: Byte;
begin
  for i := 0 to part_len - 1 do
    destination[i] := part2[i];

  for i := part_len to 2 * part_len - 1 do
    destination[i] := part1[i - part_len];
end;
end.

unit uKeys;

interface
  uses uBits;

const
  KEY1: Integer = 0; { в этой переменной будет храниться первый ключ }
  KEY2: Integer = 0; { в этой переменной будет храниться второй ключ }

  { пр-а генераципи 2-х 8бит ключей из 1-го 10бит ключа }
  procedure generate_keys(const key: Integer);


implementation

procedure generate_keys(const key: Integer);

  procedure shift(var bits: TBit10);
  var
    i: Byte;
    tmp: TBit;
  begin
    tmp := bits[9];
    for i := 9 downto 6 do
      bits[i] := bits[i - 1];
    bits[5] := tmp;

    tmp := bits[4];
    for i := 4 downto 1 do
      bits[i] := bits[i - 1];
    bits[0] := tmp
  end;

  procedure module_P8(var bits8: TBit8; const bits10: TBit10);
  var
    i: Byte;
  begin
    for i := 0 to 7 do
      bits8[i] := bits10[ P8[7 - i] ];
  end;

  procedure module_P10(var bits10: TBit10);
  var
    i: Byte;
  begin
    for i := 0 to 9 do
      bits10[i] := get_bit(key, P10[9 - i]);
  end;

var
  i: Byte;

  buff8: TBit8;
  buff10: TBit10;

begin
  { сохраняем в buff10 перестановку бит числа key по модулю p10 }
  module_P10(buff10);

  { модуль SHIFT1 }
  shift(buff10);

  { для получения ключа Key1 выполним перестановку по
   модулю P8 для "buff10" }

  module_P8(buff8, buff10);

  KEY1 := bits2int(buff8, 8); { ------- KEY1 -------- }

  { для получения ключа Key2 выполним сдвиг SHIFT2 и
   перестановку получившейся последовательности бит
    по модулю P8
  }

  shift(buff10);

  module_P8(buff8, buff10);

  KEY2 := bits2int(buff8, 8); { ------- KEY2 -------- }
end;

end.

unit uSDES;

interface
  uses uBits, uKeys;

  type
    TCryptType = (ctCrypt, ctDecrypt);

  { шифрация текстового файла }
  procedure crypt_file(const file_in, file_out: String);
  procedure decrypt_file(const file_in, file_out: String);

implementation

 { перестановка массива бит bits по модулю IP }
procedure module_IP(var bits: TBit8);
var
  i: Byte;
  temp: TBit8;
begin
  for i := 0 to 7 do
    temp[i] := bits[ IP[i] ];

  move(temp, bits, sizeof(temp));
end;

 { перестановка массива бит nits по модулю IP_ }
procedure module_IP_(var bits: TBit8);
var
  i: Byte;
  temp: TBit8;
begin
  for i := 0 to 7 do
    temp[i] := bits[ IP_[i] ];

  move(temp, bits, sizeof(temp));
end;

 { расширение 4-х битовой последователности до 8-ми бит, с
  использованием модуля EP }
procedure module_EP(const bits4: TBit4; var bits8: TBit8);
var
  i: Byte;
begin
  for i := 0 to 7 do
    bits8[i] := bits4[ EP[7 - i] ];
end;

 { преобразование 4-битовой последователности по
  матрице кодирования S0
 }
procedure module_S0(const bits4: TBit4; var bits2: TBit2);
var
  row, col: TBit2;
begin
  move(bits4[0], col, 2 * sizeof(TBit));
  move(bits4[2], row, 2 * sizeof(TBit));

  int2bits(S0[ bits2int(row, 2), bits2int(col, 2) ], bits2, 2);
end;

procedure module_S1(const bits4: TBit4; var bits2: TBit2);
var
  row, col: TBit2;
begin
  move(bits4[0], col, 2 * sizeof(TBit));
  move(bits4[2], row, 2 * sizeof(TBit));

  int2bits(S1[ bits2int(row, 2), bits2int(col, 2) ], bits2, 2);
end;

procedure module_P4(const part1, part2: TBit2; var bits: TBit4);
var
  i: Byte;
  buff4: TBit4;
begin
  concat_bits(part1, part2, bits, 2);

  for i := 0 to 3 do
    buff4[i] := bits[ P4[3 - i] ];
  move(buff4, bits, sizeof(buff4));
end;

procedure s_des(
    const left_in, right_in: TBit4;
    var left_out, right_out: TBit4;
    const key: Integer
);

var
  buff8A: TBit8;
  s0In, s1In, p4Out: TBit4;
  s0Out, s1Out: TBit2;
  temp: Integer;
begin

  module_EP(right_in, buff8A);

  temp := bits2int(buff8A, 8) xor key;

  int2bits(temp, buff8A, 8);

  cat_bits(buff8A, s0In, s1In, 8);

  module_s0(s0In, s0Out);
  module_s1(s1In, s1Out);

  module_p4(s0Out, s1Out, p4Out);

  int2bits(bits2int(left_in, 4) xor bits2int(p4Out, 4), left_out, 4);

  move(right_in, right_out, sizeof(right_in));
end;

function crypt_byte(const _byte: Byte; const ct: TCryptType): Byte;
var
  K1, K2: Integer;

  left_in, right_in, left_out, right_out: TBit4;
  buff8: TBit8;

begin

  if ct = ctCrypt then begin
    K1 := KEY1;
    K2 := KEY2;
  end else begin
    K1 := KEY2;
    K2 := KEY1;
  end;

  int2bits(_byte, buff8, 8);

  module_IP(buff8);

  cat_bits(buff8, left_in, right_in, 8);

  s_des(left_in, right_in, left_out, right_out, K1);

  s_des(right_out, left_out, left_in, right_in, K2);

  concat_bits(left_in, left_out, buff8, 4);

  module_IP_(buff8);

  crypt_byte := Byte(bits2int(buff8, 8));
end;

procedure crypt_file(const file_in, file_out: String);
var
  f_in, f_out: file of byte;

  s: String;
  i, iEnc: Byte;
begin
  assign(f_in, file_in);
  reset(f_in);

  assign(f_out, file_out);
  rewrite(f_out);

  while not eof( f_in ) do begin
    read(f_in, i);
    iEnc := crypt_byte(i, ctCrypt);
    write(f_out, iEnc);
  end;

  close(f_in);
  close(f_out)
end;

procedure decrypt_file(const file_in, file_out: String);
var
  f_in, f_out: file of byte;
  s: string;
  i, iDec: Byte;
begin
  assign(f_in, file_in);
  reset(f_in);
  assign(f_out, file_out);
  rewrite(f_out);

  while not eof ( f_in ) do begin
    read(f_in, i);
    iDec := crypt_byte(i, ctDecrypt);
    write(f_out, iDec);
  end;

  close(f_in);
  close(f_out);
end;

end.

uses crt, uBits, uKeys, uSDES;

var
  key: Integer;

begin
  clrscr;

  write('input key: '); readln(key);

  if ( key < 0 ) or ( key > 1023 ) then begin
    writeln('bad key');
    readln;
    halt(1);
  end;

  generate_keys(key);

  writeln('encoding -- start ...');

  crypt_file('c:\my_file.txt', 'c:\crypt_file.des');
  decrypt_file('c:\crypt_file.des', 'c:\decrypt_file.txt');

  writeln('encoding -- complete.');
  readln; 
end.