(495) 925-0049, ITShop интернет-магазин 229-0436, Учебный Центр 925-0049
  Главная страница Карта сайта Контакты
Поиск
Вход
Регистрация
Рассылки сайта
 
 
 
 
 

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

Источник: programmersclub

Сегодня я вам расскажу, как можно зашифровать файл с помощью пароля. Я напишу 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):

Буква пароля

Цифровой код

"q"

113

"w"

119

"e"

101

"r"

114

"t"

116

"y"

121

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

    С алгоритмом вроде разобрались, теперь надо подумать о функции, которая будет шифровать байт с помощью приращения. Самый простой способ это ксорить 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 - сообщите об этом редактору.



 Распечатать »
 Правила публикации »
  Обсудить материал в конференции Дискуссии и обсуждения общего плана »
Написать редактору 
 Рекомендовать » Дата публикации: 12.01.2010 
 

Магазин программного обеспечения   WWW.ITSHOP.RU
Quest Software. TOAD DB Admin module
SAP® Crystal Reports 2016 WIN INTL NUL
IBM DOMINO ENTERPRISE CLIENT ACCESS LICENSE AUTHORIZED USER LICENSE + SW SUBSCRIPTION & SUPPORT 12 MONTHS
Q 1.0 for Windows Single User
Oracle Data Access Components (ODAC) Standard single license
 
Другие предложения...
 
Курсы обучения   WWW.ITSHOP.RU
 
Другие предложения...
 
Магазин сертификационных экзаменов   WWW.ITSHOP.RU
 
Другие предложения...
 
3D Принтеры | 3D Печать   WWW.ITSHOP.RU
3D ручка Myriwell, голубая
CubeX Duo
MakerBot Replicator 5th GEN
PICASO 3D Designer (Желтый)
MakerBot Replicator 2
 
Другие предложения...
 
Новости по теме
 
Рассылки Subscribe.ru
Информационные технологии: CASE, RAD, ERP, OLAP
Новые материалы
Программирование на Microsoft Access
Краткие описания программ и ссылки на них
Delphi - проблемы и решения
Компьютерная библиотека: книги, статьи, полезные ссылки
Программирование на Visual Basic/Visual Studio и ASP/ASP.NET
 
Статьи по теме
 
Новинки каталога Download
 
Исходники
 
Документация
 
Обсуждения в форумах
Пишу программы на заказ профессионально (1944)
Пишу программы на заказ на языках Pascal (численные методы, списки, деревья, прерывания) под...
 
Разработка программ под заказ на Visual Basic/Delphi/PHP+MySQL/MS Access/MS SQL Server (46)
Доработка, модернизация и создание программ по заказу на Visual Basic/Visual...
 
Пишу программы на заказ для студентов (92)
Пишу для студентов на с, с++, паскаль в средах ms visual studio, qt, builder, borland c, delphi....
 
Помощь по MS Access (322)
Доброе время суток. Случайно оказался на этом сайте, искал статьи по OLAP. Вижу, что...
 
Уроки по JavaScript для новичков (1)
Всем привет! Вот хочу поделиться классным сайтом для начинающих изучать программирование на ...
 
 
 



    
rambler's top100 Rambler's Top100