Конференция "KOL" » Запись в ресурсы DLL [Delphi, Windows]
 
  • Сашик (02.07.08 23:06) [0]
    Столкнулся с проблемой значительного увеличения размера exe файла из-за PImageList. Предлагаю следующий набор функций для хранения сжатой Zlib информации в DLL:


    unit NKolZLib;

    interface

    { Функции работы с ресурсами DLL }

    uses Windows, KOL, KolZlib;

    //decompression stream:
    function StreamZCompress(Dest, Source: PStream): DWord;
    //compression stream:
    function StreamZDecompress(Dest, Source: PStream; Count: DWord): DWord;
    //read decompression stream from DLL:
    function GetStreamResource(Dest: PStream; const DllName, ResName: KolString): Boolean;
    //read decompression Bitmap from DLL:
    function GetBitmapResource(const DllName, ResName: KolString): PBitmap;
    //write compression stream to DLL:
    function SetStreamResource(Dest: PStream; const DllName, ResName: KolString): Boolean;
    //write compression file to DLL:
    function AddFileToResource(const DllName, FileName, ResName: KolString): Boolean;
    //read decompression file from DLL:
    function GetFileFromResource(const DllName, NewFileName, ResName: KolString): Boolean;
    //read data from DLL:
    function GetResData(const DllName, ResName: KolString; var Data: pointer; var Length: integer): THandle;
    //read string as RT_RCDATA from DLL:
    function LoadStringFromRCData(const DllName, ResName: KolString): KolString;
    //write data to DLL:
    procedure AddRCDataResource(const DllName, ResName: KolString; Value: pointer; Size: integer);
    //освобождение ресурса:
    procedure ReleaseResData(Handle: THandle);

    type
    TBlobByteData = array of Byte;

    resourcestring
    ERLIB = 'Динамически подключаемый модуль < %s > не найден...';
    SERROR = 'Ошибка';

    implementation

    function MsgErr(const Msg: String; Args: Array of const): Boolean;
    begin
     MessageBox(0, PChar(Format(Msg, Args)), PChar(SERROR), MB_OK + MB_ICONSTOP);
     Result:= True
    end;

    function StreamZDecompress(Dest, Source: PStream; Count: DWord): DWord;
    var Zipper: PStream;
     Size: DWord;
     begin
       Result:= 0;
       try
        Source.Seek(0, spBegin);
         if Source.Read (Size, 4) <> 4 then Exit;
         if not NewZLibDStream (Zipper, Source, nil) then Exit;
         Result:= Stream2Stream(Dest, Zipper, Size);
       finally
         if Zipper <> nil then Zipper.Free;
       end;
    end;

    function StreamZCompress(Dest, Source: PStream): DWord;
    var  Zipper: PStream; Size: DWord;
    begin
      Size:=Source.Size;
       Result:= 0;
     Source.Seek(0, spBegin);
       Dest.Write (Size, 4);
       try
         If not NewZLibCStream (Zipper, clMax, Dest, nil) then Exit;
         Result:= Stream2Stream(Zipper, Source, Size);
       finally
         if Zipper <> nil then Zipper.Free;
       end;
    end;

    function GetResData(const DllName, ResName: KolString; var Data: pointer; var Length: integer): THandle;
    var rHandle, hInst: THandle; p: Pointer;
    begin
      hInst:= LoadLibrary(PChar(DllName));
       Result:= 0;
     try
      if hInst = 0 then MsgErr(ERLIB, [DllName]);
      rhandle:= FindResource(hInst, MakeIntResource(ResName), RT_RCDATA);
      Result:= LoadResource(hInst, rhandle);
      p:= LockResource(Result);
      Length:= SizeOfResource(hInst, rhandle);
        Data:= AllocMem(Length);
        Move(p^,Data^,Length);
      finally
      ReleaseResData(Result);
      FreeLibrary(hInst);
    end;
    end;

    function GetStreamResource(Dest: PStream; const DllName, ResName: KolString): Boolean;
    var aSize: Integer; Buf: Pointer; M: PStream;
    begin
      Result:= GetResData(DllName, ResName, Buf, aSize) <> 0;
       if not Result then Exit;
       M:= NewMemoryStream;
       try
         M.Write(Buf^, aSize);
         M.Position:= 0;
         StreamZDecompress(Dest, M, 0);
         Dest.Position:= 0;
       finally
         M.Free;
       end;
       FreeMem(Buf);
       Result:= True;
    end;

    function GetBitmapResource(const DllName, ResName: KolString): PBitmap;
    var M: PStream;
     begin
      M:= NewMemoryStream;
       try
        Result:= NewBitmap(1, 1);
       if GetStreamResource(M, DllName, ResName) then
          Result.LoadFromStream(M);
      finally
        M.Free;
       end;
    end;

    function GetFileFromResource(const DllName, NewFileName, ResName: KolString): Boolean;
    var F: PStream;
    begin
       F:= NewWriteFileStream(NewFileName);
       try
        Result:= GetStreamResource(F, DllName, ResName);
      finally
        F.Free;
       end;
    end;

    function SetStreamResource(Dest: PStream; const DllName, ResName: KolString): Boolean;
    var M: PStream;
    begin
       M:= NewMemoryStream;
       try
      StreamZCompress(M, Dest);
         M.Position:= 0;
         AddRCDataResource(DllName, ResName, M.Memory, M.Size);
     finally
         M.Free;
       end;
       Result:= True;
    end;

    function AddFileToResource(const DllName, FileName, ResName: KolString): Boolean;
     var F: PStream;
    begin
       F:= NewReadFileStream(FileName);
       try
      Result:= SetStreamResource(F, DllName, ResName);
     finally
        F.Free;
       end;
    end;

    procedure AddRCDataResource(const DllName, ResName: KolString; Value: pointer; Size: integer);
    var h: THandle;
    begin
     h:= BeginUpdateResource(PChar(DllName), false);
     if h = 0 then Exit;
     UpdateResource(h, RT_RCDATA, MakeIntResource(UpperCase(ResName)), 0, Value, Size);
     EndUpdateResource(h, false);
    end;

    procedure ReleaseResData(Handle: THandle);
    begin
     UnlockResource(Handle);
     FreeResource(Handle);
    end;

    function LoadStringFromRCData(const DLLName, ResName: KolString): KolString;
    var rHandle: THandle; Buf: Pointer; Size: integer;
    begin
     rHandle:= GetResData(DLLName, ResName, Buf, Size);
     try
      SetString(Result, PChar(Buf), size);
     finally
         FreeMem(Buf);
      ReleaseResData(rHandle);
     end;
    end;



    Для динамической загрузки PImageList использую:

       Bmp:= GetBitmapResource(<путь к dll>, <имя ресурса>);
       Img.AddMasked(Bmp.Handle, <TransparentColor>);
       Bmp.Free;


    Выигрыш в размере довольно значительный...
  • mdw © (03.07.08 10:06) [1]

    > Предлагаю следующий набор функций для хранения сжатой Zlib
    > информации в DLL:

    Хочу сказать, что если Вы считаете, что какой либо код кому-то еще может быть полезен, то присылайте в виде архива и желательно с демо. Или, если это несколько функций, добавде в KOLUtils, и тоже присылайте. Выложим на сайте. А от того что вы выставили код в форуме (насколько помню не первый раз), толку мало, через несколько дней ветка уйдет с первой странице и о ней все забудут....
  • Сашик (03.07.08 13:00) [2]
    mdv, я все не могу понять, куда отсылать (адрес) ?
  • mdw © (03.07.08 13:22) [3]
    На первой же странице указан
    http://www.kolnmck.ru/start.shtml
    Мне или MTsv DN
  • Сашик (03.07.08 13:32) [4]
    mdw, (прошу прощения за ошибочное обращение в предыдущем сообщении) я на самом  деле большой профан при работе с Internet-ом... Благодарен за помощь!
 
Конференция "KOL" » Запись в ресурсы DLL [Delphi, Windows]
Есть новые Нет новых   [134431   +15][b:0][p:0.004]