Захотелось мне как-то попробовать сжать ресурсы dfm форм своего приложения, плюсы довольно спорные (сложные формы могут содержать много графических ресурсов которые в dfm файле хранятся как буфер с bmp, который конечно хочется сжать, так же защита от просмотра и редактирования ресурсов форм), но ведь есть несколько программ позволяющих такое делать, значит кому-то нужно.
Напишем приложение DFMCompressor, которое будет извлекать dfm ресурсы из exe файла, сжимать их и записывать обратно заменяя оригиналы.
DFM ресурсы имеют сигнатуру, первые 4 байта содержат строку 'TPF0', напишем функцию чтобы проверять:
Зная все это процедура удаления ресурсов получилась такой:
Ресурсы сжались, но программа теперь вылетает, не мудрено, ведь vcl не знает что ресурсы теперь сжаты.
Так же, чтобы можно было отлаживать модули delphi, нужно включить в свойствах проекта использование отладочных dcu.
Запускаем, умираем с исключением, и можем по стеку изучить как дошло управление до загрузки формы:
Собственно по стэку видно что вызывалась процедура classes.InternalReadComponentRes в которой и происходит загрузка ресурсов:
Что же, попробуем внести изменения. Для этого скопируем classes.pas в каталог с нашим тестовым приложением (чтобы при компиляции подхватывался измененный файл), и модифицируем указанною процедуру так, чтобы происходила распаковка файла:
Хук делается очень просто формированием команды длинного jump'а на свою функцию, и вставкой его в начало InternalReadComponentRes. Да, таким подходом vcl не сможет больше вызвать свой InternalReadComponentRes, но нам этого и не надо. Пишем функцию установки перехвата:
Вернувшись к стеку загрузки формы и изучив его, видно что InternalReadComponentRes вызвана из InitInheritedComponent, которая является публичной функцией, и на которую можно поставить перехват. Так же играет на руку то, что InitInheritedComponent не вызывает ни одной приватной функции из classes.pas (разумеется кроме той что мы меняем), а значит дублирование кода будет минимальным.
Реализуем все в модуле, подключив который к проекту программа научится читать сжатые ресурсы:
----
Виктор Вик Федоренков
Напишем приложение DFMCompressor, которое будет извлекать dfm ресурсы из exe файла, сжимать их и записывать обратно заменяя оригиналы.
Алгоритм работы компрессора
Компрессор находит dfm ресурсы и сжимает их. Всю его работу можно разложить на шаги:- Извлечь все DFM ресурсы приложения
- Сжать их
- Удалить из приложения найденные ресурсы
- Записать сжатые ресурсы в приложение
type //Словарь содержащий имена DFM ресурсов и их содержимое TDFMByNameDict = TObjectDictionary<string, TMemoryStream>;Большая часть компрессора завязана на работу с ресурсами exe файла. Windows API содержит функции для работы с ресурсами, нам понадобятся две основные функции:
- EnumResourceNames - получение имен ресурсов
- UpdateResource - добавление/удаление ресурсов
- Все операции относятся только к ресурсам типа RT_RCDATA
- LangId ресурсов всегда используется 0, так как именно такой LangId у dfm форм
Поиск DFM ресурсов
Алгоритм простой, пройдем по всем ресурсам из RT_RCDATA, и проверим являются ли они DFM ресурсами.DFM ресурсы имеют сигнатуру, первые 4 байта содержат строку 'TPF0', напишем функцию чтобы проверять:
function IsDfmResource(Stream: TStream): Boolean; const FilerSignature: array [1..4] of AnsiChar = AnsiString('TPF0'); var Signature: LongInt; begin Stream.Position := 0; stream.Read(Signature, SizeOf(Signature)); Result := Signature = LongInt(FilerSignature); end;Теперь, умея отличать DFM ресурсы от остальных напишем функцию получения их:
function LoadDFMs(const FileName: string): TDFMByNameDict; //Callback-функция для перечисления имен ресурсов //вызывается когда найден очередной ресурс указанного типа function EnumResNameProc(Module: THandle; ResType, ResName: PChar; lParam: TDFMByNameDict): BOOL; stdcall; var ResStream: TResourceStream; begin Result := True; //Откроем ресурс ResStream := TResourceStream.Create(Module, ResName, ResType); try //Если это не DFM выходим if not IsDfmResource(ResStream) then Exit; //Если DFM ресурс, то скопируем его тело в результирующий список lParam.Add(ResName, TMemoryStream.Create); lParam[ResName].CopyFrom(ResStream, 0); finally FreeAndNil(ResStream); end; end; var DllHandle: THandle; begin Result := TDFMByNameDict.Create([doOwnsValues]); try DllHandle := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE); Win32Check(DllHandle <> 0); try EnumResourceNamesW(DllHandle, RT_RCDATA, @EnumResNameProc, Integer(Result)); finally FreeLibrary(DllHandle); end; except FreeAndNil(Result); raise; end; end;
Cжимаем содержимое найденных ресурсов
Жать будем с помощью Zlib, вот такая функция сжимает TMemoryStream:procedure ZCompressStream(Source: TMemoryStream); var pOut: Pointer; outSize: Integer; begin ZCompress(Source.Memory, Source.Size, pOut, outSize, zcMax); try Source.Size := outSize; Move(pOut^, Source.Memory^, outSize); Source.Position := 0; finally FreeMem(pOut); end; end;Теперь легко написать процедуру которая будет сжимать все ресурсы из нашего списка:
procedure CompressDFMs(DFMs: TDFMByNameDict); var Stream: TMemoryStream; begin for Stream in DFMs.Values do ZCompressStream(Stream); end;
Удаление ресурсов
Чтобы удалить ресурс нужно вызвать функцию UpdateResource и передать в нее пустой указатель на данные. Но штука в том, что удаление ресурсов реализовано так, что оно не уменьшает exe файл, Windows просто удаляет запись о ресурсе из таблицы ресурсов, при этом место который занимал ресурс остается и никуда не перераспределяется. У нас цель не просто зашифровать dfm'ки, но и уменьшить на их сжатии общий размер программы, поэтому Win API не поможет. Благо есть решение, библиотека madBasic из madCollection содержит модуль madRes.pas, в котором реализованы функции по работе с ресурсами, в том числе и удаление ресурсов, при этом авторы постарались и сделали вызов функций совместимым по синтаксису с Windows API, за что отдельное спасибо.Зная все это процедура удаления ресурсов получилась такой:
procedure DeleteDFMs(const FileName: string; DFMs: TDFMByNameDict); var ResName: string; Handle: THandle; begin Handle := MadRes.BeginUpdateResourceW(PChar(FileName), False); Win32Check(Handle <> 0); try for ResName in DFMs.Keys do Win32Check(MadRes.UpdateResourceW(Handle, RT_RCDATA, PChar(ResName), 0, nil, 0)); finally Win32Check(MadRes.EndUpdateResourceW(Handle, False)); end; end;
Добавляем ресурсы в приложение
Добавить ресурсы не сложнее чем удалить, вот код://Добавление ресурсов в EXE файл procedure AddDFMs(const FileName: string; DFMs: TDFMByNameDict); var Handle: THandle; Item: TPair<string, TMemoryStream>; begin Handle := BeginUpdateResource(PChar(FileName), False); Win32Check(Handle <> 0); try for Item in DFMs do Win32Check(UpdateResource(Handle, RT_RCDATA, PChar(Item.Key), 0, Item.Value.Memory, Int64Rec(Item.Value.Size).Lo)); finally Win32Check(EndUpdateResource(Handle, False)); end; end;Я думаю код вопросов не вызовет. Мы разобрали и написали код для всех шагов нашего алгоритма, самое время собрать приложение реализующее нужный функционал.
Финальные штрихи компрессора
Напишем основную процедуру которая будет реализовывать все вышеописанные шаги вместе взятые://Основная рабочая процедура procedure ExecuteApplication(const FileName: string); var DFMs: TDFMByNameDict; begin //Получим все DFM ресурсы из файла DFMs := LoadDFMs(FileName); try //Если таких не найдено, выходим if DFMs.Count = 0 then Exit; //Сожмем тело ресурсов CompressDFMs(DFMs); //Удалим найденные ресурсы из файла DeleteDFMs(FileName, DFMs); //Запишем вместо них новые, сжатые AddDFMs(FileName, DFMs); finally FreeAndNil(DFMs); end; end;Собственно уже вполне можно собрать приложение. Создадим в Delphi новый проект консольного приложения, сохраним его с именем dfmcompressor.dpr и сделаем программу:
program dfmcompressor; {$APPTYPE CONSOLE} uses Windows, SysUtils, Classes, Generics.Collections, ZLib, madRes; // // Тут должны располагаться все вышенаписанные процедуры // begin try ExecuteApplication(ParamStr(1)); Writeln('Done.') except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; end.Собираем, натравливаем на какое-нить vcl приложение, и оно работает!
Ресурсы сжались, но программа теперь вылетает, не мудрено, ведь vcl не знает что ресурсы теперь сжаты.
Учим программу использовать сжатые DFM ресурсы
Пора создать тестовое приложение, на котором и будут проводится эксперименты. Создадим новый пустой VCL проект, в свойствах проекта пропишем чтобы он после компиляции обрабатывался dfmcompressor'ом:Так же, чтобы можно было отлаживать модули delphi, нужно включить в свойствах проекта использование отладочных dcu.
Запускаем, умираем с исключением, и можем по стеку изучить как дошло управление до загрузки формы:
Собственно по стэку видно что вызывалась процедура classes.InternalReadComponentRes в которой и происходит загрузка ресурсов:
function InternalReadComponentRes(const ResName: UnicodeString; HInst: THandle; var Instance: TComponent): Boolean; overload; var HRsrc: THandle; begin { avoid possible EResNotFound exception } if HInst = 0 then HInst := HInstance; HRsrc := FindResourceW(HInst, PWideChar(ResName), PWideChar(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;
Что же, попробуем внести изменения. Для этого скопируем classes.pas в каталог с нашим тестовым приложением (чтобы при компиляции подхватывался измененный файл), и модифицируем указанною процедуру так, чтобы происходила распаковка файла:
function InternalReadComponentRes(const ResName: UnicodeString; HInst: THandle; var Instance: TComponent): Boolean; overload; var Signature: Longint; ResStream: TResourceStream; DecompressStream: TDecompressionStream; begin Result := True; if HInst = 0 then HInst := HInstance; if FindResource(HInst, PChar(ResName), PChar(RT_RCDATA)) = 0 then Exit(False); ResStream := TResourceStream.Create(HInst, ResName, RT_RCDATA); try //Проверим, сжат ли стрим //Если есть стандартная DFM сигнатура, значит он не сжат ResStream.Read(Signature, SizeOf(Signature)); //Восстановим указатель ResStream.Position := 0; //Если есть сигнатура, значит считем что поток не сжат if Signature = Longint(FilerSignature) then Instance := ResStream.ReadComponent(Instance) else begin //Ну а если нет сигнатуры, то распакуем DFM DecompressStream := TDecompressionStream.Create(ResStream); try Instance := DecompressStream.ReadComponent(Instance); finally FreeAndNil(DecompressStream); end; end; finally FreeAndNil(ResStream); end; end;Так же нужно не забыть добавить модуль Zlib в раздел uses секции implementation Собираем, запускаем - все работает!
Развиваем идею
Вроде все работает - но таскать с приложением измененный classes.pas это крайняя мера, попробуем что-нибудь сделать. В идеале бы поставить хук на функцию InternalReadComponentRes и перенаправлять ее вызов на свою реализацию.Хук делается очень просто формированием команды длинного jump'а на свою функцию, и вставкой его в начало InternalReadComponentRes. Да, таким подходом vcl не сможет больше вызвать свой InternalReadComponentRes, но нам этого и не надо. Пишем функцию установки перехвата:
type PJump = ^TJump; TJump = packed record OpCode: Byte; Distance: Pointer; end; procedure ReplaceProcedure(ASource, ADestination: Pointer); var NewJump: PJump; OldProtect: Cardinal; begin if VirtualProtect(ASource, SizeOf(TJump), PAGE_EXECUTE_READWRITE, @OldProtect) then try NewJump := PJump(ASource); NewJump.OpCode := $E9; NewJump.Distance := Pointer(Integer(ADestination) - Integer(ASource) - 5); FlushInstructionCache(GetCurrentProcess, ASource, SizeOf(TJump)); finally VirtualProtect(ASource, SizeOf(TJump), OldProtect, @OldProtect); end; end;Вот только не получится так, ведь определение процедуры InternalReadComponentRes отсутствует в интерфейсной секции, а значит узнать указатель на нее мы не можем.
Вернувшись к стеку загрузки формы и изучив его, видно что InternalReadComponentRes вызвана из InitInheritedComponent, которая является публичной функцией, и на которую можно поставить перехват. Так же играет на руку то, что InitInheritedComponent не вызывает ни одной приватной функции из classes.pas (разумеется кроме той что мы меняем), а значит дублирование кода будет минимальным.
Реализуем все в модуле, подключив который к проекту программа научится читать сжатые ресурсы:
{ Модуль добавляет поддержку сжатых DFM ресурсов в приложение } unit DFMCompressorSupportUnit; interface uses Windows, SysUtils, Classes, ZLib; implementation const //Скопировано из classes.pas FilerSignature: array[1..4] of AnsiChar = AnsiString('TPF0'); // // Тут должны распологаться вышенаписанные ReplaceProcedure и // наша реализация InternalReadComponentRes // //Скопировано из classes.pas function InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean; function InitComponent(ClassType: TClass): Boolean; begin Result := False; if (ClassType = TComponent) or (ClassType = RootAncestor) then Exit; Result := InitComponent(ClassType.ClassParent); Result := InternalReadComponentRes(ClassType.ClassName, FindResourceHInstance(FindClassHInstance(ClassType)), Instance) or Result; end; var LocalizeLoading: Boolean; begin GlobalNameSpace.BeginWrite; // hold lock across all ancestor loads (performance) try LocalizeLoading := (Instance.ComponentState * [csInline, csLoading]) = []; if LocalizeLoading then BeginGlobalLoading; // push new loadlist onto stack try Result := InitComponent(Instance.ClassType); if LocalizeLoading then NotifyGlobalLoading; // call Loaded finally if LocalizeLoading then EndGlobalLoading; // pop loadlist off stack end; finally GlobalNameSpace.EndWrite; end; end; initialization ReplaceProcedure(@Classes.InitInheritedComponent, @InitInheritedComponent); end.
Заключение
Все это работает и тестировалось на Delphi 2010, как будет работать на других версиях я не знаю, но думаю имея это руководство адаптировать не составит проблем.----
Виктор Вик Федоренков
А не могли бы Вы привести цифры? Сколько занимал у Вас экзешник до сжатия ресурсов и после...
ОтветитьУдалитьНе так много как думал, всего несколько процентов, но формы которые содержат картинки (хранящиеся в ресурсах в виде bmp) сжимает неплохо
Удалить