Текущий архив: 2010.03.28;
Скачать: CL | DM;

Вниз

Запись в ресурсы DLL   Найти похожие ветки 

← →
Сашик   (2008-07-02 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 ©   (2008-07-03 10:06) [1]

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

Хочу сказать, что если Вы считаете, что какой либо код кому-то еще может быть полезен, то присылайте в виде архива и желательно с демо. Или, если это несколько функций, добавде в KOLUtils, и тоже присылайте. Выложим на сайте. А от того что вы выставили код в форуме (насколько помню не первый раз), толку мало, через несколько дней ветка уйдет с первой странице и о ней все забудут....

---

← →
Сашик   (2008-07-03 13:00) [2]

mdv, я все не могу понять, куда отсылать (адрес) ?

---

← →
mdw ©   (2008-07-03 13:22) [3]

На первой же странице указан
http://www.kolnmck.ru/start.shtml
Мне или MTsv DN

---

← →
Сашик   (2008-07-03 13:32) [4]

mdw, (прошу прощения за ошибочное обращение в предыдущем сообщении) я на самом  деле большой профан при работе с Internet-ом... Благодарен за помощь!

---

Страницы: 1 вся ветка

Текущий архив: 2010.03.28;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.014 c