📜 ⬆️ ⬇️

Compressing DFM resources in Delphi programs

I wanted to somehow try to compress the resources of the dfm 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 quite well compressed, as well as protection from viewing and editing form resources) but there are several programs that allow you to do this, so someone needs it.

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

Compressor operation algorithm


The compressor finds dfm resources and compresses them. All his work can be decomposed into steps:

For consistency of the following code for the implementation of these steps, we introduce a special type, a dictionary that will contain the name of the resource and its body:

type //   DFM     TDFMByNameDict = TObjectDictionary<string, TMemoryStream>; 

')
Most of the compressor is tied to work with resources exe file. The Windows API contains functions for working with resources ; we will need two main functions:

Since we will work with resources only in the context of Delphi DFM resources, in order to simplify the code, we will make the following assumptions:

DFM resource lookup


The algorithm is simple, go through all the resources from RT_RCDATA, and check if they are DFM resources.

DFM resources have a signature, the first 4 bytes contain the string 'TPF0', we 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, being able to distinguish DFM resources from the rest, we will write the function of getting 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 resources found


We’ll reap with Zlib, so this 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 is easy to write a procedure that will compress all resources from our list:

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

Deleting resources


To delete a resource, call the UpdateResource function and pass a null pointer to the data into it. But the thing is that the removal of resources is implemented in such a way that it does not reduce the exe file, Windows simply deletes the resource record from the resource table, while the place that occupied the resource remains and is not redistributed. Our goal is not just to encrypt dfm'ki, but also to reduce the overall size of the program on their compression, so the Win API will not help. Fortunately, there is a solution, the madBasic library from madCollection contains the madRes.pas module, which implements functions for working with resources, including deleting resources, and the authors tried and made the function call syntax-compatible with the Windows API, for which a special thank you.

Knowing all this, the procedure for deleting resources was 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's the code:

 //   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; 

I think the code questions will not cause. We disassembled and wrote the code for all 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 is quite possible to assemble the application. Create a new console application project in Delphi, save it with the name dfmcompressor.dpr and make the 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 on a thread vcl application, and it works!

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

We learn the program to use resources compressed DFM


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

We start, we die with an exception, and we can study how the control reached the form loading.

Actually, the stack shows that the classes.InternalReadComponentRes procedure was called in which the resources are loaded:

 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 to the directory with our test application (so that the modified file is picked up when compiling), 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
We collect, we start - everything works!

Develop the idea


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

A hook is done very simply by forming a long jump command on its function, and inserting it into the beginning of the InternalReadComponentRes. Yes, with this approach, vcl will not be able to call its InternalReadComponentRes, but we don’t 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; 

But it does not work out this way, because the definition of the procedure InternalReadComponentRes is absent in the interface section, which means we cannot recognize 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 can be intercepted. It also plays into the hands of the fact that InitInheritedComponent does not call any private functions from classes.pas (of course, except for the one we are changing), which means duplication of the code will be minimal.

We implement everything in the module, connecting which the program learns 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 will not know how it will work on other versions, but I think having this guide to adapt will not be a problem.

Source: https://habr.com/ru/post/238961/


All Articles