Compression of DFM resources in Delphi programs

    I wanted to somehow try to compress the dfm resources of the forms of my application, the advantages are quite controversial (complex forms can contain many graphic resources that are stored in the dfm file as a buffer with bmp, which can be compressed quite well, as well as protection from viewing and editing form resources), but there are several programs that allow you to do this, so someone needs to.

    We will write a DFMCompressor application that will extract dfm resources from an exe file, compress them and write back replacing the originals.

    Compressor Algorithm


    The compressor finds dfm resources and compresses them. All his work can be decomposed into steps:
    • Extract all application DFM resources
    • Squeeze them
    • Delete found resources from the application
    • Write compressed resources to the application

    To ensure uniformity of the further implementation code for these steps, we introduce a special type, a dictionary, which will contain the name of the resource and its body:

    type
      //Словарь содержащий имена DFM ресурсов и их содержимое 
      TDFMByNameDict = TObjectDictionary;


    Most of the compressor is tied to working with exe file resources. The Windows API contains functions for working with resources , we need two main functions:
    • EnumResourceNames - getting resource names
    • UpdateResource - add / remove resources

    Since we will work with resources only in the context of Delphi DFM resources, we will make the following assumptions to simplify the code:
    • All operations apply only to resources of type RT_RCDATA
    • LangId of resources is always used 0, since it is such a LangId in dfm forms

    Search DFM Resources


    The algorithm is simple, let’s go through all the resources from RT_RCDATA, and check whether they are DFM resources.

    DFM resources have a signature, the first 4 bytes contain the string 'TPF0', we will write a function to check:

    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;
    

    Now, knowing how to distinguish DFM resources from the rest, we will write a function to get them:

    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;
    

    Compress the contents of the found resources


    We will reap using Zlib, here such a function compresses 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;
    

    Now it’s easy to write a procedure that will compress all the resources from our list:

    procedure CompressDFMs(DFMs: TDFMByNameDict);
    var
      Stream: TMemoryStream;
    begin
      for Stream in DFMs.Values do
        ZCompressStream(Stream);
    end;
    

    Resource Removal


    To delete a resource, you need to call the UpdateResource function and pass a null pointer to the data into it. But the thing is that resource deletion is implemented in such a way that it does not reduce the exe file, Windows simply deletes the resource record from the resource table, and the place the resource occupied remains and is not redistributed anywhere. Our goal is not only to encrypt dfm's, but also to reduce the overall size of the program on their compression, so the Win API will not help. Good is the decision of the library madBasic madCollection contains a module madRes.pas , which carried on the work with the resources functions, including the removal of resources, in this case the authors have tried and made a function call syntax compatible with Windows API, for which a special thank you.

    Knowing all this, the procedure for deleting resources is as follows:

    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;

    Add resources to the application


    Adding resources is no more difficult than deleting, here is the code:

    //Добавление ресурсов в EXE файл
    procedure AddDFMs(const FileName: string; DFMs: TDFMByNameDict);
    var
      Handle: THandle;
      Item: TPair;
    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;

    I think the code of questions will not cause. We disassembled and wrote the code for all the steps of our algorithm, it's time to build an application that implements the necessary functionality.

    Compressor finishing touches


    We will write the main procedure that will implement all the above steps together:

    //Основная рабочая процедура
    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;

    Actually, it’s already quite possible to build the application. Let's create a new console application project in Delphi, save it with the name dfmcompressor.dpr and make a program:

    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.

    We collect, set vcl application on some thread, and it works!

    Resources are compressed, but the program now crashes, not surprisingly, because vcl does not know that resources are now compressed.

    We teach the program to use compressed DFM resources


    It's time to create a test application on which experiments will be conducted. Let's create a new empty VCL project, write in the project properties so that it is processed by dfmcompressor after compilation, so that you can debug delphi modules, you need to enable the use of debug dcu in the project properties.

    We start, die with the exception, and we can study on the stack how the management got to loading the form.

    Actually, the stack shows that the classes.InternalReadComponentRes procedure was called in which the loading of resources takes place:

    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;
    


    Well, let's try to make changes. To do this, copy classes.pas into the directory with our test application (so that the compiled file is picked up during compilation), and modify the specified procedure so that the file is unpacked:

    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;

    You also need to remember to add the Zlib module to the uses section of the implementation section.
    Build, run, it works!

    We develop the idea


    It seems that everything works - but to drag the changed classes.pas with the application is an extreme measure, let's try to do something. Ideally, put a hook on the InternalReadComponentRes function and redirect its call to its implementation.

    A hook is made very simple by forming a long jump command on its function, and inserting it at the beginning of InternalReadComponentRes. Yes, with this approach, vcl will no longer be able to call its InternalReadComponentRes, but we do not need this. We write the interception setting function:

    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;

    It just doesn’t work that way, because the definition of the InternalReadComponentRes procedure is missing in the interface section, which means we can’t find the pointer to it.

    Returning to the form loading stack and examining it, you can see that InternalReadComponentRes is called from InitInheritedComponent, which is a public function, and which can be intercepted. It also plays into the hands of the fact that InitInheritedComponent does not call a single private function from classes.pas (of course, except for the one we are changing), which means that code duplication will be minimal.

    We implement everything in the module, by connecting which the program will learn to read compressed resources to the project:

    {
      Модуль добавляет поддержку сжатых 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.

    Conclusion


    All this works and was tested on Delphi 2010, I don’t know how it will work on other versions, but I think having this guide to adapt will not be a problem.

    Also popular now: