www.gcmsite.ru

Новости Программы PHP-скрипты Статьи Числа
Услуги Резюме Игры Автомобили Поиск

СИСТЕМНОЕ И ВЕБ-ПРОГРАММИРОВАНИЕ
компьютерная техника, игры

Нужна программа, скрипт или сайт? Анализ сайта или оптимизация? Копирайт или рерайт текстов? Заявка на выполнение работ.

Криптографические алгоритмы

В данной статье представлено несколько алгоритмов шифрования данных. Каждый блок является самодостаточной программой, написанной на языке программирования Borlabd Pascal 7.0

Опытному программисту не составит труда перевести алгоритмы на другой язык программирования, например на C++ или Java.

  • Программное моделирование шифрующей машины "Энигма". стр 141 - 144 книги В.Жельникова "Криптография"
  • Алгоритм замены биграммами, модификация PlayFair. Описание: книга В. Жельникова "Криптография" стр 62-63. Этот алгоритм применялся Великобританией в Первую мировую войну
  • Шифрование 'взбиванием', стр 138 - 139 книги В.Жельникова "Криптография"
  • Шифрование тасовкой (стр 134 - 135 книги В.Жельникова "Криптография")
  • Кодирование простой заменой
  • Некий аналог RSA-КОДИРОВАНИЯ
program Enigma;
{ Программное моделирование шифрующей машины "Энигма" }
{ стр 141 - 144 книги В.Жельникова "Криптография"     }
uses Crt;
 
const
  Password = 231;
  ns       = 4;
  ss: string =
  '   Когда программисты-фанатики  собираются  в своем кругу для об' +
  'суждения тайн структурного программирования                     ';
 
 
var i, j, k, m, n: integer;
    st: string;
    x: integer;
    s: array[0..ns, 0..32] of char;
    t: char;
begin
  ClrScr;
  RandSeed:= Password;
  Writeln(ss);
  Writeln;
  for i:= 0 to ns do begin
    for j:= 0 to 32 do s[i, j]:= Chr(j);
    for j:= 0 to 32 do begin
      t:= s[i, j];
      k:= Random(33);
      s[i, j]:= s[i, k];
      s[i, k]:= t;
    end;
  end;
  st:= '';
  for i:= 1 to Length(ss) do begin  { Шифрование }
    k:= Ord(ss[i]);
    if k > 32 then dec(k, 128);
    for j:= 0 to ns do
      k:= Ord(s[j, k]);
    if k < 32 then inc(k, 128);
    Write(Chr(k));
    st:= st + Chr(k);
    k:= Random(ns);             { Поворот колес }
    for j:= 0 to 31 do begin
      t:= s[k, j];
      s[k, j]:= s[k, j + 1];
      s[k, j + 1]:= t;
    end;
    for j:= 0 to 32 do
      s[k, j]:= Chr((Ord(s[k, j]) + 32) mod 33);
  end;
  Writeln;
  Writeln;
  RandSeed:= Password;
  for i:= 0 to ns do begin
    for j:= 0 to 32 do
      s[i, j]:= Chr(j);
    for j:= 0 to 32 do begin
      t:= s[i, j];
      k:= Random(33);
      s[i, j]:= s[i, k];
      s[i, k]:= t;
    end;
    for j:= 0 to 32 do begin
      if Ord(s[i, j]) < 64 then begin
        m:= j;
        n:= Ord(s[i, j]);
        repeat
          k:= Ord(s[i, n]);
          s[i, n]:= Chr(m or 64);
          m:= n;
          n:= k;
        until m = j;
      end;
    end;
    for j:= 0 to 32 do
      s[i, j]:= Chr(Ord(s[i, j]) and 63);
  end;
  ss:= st;
  for i:= 1 to Length(ss) do begin
    k:= Ord(ss[i]);
    if k > 32 then dec(k, 128);
    for j:= ns downto 0 do
      k:= Ord(s[j, k]);
    if k < 32 then inc(k, 32);
    Write(Chr(k));
    k:= Random(ns);            { Поворот колес }
    for j:= 0 to 31 do begin
      t:= s[k, j];
      s[k, j]:= s[k, j + 1];
      s[k, j + 1]:= t;
    end;
    for j:= 0 to 32 do
      s[k, j]:= Chr((Ord(s[k, j]) + 32) mod 33);
  end;
  Writeln;
end.
program PlayFair;
{ Алгоритм замены биграммами, модификация PlayFair                }
{ Описание: книга В. Жельникова "Криптография" стр 62-63          }
{ Этот алгоритм применялся Великобританией в Первую мировую войну }
uses Dos, Crt;
 
type TMatrix = array[1..16, 1..16] of Char;
 
const
  Banner = 'Реализация алгоритма шифрования PlayFair';
 
const InFileName: string = '';              { Имя входного файла  }
      OutFileName: string = '';             { Имя выходного файла }
      Phase: (None, Code, Decode) = None;   { Режим работы        }
 
{ True если файл с именем Name существует, False если нет }
function Exists(Name: string): boolean;
var F: file;
    Attr: word;
begin
  Assign(F, Name);
  GetFAttr(F, Attr);
  Exists:= DosError = 0;
end;
 
function AskToDelete(Name: string): boolean;
var ch: char;
begin
  while KeyPressed do ch:= ReadKey; { Чистим буфер }
  Write('Файл с именем ', Name, ' уже существует. Перезаписать ? [Y/N]: ');
  repeat
    ch:= ReadKey;
  until UpCase(ch) in ['Y', 'N'];
  Writeln(ch);
  AskToDelete:= UpCase(ch) = 'Y';
end;
 
{ Получение от пользователя имени входного файла. }
function AskInName(var Name: string): boolean;
var Flag: boolean;
begin
  repeat
    Writeln('Введите имя входного файла, или Enter для выхода');
    Write('Имя файла: ');  Readln(Name);
    Flag:= Name = '';
    if not Flag then
      if Exists(Name) then Flag:= true
        else Writeln('Файл с именем ', Name, ' не найден !');
  until Flag;
  AskInName:= Name <> '';
end;
 
{ Получение от пользователя имени выходного файла. }
function AskOutName(var Name: string): boolean;
var Flag: boolean;
begin
  repeat
    Writeln('Введите имя выходного файла или Enter для выхода');
    Write('Имя файла: ');  Readln(Name);
    Flag:= Name = '';
    if not Flag then
      if not Exists(Name) then Flag:= true
        else Flag:= AskToDelete(Name);
  until Flag;
  AskOutName:= Name <> '';
end;
 
{ Спрашивает режим работы программы }
function AskPhase: boolean;
var ch: char;
begin
  while KeyPressed do ch:= ReadKey;
  Writeln('Что вы хотите сделать с этим файлом ?');
  Write('[C - зашифровать, D - расшифровать, Q - выйти]: ');
  repeat
    ch:= UpCase(ReadKey);
  until ch in ['C', 'D', 'Q'];
  Writeln(ch);
  case ch of
    'C': Phase:= Code;
    'D': Phase:= Decode;
  end;
  AskPhase:= ch <> 'Q';
end;
 
{ Выдает небольшую справку по ключам программы и выйти }
procedure GiveHelp;
begin
  Writeln;
  Writeln('Программа используется следующим образом:');
  Writeln('playfair [InFileName OutFileName] [-c|-d]');
  Writeln('InFileName  - имя исходного файла');
  Writeln('OutFileName - имя результирующего файла');
  Writeln('-c          - шифрование');
  Writeln('-d          - расшифрование');
  Writeln('-?          - выдать это сообщение');
  Halt(0);
end;
 
{ Проверяет данные и спрашивает недостающие }
function VerifyData: boolean;
var Res: boolean;
begin
  Res:= true;
  if (InFileName <> '') then begin
    if not Exists(InFileName) then begin
      Writeln('Файл с именем ', InFileName, ' не найден !');
      Res:= AskInName(InFileName);
    end
  end
  else Res:= AskInName(InFileName);
  if Res then
    if (OutFileName <> '') then begin
      if Exists(OutFileName) and not AskToDelete(OutFileName) then
        Res:= AskOutName(OutFileName);
    end
    else Res:= AskOutName(OutFileName);
  if Res and (Phase = None) then Res:= AskPhase;
  VerifyData:= Res;
end;
 
{ Получение данных из коммандной строки }
function GetStartData: boolean;
var Res: boolean;   { Результат выполнения функции }
    Params: string;
    i, SlashPos: byte;
begin
  if ParamCount = 0 then Res:= AskInName(InFileName)
  else begin
    Res:= false;
    i:= 1;
    Params:= '';
    while i <= ParamCount do begin
      Params:= Params + '|' + ParamStr(i);
      inc(i);
    end;
    if Pos('?', Params) <> 0 then GiveHelp
    else begin
      SlashPos:= Pos('-', Params);
      if SlashPos = 0 then SlashPos:= Pos('/', Params);
      if SlashPos = 0 then begin
        InFileName:= ParamStr(1);
        OutFileName:= ParamStr(2);
      end
      else begin
        case UpCase(Params[SlashPos + 1]) of
          'C': Phase:= Code;
          'D': Phase:= Decode;
          else GiveHelp;
        end;
        if Pos('|', Params) < SlashPos then begin
          InFileName:= ParamStr(1);
          OutFileName:= ParamStr(2);
        end;
      end;
    end;
    Res:= VerifyData;
  end;
  GetStartData:= Res;
end;
 
function AskLoop: string;
var S: string;
    Flag: boolean;
    ch: Char;
begin
  S:= '';
  Flag:= false;
  repeat
    if KeyPressed then begin
      ch:= ReadKey;
      case ch of
        #0: ch:= ReadKey;
        #13: Flag:= true;
        #8: if Length(S) > 0 then begin
              Dec(S[0]);
              Write(#8#32#8);
            end;
        #32..#255:
          begin
            S:= S + ch;
            Write('*');
          end;
      end;
    end;
  until Flag;
  Writeln;
  AskLoop:= S;
end;
 
function AskPassword(var Password: string): boolean;
begin
  Password:= '';
  Write('Введите пароль: ');
  Password:= AskLoop;
  if Password = '' then Writeln('Пароль пуст ! Файл не зашифрован.');
  AskPassword:= Password <> '';
end;
 
function ReAskPassword(Password: string): boolean;
var S: string;
begin
  Write('Введите пароль снова: ');
  S:= AskLoop;
  if S <> Password then Writeln('Пароли не совпадают !');
  ReAskPassword:= S = Password;
end;
 
procedure MakeMatrix(var Matrix: TMatrix; var Password: string);
var i, j, Pos: byte;
    ch: char;
    Used: array[#1..#255] of boolean;
begin
  for ch:= #1 to #255 do Used[ch]:= false;
  Pos:= 1;
  for i:= 1 to 16 do begin
    for j:= 1 to 16 do begin
      while (Pos <= Length(Password)) and Used[Password[Pos]] do inc(Pos);
      if Pos <= Length(Password) then begin
        Used[Password[Pos]]:= true;
        Matrix[i, j]:= Password[Pos];
        inc(Pos);
      end
      else begin
        ch:= #1;
        while (Used[ch]) and (ch < #255) do inc(ch);
        if not Used[ch] then begin
          Matrix[i, j]:= ch;
          Used[ch]:= true;
        end;
      end;
    end;
  end;
end;
 
procedure FindChar(ch: char; var Matrix: TMatrix; var i, j: byte);
var Flag: boolean;
    k, m: byte;
begin
  Flag:= false;
  for k:= 1 to 16 do begin
    for m:= 1 to 16 do begin
      Flag:= Matrix[k, m] = ch;
      if Flag then Break;
    end;
    if Flag then Break;
  end;
  i:= k;
  j:= m;
end;
 
procedure CodeBigramm(var c1, c2: char; var Matrix: TMatrix);
var i, j: byte;
    k, m: byte;
begin
  FindChar(c1, Matrix, i, j);
  FindChar(c2, Matrix, k, m);
  if i = k then begin
    if Phase = Code then begin
      if j = 16 then j:= 1
                else inc(j);
      if m = 16 then m:= 1
                else inc(m);
    end
    else begin
      if j = 1 then j:= 16
               else dec(j);
      if m = 1 then m:= 16
               else dec(m);
    end;
    c1:= Matrix[i, j];
    c2:= Matrix[k, m];
  end
  else if j = m then begin
         if Phase = Code then begin
           if i = 16 then i:= 1
                     else inc(i);
           if k = 16 then k:= 1
                     else inc(k);
         end
         else begin
           if i = 1 then i:= 16
                    else dec(i);
           if k = 1 then k:= 16
                    else dec(k);
         end;
         c1:= Matrix[i, j];
         c2:= Matrix[k, m];
       end
       else begin
         c1:= Matrix[i, m];
         c2:= Matrix[k, j];
       end;
end;
 
procedure CodeBlock(Size: word; var Buffer: array of char;
  var Matrix: TMatrix);
var i: word;
begin
  i:= 0;
  while i <= Size do begin
    CodeBigramm(Buffer[i], Buffer[i + 1], Matrix);
    inc(i, 2);
  end;
end;
 
procedure ProceedFile(var Matrix: TMatrix);
var InFile, OutFile: file;
    Buffer: array[0..1024] of char;
    Got: word;
begin
  Assign(InFile, InFileName);
  Assign(OutFile, OutFileName);
  Reset(InFile, 1);
  Rewrite(OutFile, 1);
  repeat
    BlockRead(InFile, Buffer, High(Buffer), Got);
    CodeBlock(Got, Buffer, Matrix);
    BlockWrite(OutFile, Buffer, Got, Got)
  until Got < High(Buffer);
  Close(InFile);
  Close(OutFile);
end;
 
var Matrix: TMatrix;
    Password: string;
begin
  Writeln(Banner);
  if GetStartData then { Разбор ключей, и заполнение данных }
    if AskPassword(Password) and
       ((Phase <> Code) or ReAskPassword(Password)) then
    begin
      MakeMatrix(Matrix, Password);
      ProceedFile(Matrix);
    end;
end.
program Scramble;
{ Шифрование 'взбиванием',
  стр 138 - 139 книги В.Жельникова "Криптография" }
 
uses Crt;
 
const Password = 231;
      Count    = 6;  { Количество перемешиваний (Count <= 6) }
 
var i, j, l, kg, kl, kr: byte;
    Key, ss, Sav, sc, sl, sr: string;
begin
  RandSeed:= Password;
  ClrScr;
  ss:= '';
  for i:= 1 to 64 do
    ss:= ss + Chr(65 + Random(25));
  Writeln(ss, ' - Text');
  Sav:= ss;
  Key:= '';
  for i:= 1 to 32 * Count do
    Key:= Key + Chr(Random(255));
  {--------------- Шифрование --------------}
  for i:= 0 to Count - 1 do begin
    sc:= Copy(Key, i shl 5 + 1, 32);
    l:= 1 shl i;
    sl:= '';
    sr:= '';
    for j:= 1 to 32 do begin
      kg:= Ord(sc[j]);
      kl:= Ord(ss[j]);
      kr:= Ord(ss[j + 32]);
      sl:= sl + Chr(kl xor kr);
      sr:= sr + Chr(kr xor kg);
    end;
    ss:= sr + Copy(sl, l, 255) + Copy(sl, 1, l - 1); { Перестановка }
  end;
  {-------------- Порча бита --------------}
  ss[1]:= Chr(Ord(ss[1]) xor 4);
  {-------------- Вывод на экран --------------}
  for i:= 1 to 64 do begin
    j:= Ord(ss[i]);
    Mem[$B80A:(2 * i - 2)]:= j;
  end;
  GotoXY(65, 2);
  Writeln(' - Code');
  {-------------- Расшифровывание --------------}
  for i:= Count - 1 downto 0 do begin
    sc:= Copy(Key, i shl 5 + 1, 32);
    l:= 1 shl i;
    { Обратная перестановка }
    ss:= Copy(ss, 66 - l, 255) + Copy(ss, 33, 33 - l) + Copy(ss, 1, 32);
    sl:= '';
    sr:= '';
    for j:= 1 to 32 do begin
      kg:= Ord(sc[j]);
      kl:= Ord(ss[j]);
      kr:= Ord(ss[j + 32]);
      sl:= sl + Chr(kl xor (kr xor kg));
      sr:= sr + Chr(kr xor kg);
    end;
    ss:= sl + sr;
  end;
  {-------------- Вывод на экран --------------}
  for i:= 1 to 64 do begin
    j:= Ord(ss[i]);
    Mem[$B814:(2 * i - 2)]:= j;
  end;
  GotoXY(65, 3);
  Writeln(' - Text');
  j:= 0;
  for i:= 1 to 64 do
    if ss[i] = sav[i] then Write('+')
    else begin
      Write('-');
      inc(j);
    end;
  Writeln;
  Writeln(j, ' errors');
end.
program Shuffle;
{ Шифрование тасовкой (стр 134 - 135 книги В.Жельникова "Криптография") }
uses Crt;
 
const Password = 13;
      S: string = 'Вверху синева и внизу откос';
var L, i: byte;
    ss: string;
    m, n, t: byte;
    Beg, Mid, Fin: string;
begin
  ClrScr;
  RandSeed:= Password;                   { Установка пароля }
  L:= Length(S);
  Writeln(s);                            { Вывод исходной строки           }
  Writeln;
  ss:= '';                               { Строка - шифратор, в ней        }
  for i:= 1 to L shl 1 do                { каждые 2 символа определяют     }
    ss:= ss + Chr(Random(L div 2));      { размер блока с конца и с начала }
  { Шифровка }
  i:= 2;
  while i <= Length(ss) do begin
    n:= Ord(ss[i - 1]);                  { Длина первого блока   }
    m:= Ord(ss[i]);                      { Длина второго блока   }
    Beg:= Copy(s, 1, n);                 { Первый блок           }
    Mid:= Copy(s, n + 1, l - m - n);     { Серединка             }
    Fin:= Copy(s, l - m + 1, 255);       { Второй блок           }
    s:= Fin + Mid + Beg;                 { Перетасовываем...     }
    inc(i, 2);
  end;
  Writeln(s);
  Writeln;
  { Расшифровка }                        { При расшифровке все   }
  i:= Length(SS);                        { производится с        }
  while i >= 1 do begin                  { точностью до наоборот }
    n:= Ord(SS[i - 1]);
    m:= Ord(SS[i]);
    Beg:= Copy(s, 1, m);
    Mid:= Copy(s, m + 1, l - m - n);
    Fin:= Copy(s, l - n + 1, 255);
    s:= Fin + Mid + Beg;
    dec(i, 2);
  end;
  Writeln(S);
end.
program XorCodeing; { Кодирование простой заменой }
 
const Password = 983100;
 
const Mess: string = 'Жили были старик со старухой.';
 
procedure CodeMess(var Mess: string);
var i: Word;
begin
  RandSeed:= Password;
  for i:= 1 to Length(Mess) do
    Mess[i]:= Char(Random(40) xor Byte(Mess[i]));
  Writeln(Mess);
end;
 
begin
  Writeln(Mess);
  CodeMess(Mess);
  CodeMess(Mess);
end.
program rsa; {Некий аналог RSA-КОДИРОВАНИЯ}
uses
 Crt;
 
var
 code,
 l : Integer;
 
 onebyte : Byte;
 oneword : Word;
 
 s,
 KeyFileName,
 OFileName,
 IFileName : String;
 n,m,
 d,e,
 p, q     : Word;
 
 WordFile : File of Word;
 ByteFile : File of Byte;
 KeyFile  : Text;
 
{Функция преобразования}
function G(x,e,n : Word) : Word;
var
 i,
 k,
 t    : Word;
begin
 k:=x;
 t:=x mod n;
 for i:=2   to e do
  t:=Word((Longint(t)*Longint(k)) mod Longint(n));
 G:=t;
end;{G}
 
{Проверить яв-ся ли число простым}
function IsSimple(x : Word) : boolean;
var
 c : LongInt;
 f : boolean;
begin
 c:=3;
 f:=True;
 f:= (x mod 2) <> 0;
 f:=f and (G(x-2, x-1, x) = 1);
 While f and (c < x) do
  begin
   f:=(x mod c) <> 0;
   c:=c+2;
  end;
 isSimple:=f;
end;{IsSimple}
 
 
{Сформировать коэффициенты p и q}
procedure MakeValue(Var p, q : Word);
begin
 Randomize;
 p:=Random(255);
 
 if p < (255/2+1)
  then
   p:=255-p;
 
 while Not IsSimple(p) do
  begin
   p:=Random(255);
   if p < (255/2+1)
    then
     p:=255-p;
  end;
 
 q:=Random(255);
 
 if q < (255/2+1)
  then
   q:=255-q;
 
 while Not IsSimple(q) do
  begin
   q:=Random(255);
   if q < (255/2+1)
    then
     q:=255-q;
  end;
 
 if p = q
  then
   MakeValue(p, q);
end;{MakeValue}
 
{Создать ключи}
procedure MakeKey(Var d,e : Word);
var
 k : LongInt;
begin
 MakeValue(p,q);
 repeat
  n:=p*q;
  m:=(p-1)*(q-1);
 
  e:=1;
  while  (m mod e =0) and (e1)
     and (dn;
end;
 
begin
 repeat
  ClrScr;
  WriteLn('1 - Шифровать файл...');
  WriteLn('2 - Расшифровать...');
  WriteLn('0 - Выход');
  ReadLn(l);
  case l of
   1:{Шифровать}
    begin
     ClrScr;
     WriteLn('Имя исходного файла: ');
     ReadLn(IFileName);
     WriteLn('Имя зашифрованного файла: ');
     ReadLn(OFileName);
     WriteLn('Имя файла для ключей: ');
     ReadLn(KeyFileName);
 
 
     MakeKey(d, e);
     WriteLn('p=',p,' q=',q);
     WriteLn('n=',n,' m=',m);
     WriteLn('d=',d,' e=',e);
 
     {Записать ключи в файл}
     Assign(KeyFile, KeyFileName);
     Rewrite(KeyFile);
     Str(d,s);
     WriteLn(KeyFile, s);
     Str(n,s);
     WriteLn(KeyFile, s);
     Close(KeyFile);
 
     {Зашифровать файл}
     Assign(ByteFile, IFileName);
     Assign(WordFile, OFileName);
     Rewrite(WordFile);
     Reset(ByteFile);
 
     while Not EOF(ByteFile) do
      begin
       Read(ByteFile, onebyte);
       oneword:=G(Word(onebyte), e, n);
       Write(WordFile, oneword);
      end;{while}
 
     Close(ByteFile);
     Close(WordFile);
    end;
   2:{Расшифровать}
    begin
     ClrScr;
     WriteLn('Имя зашифрованного файла: ');
     ReadLn(IFileName);
     WriteLn('Имя расшифрованного файла: ');
     ReadLn(OFileName);
     WriteLn('Имя файла ключей: ');
     ReadLn(KeyFileName);
 
 
     {Прочитать ключи из файла}
     Assign(KeyFile, KeyFileName);
     Reset(KeyFile);
     ReadLn(KeyFile, s);
     Val(s, d, code);
     ReadLn(KeyFile, s);
     Val(s, n, code);
     Close(KeyFile);
 
     {Расшифровать файл}
     Assign(WordFile, IFileName);
     Assign(ByteFile, OFileName);
     Rewrite(ByteFile);
     Reset(WordFile);
 
     while Not EOF(WordFile) do
      begin
       Read(WordFile, oneword);
       onebyte:=LO((G(oneword, d, n)));
       Write(ByteFile, onebyte);
      end;{while}
 
     Close(WordFile);
     Close(ByteFile);
    end;
  end;
  until l = 0;
end.




PHP — это язык программирования, основанный на использовании скриптов. Данный язык широко применяется для создания различных front-end и back-end веб-приложений. Поддерживается по-умолчанию большинством хостеров, являясь одним из лидеров среди языков программирования, предназначенных для создания динамических интерактивных сайтов.

Интересные материалы на сайте:

Рейтинг@Mail.ru     Автор, разработчик: Шаров Евгений   (gcmsite@yandex.ru)
(c) 2000-2017 GCM-Site - системное и веб-программирование
Цитирование материалов сайта возможно только при наличии гиперссылки