Защита данных от несанкционированного доступа

  Dispose(Dialog, Done);

end; 

{ Русифицированная функция формирования сообщения

                стандартного размера }

function MyMessageBox(const Msg: String;

           Params: Pointer; AOptions: Word): Word;

var

  R: TRect;

begin

  R.Assign(0, 0, 40, 9);

  MyMessageBox:= MyMessageBoxRect(R, Msg, Params, AOptions);

end; 

function GetCurDir: DirStr;

var

  CurDir: DirStr;

begin

  GetDir(0, CurDir);

  if Length(CurDir) > 3 then

    begin

      Inc(CurDir[0]);

      CurDir[Length(CurDir)]:= '\';

    end;

  GetCurDir:= CurDir;

end; 

{Процедура инициализации окна работы с файлами}

procedure TMyApp.FileOpen(WildCard: PathStr);

var

  FileName: FNameStr;

begin

  FileName:= '*.*';

  if ExecuteDialog(New(PMyFileDialog, Init(

    WildCard, 'Открыть файл', 'Имя', fdOpenButton,

    100)), @FileName) <> cmCancel then FName:=FileName;

    {открыть файл, потом...}

end; 

{****************************************************************************}

{*----------============= К Р И П Т О Г Р А Ф И Я ================----------*}

{****************************************************************************} 

{Шифрование файлов}

procedure Shifr(InputFileName: string);

const

  A = 5;     {Константы для}

  C = 27;    {генератора}

  M = 65536; {псевдослучайных чисел, далее - ПСЧ} 

var

  TempFile                : file of byte;

  InpF, OutF              : file of word; {файлы на входе и выходе}

  Password, Password1     : string; {переменные для работы с паролями}

  OutputFileName, Exten   : string; {переменные имен файлов}

  I, J, K, tmp            : byte; {переменные кодирования}

  Temp, SCode, TByte, Code: word;

  Position                : LongInt; {переменные данных о процессе}

  NowPos                  : real;

  TPassword               : array [1..255] of word;

  MasByte, Mas, MasEnd, PS: array [1..64] of word; {массивы перестановок}

  T                       : array [0..64] of word;

  DirInfo, DirInfo1       : SearchRec; {данные о файле}

begin

  if length(FName) > 3 then {Файл выбран?}

    begin

      {Получить пароль}

      Password := '';

      Password1 := '';

      InputBox('П А Р О Л Ь', '        Введите пароль:', Password, 255);

      InputBox('П А Р О Л Ь', 'Введите пароль еще раз:', Password1, 255);

      if (Password = Password1) and (length(Password)<>0) then 

        begin

          {Преобразовать файл}

          FindFirst(InputFileName, AnyFile, DirInfo);

          if DOSError = 0 then

            begin

              if DirInfo.Size mod 2 = 1 then

                begin

                  assign(TempFile, InputFileName);

                  reset(TempFile);

                  while not EOF(TempFile) do read(TempFile, tmp);

                  tmp := 255;

                  write(TempFile, tmp);

                  close(TempFile);

                end;

              {Преобразовать имя файла}

              Position := 0;

              assign(InpF, InputFileName);

              reset(InpF);

              for i := length(InputFileName) downto 1 do

                if InputFileName[i] = '.' then

                  begin

                    OutputFileName := copy(InputFileName, 1, i) + 'M&A';

                    break;

                  end;

              assign(OutF, OutputFileName);

              rewrite(OutF);

              for i:= 0 to length(InputFileName) do

                if InputFileName[length(InputFileName) - i] = '.' then

                  case i of

                    0: Exten := chr(0) + chr(0) + chr(0);

                    1: Exten := copy(FName, length(FName)-2, i) + chr(0) + chr(0);

                    2: Exten := copy(FName, length(FName)-2, i) + chr(0)

                    else Exten := copy(FName, length(FName)-2, 3)

                  end;

              for i := 1 to 3 do

                begin

                  Temp := ord(Exten[i]);

                  Write(OutF, Temp);

                end;

              {Начать шифрование}

              k := 1;

              repeat

                begin

                  {Считать из исходного файла блок размером 64*word}

                  for i:=1 to 64 do

                    If EOF(InpF) then MasByte[i] := 0 else Read(InpF, MasByte[i]);

                  Mas := MasByte;

                  T[0] := ord(Password[k]);

                  if k < length(Password) then inc(k) else k := 1;

                  for i:= 1 to 64 do

                    begin

                      {Получить текущую позицию процесса}

                      NowPos := 100*Position/DirInfo.Size;

                      inc(Position, 2);

                      if NowPos > 100 then NowPos := 100;

                      Str(Round(NowPos):3, Pos);

                      if OptInd = 0 then

                        begin

                          GoToXY(77, 1);

                          Write(Pos + '%');

                        end;

                      {Шифровать с помощью ПСЧ}

                      Code:=Mas[i];

                      T[i] := (A * T[i-1] + C) mod M;

                      Code:=T[i] xor Code;

                      Mas[i] := Code;

                    end; 

                  for i:=1 to 8 do { Конечная перестановка }

                    for j:=1 to 8 do

                      case i of

                        1: MasEnd[8*(j-1)+i] := Mas[41-j];

                        2: MasEnd[8*(j-1)+i] := Mas[09-j];

                        3: MasEnd[8*(j-1)+i] := Mas[49-j];

                        4: MasEnd[8*(j-1)+i] := Mas[17-j];

                        5: MasEnd[8*(j-1)+i] := Mas[57-j];

                        6: MasEnd[8*(j-1)+i] := Mas[25-j];

                        7: MasEnd[8*(j-1)+i] := Mas[65-j];

                        8: MasEnd[8*(j-1)+i] := Mas[33-j]

                      end;

              for i:= 1 to 64 do Write(OutF, MasEnd[i]);

            end;

          until eof(InpF);

          MyMessageBox('Файл '+ InputFileName + ' зашифрован с именем ' +

                       OutputFileName, nil, mfInformation+mfOkButton);

          Close(InpF);

          if OptFile = 1 then Erase(InpF);

          Close(OutF);

        end

          else  MyMessageBox('Файл '+ InputFileName + ' не существует!',

                   nil, mfInformation+mfOkButton); 

        end

      else MyMessageBox('      Ошибка ввода пароля!!!', nil,

                        mfError+mfOkButton);

    end

  else MyMessageBox('          Файл не выбран!!!', nil, mfError+mfOkButton);

end; 
 

procedure DeShifr(InputFileName: String);

const

  A = 5;

  C = 27;

  M = 65536; 

var

  InpF, OutF                   : file of word;

  Password, OutputFileName     : string;

  Password1                    : string;

  Exten                        : string[3];

  SCode, Temp, Ext, TByte, Code: word;

  I, J, K                      : byte;

  Position                     : LongInt;

  NowPos                       : real;

  TPassword                    : array [1..255] of word;

  MasByte, Mas, MasEnd, PS     : array [1..64] of word;

  T                            : array [0..64] of word;

  DirInfo                      : SearchRec; 

begin

  if (length(InputFileName) > 3) and

    (copy(InputFileName, length(InputFileName)-2, 3) = 'M&A') then

    begin

      Password := '';

      Password1 := '';

      InputBox('П А Р О Л Ь', '        Введите пароль:', Password, 255);

      InputBox('П А Р О Л Ь', 'Введите пароль еще раз:', Password1, 255);

      if (Password = Password1) and (length(Password)<>0) then