Сжатие DFM ресурсов в Delphi программах
Захотелось мне как-то попробовать сжать ресурсы dfm форм своего приложения, плюсы довольно спорные (сложные формы могут содержать много графических ресурсов которые в dfm файле хранятся как буфер с bmp, который можно неплохо сжать, так же защита от просмотра и редактирования ресурсов форм), но ведь есть несколько программ позволяющих такое делать, значит кому-то нужно.Напишем приложение DFMCompressor, которое будет извлекать dfm ресурсы из exe файла, сжимать их и записывать обратно заменяя оригиналы.
Алгоритм работы компрессораКомпрессор находит dfm ресурсы и сжимает их. Всю его работу можно разложить на шаги: Извлечь все DFM ресурсы приложения
Сжать их Удалить из приложения найденные ресурсы
Записать сжатые ресурсы в приложение
Для единообразия дальнейшего кода реализации указанных шагов введем специальный тип, словарь, который будет содержать имя ресурса и его тело:
type
//Словарь содержащий имена DFM ресурсов и их содержимое
TDFMByNameDict = TObjectDictionary
EnumResourceNames — получение имен ресурсов UpdateResource — добавление/удаление ресурсов Так как мы будем работать с ресурсами только в контексте Delphi DFM ресурсов, то, чтобы упростить код, сделаем следующие допущения: Все операции относятся только к ресурсам типа 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
//Сожмем тело ресурсов 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, как будет работать на других версиях я не знаю, но думаю имея это руководство адаптировать не составит проблем.
