Шифрование файла при помощи пароля в Delphi (исходники, download)

Сегодня я вам расскажу, как можно зашифровать файл с помощью пароля. Я напишу 2 функции, которые всё это делают (разумеется, одна функция будет зашифровывать, а другая расшифровывать) и засуну их в отдельный модуль, чтобы ими было проще пользоваться.

    Итак, приступим.
    Сначала немного теории. Какой же алгоритм шифровки я буду использовать? Алгоритм очень прост.

1. Открываем файл источник
2. Создаём файл назначение
3. дальше число n будет изменяться от 1 до <размер файла>
4. Читаем n-байт файла в некую переменную xn 5
5. Вычисляем параметр изменения этой переменной - dx, которое будет вычисляться по формуле dx=ord(пароль[index]), где index= n mod <длина пароля>.
6. Зашифровываем переменную xn с помощью некой функции xk=cript(xn,dx)
7. Записываем в n-байт файла назначения переменную xk.
8. Закрываем оба файла. И если надо, удаляем искомый файл.

    Согласно этому алгоритму не трудно понять, каким будет алгоритм расшифровки. Он будет точно таким же только с тем отличием, что вместо некоторой функции cript будет применяться функция ей обратная. Поясню данный алгоритм на таблице, допустим, что пароль будет равен "qwerty", схема шифровки будет такая (напомню, что функция ord возвращает цифровой код буквы в кодировке ANSI):

    Для лучшего понимания, в таблице я не буду указывать цифровые коды букв пароля, я просто укажу сами буквы. Разумеется, под буквами понимается их цифровой код.

    С алгоритмом вроде разобрались, теперь надо подумать о функции, которая будет шифровать байт с помощью приращения. Самый простой способ это ксорить xn и dx. Вот так: 

  xk:=xn xor dx;

    Этот способ примечателен тем, что для него не нужно создавать способа дешифровки, потому что декриптор ксора - это тот же ксор.

   xk:=xn xor dx; 
  xdk:=xk xor dx;

    После всех этих манипуляций xdk будет равно xn. Следовательно, для расшифровки нам не надо создавать декриптор.

     Шифровать с помощью ксора примитивно и просто. Есть более лучший метод. Можно просто к начальному значению байта прибавлять значение dx, а при расшифровке вычитать. По-моему этот метод лучше и оригинальнее. НО здесь тоже есть загвоздка. Проблема в том, что максимальное значение байта 28 это 256, но у нас есть ещё и ноль, значит диапазон значений байта [0..255]. Следовательно, если начальное значение байта было равно 245, а приращение равно 45, и если их сложить то получается 290, и присваивании такого значения переменной размером с байт, произойдёт переполнение и просто-напросто ей присвоится 0. Есть выход: можно просто брать остаток от 256. При расшифровке смотреть если dx больше чем xn, то просто сначала из xn вычесть dx, а потом прибавить 256. Вот эти 2 функции:

function plus(xn,dx:byte):byte;
begin
   result:=(xn+dx) mod 256;
end;

function minus(xn,dx:byte):byte;
begin
   if xn>=dx then
   result:=xn-dx
         else
   result:=xn-dx+256;
end;

    Вот и у нас есть криптор и декриптор. Теперь приступим к написанию самих функции шифровки и расшифровки.

    Сначала напишем криптор.

Function CriptFile( 
                        SourceFile:string; //наверное 
                        DestFile:string; // это понятно 
                        Password:string; //пароль шифровки 
                        Flags:DWORD; //флаги операции 
                        aGauge:pointer //указатель на прогресс 
                        ):boolean;
label
   1; //пригодится
var
   DestHFile,SourceHFile:THandle;
   FSize,i,j,kl,n:DWORD;
   CurrentByte:byte;
   one_byte_mass,all_mass:real;
begin
   Result:=false;
   kl:=length(Password);

   ACF_AutoRename :=(Flags and CF_AutoRename) = CF_AutoRename;
   ACF_DeleteSource :=(Flags and CF_DeleteSource) = CF_DeleteSource;
   ACF_Dest_NOT_CREATE :=(Flags and CF_Dest_NOT_CREATE) = CF_Dest_NOT_CREATE;
   ACF_ShowProgress :=(Flags and CF_ShowProgress) = CF_ShowProgress;

    Обрабатывает флаги которые мы приняли и потом их обрабатываем. Константы CF_* и переменные ACF_* опишу позже.

if ACF_AutoRename then
   begin
{если автоматическое переименование то добаляем ещё одно расширение}
   DestFile:=SourceFile+".cript";
{если автоматически переименовывать, то файл нащначение надо создавать в любом случае}
   ACF_Dest_NOT_CREATE:=false;
   end;
if ACF_Dest_NOT_CREATE then
   begin
     DestFile:="c:\3D9D8F57C3274EF3A6E7C5D5B27ADCF0.dat";
     ACF_DeleteSource:=false;
end;

    Здесь я поясню подробнее. Константа CF_Dest_NOT_CREATE говорит функции, что шифровать надо в искомый файл, то есть искомый файл, и файл назначение совпадают. Но промежуточный файл нужен в любом случае, поэтому мы его создаём на диске С:, потом мы заменим искомый файл этим промежуточным, и промежуточный потом удалим.

    all_mass:=0;//эта переменная нужна для прогресса
   SourceHFile:=CreateFile(pchar(SourceFile),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0);
   if SourceHFile=INVALID_HANDLE_VALUE then
      Exit; {это думаю понятно: если файл не открылся, то вылетаем}
   DestHFile:=CreateFile(pchar(DestFile),GENERIC_WRITE,FILE_SHARE_READ,nil,CREATE_ALWAYS,0,0);
   if DestHFile=INVALID_HANDLE_VALUE then
      Exit;
   FSize:=GetFileSize(SourceHFile,nil);
   if ACF_ShowProgress then
   if aGauge=nil then
   {это на тот случай, если гаугэ забыли указать}
      ACF_ShowProgress:=false
          Else
   { всё правильно: гаугэ указали, получаем вес одного байта в прогрессе гаугэ}
      one_byte_mass:=(TGauge(aGauge^).MaxValue-TGauge(aGauge^).MinValue)/FSize;

    Дальше идёт алгоритм отличный от того, который я указывал в начале, но он выполняет тоже самое только быстрее. Он быстрее, потому что он не вычисляет номер буквы, которую надо брать из пароля, она берётся сама по себе, согласно номеру повтора во внутреннем цикле.

   for i:=1 to (FSize div kl)+1 do
     for j:=1 to kl do
       begin
         ReadFile(SourceHFile,CurrentByte,1,n,0);
{если ничего не считалось, то значит это конец файла}
     if n=0 then goto 1;
     CurrentByte:=plus(CurrentByte,ord(password[j]));
     WriteFile(DestHFile,Currentbyte,1,n,0);
     if ACF_ShowProgress then
        begin
          all_mass:=all_mass+one_byte_mass;
          TGauge(aGauge^).Progress:=round(all_mass);
        end;
     end;
   1:

   CloseHandle(SourceHFile);
   CloseHandle(DestHFile);
{если надо удалить источник, то удаляем, если надо не надо создавать назначение, то производим необходимые манипуляции}
   if ACF_DeleteSource then
      DeleteFile(pchar(SourceFile));
   if ACF_Dest_NOT_CREATE then
      begin
        if not DeleteFile(pchar(SourceFile))then exit;
        CopyFile(pchar(DestFile),pchar(SourceFile),false);
        if not DeleteFile(pchar(DestFile)) then exit;
      end;
   Result:=true;//всё завершилось хорошо
end;

    Вот константы, которые я использовал в этой функции (изменять их нерекомендуется):

const
   CF_AutoRename = $00000001;
   CF_DeleteSource = $00000002;
   CF_Dest_NOT_CREATE = $00000008;
   CF_ShowProgress = $00000010;

implementation

uses …………;

var
   ACF_AutoRename:boolean;
   ACF_DeleteSource:boolean;
   ACF_Dest_NOT_CREATE:boolean;
   ACF_ShowProgress:boolean;
Их надо описывать именно так: константы до implementation, а переменные после.

    Функции. DeCriptFile я не буду описывать, потому что она точно такая же, всего лишь за двумя отличиями:

if ACF_AutoRename then
   begin
     DestFile:=copy(SourceFile,1,length(SourceFile)-6);
     ACF_Dest_NOT_CREATE:=false;
   end;

и разумеется:
CurrentByte:=minus(CurrentByte,ord(password[j]));

    Кстати о флагах. Их можно комбинировать с помощью оператора or.
    Вот пример использования этих функций:

procedure TForm1.Button1Click(Sender: TObject);
begin
   CriptFile(Edit1.Text,","123′,CF_AutoRename or CF_ShowProgress or
                                                      CF_DeleteSource,@Gauge1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   DeCriptFile(Edit2.Text,","123′,CF_AutoRename or
                            CF_ShowProgress,@Gauge1);
end;

    Короче всё смотрите в исходниках. Там всё есть. Копируете этот модуль в расшаренную для дельфи папку, добавляете в выражение uses модуль FileCript и пользуетесь им на здоровье.

Шифрование файла при помощи пароля в Delphi

В каталоге Download Вы можете найти другие полезные материалы - утилиты, программы, документацию, исходники, электронные книги. Если Вы обнаружили неработающую ссылку, пожалуйста, помогите другим посетителям и администратору каталога Download - сообщите об этом редактору.