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

Вниз

Как файл иконки new.ico поместить в EXE или Dll файл   Найти похожие ветки 

← →
Nikfel   (2009-06-07 16:33) [0]

Подскажите, пожалуйста. Мне надо записать икоку в файл dll и никак не получается.

А вот bmp записывается нормально вот так:

procedure TForm1.Button1Click(Sender: TObject);
var dwResSize, dwRead:DWORD;
hUpdateRes:Cardinal;
pRes: PChar;
f:thandle;
begin
F:=CreateFile("new.bmp", GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
// Если открыть не удалось, то выходим
if F=INVALID_HANDLE_VALUE then begin
CloseHandle(F);
exit;
end;
dwResSize:=GetFileSize(F, nil)-sizeof(BITMAPFILEHEADER);
pRes:=SysGetMem(dwResSize);
SetFilePointer(F,sizeof(BITMAPFILEHEADER),nil,0);
ReadFile(F, pRes^, dwResSize, dwRead, nil);
hUpdateRes:=BeginUpdateResource("ResourceKeeper.exe", FALSE);
UpdateResource(hUpdateRes, RT_BITMAP, "bmp", LANG_NEUTRAL, pRes, dwResSize);
EndUpdateResource(hUpdateRes, FALSE);
CloseHandle(F);
end;

А вот как иконку записать? Наверно лучше будет когда удаляешь все иконки из файла dll, а потом все по новой загнать, но уже другие иконки. Проблема в том что как записать правильно иконку в файл ресурсов dll, чтобы она отображалась правильно. Я так понимаю что надо записывать иконку в RT_ICON и RT_GROUP_ICON, но как правильно записать? Заранее спасибо.

---

← →
Palladin ©   (2009-06-07 16:50) [1]

> Проблема в том что как записать правильно иконку в файл
> ресурсов dll, чтобы она отображалась правильно.

Где отображалась?

---

← →
Nikfel   (2009-06-07 17:08) [2]

Я проверяю правильно ли записал в редакторе ресурсов Restorator и там показывает что не правильный ресурс.

---

← →
Сергей М. ©   (2009-06-07 17:35) [3]

http://www.delphikingdom.com/asp/answer.asp?IDAnswer=39149

---

← →
Виктор85   (2009-06-09 18:53) [4]

Сильно не пинай, для себя писал (код замены иконки содрал оттуда же откуда в предыдущем посте)

{
 Модуль содержит класс для записи ресурсов в exe файл
}

unit isResourceWriterUnit;

interface

uses
 Windows, SysUtils, Classes;

type
 //Класс для записи ресурсов в exe файл
 TisResourceWriter = class
 private
   FExeName: TFileName;
   FResHandle: THandle;
   FAutoCommit: Boolean;
 public
   constructor Create(const ExeName: TFileName);
   procedure Commit;

   procedure UpdateIco(const IcoFileName: TFileName);
   procedure WriteString(const ResName, Value: string);
   procedure WriteBuffer(const ResName: string; const Buffer; BufferSize: LongWord; lpType: PChar = RT_RCDATA);

   property AutoCommit: Boolean read FAutoCommit write FAutoCommit;
 end;

implementation

procedure ErrorWithLastError(const Message: string);
begin
 raise Exception.CreateFmt("%s: %s (#%d)", [Message, SysErrorMessage(GetLastError), GetLastError]);
end;

procedure Error(const Message: string);
begin
 raise Exception.Create(Message);
end;

function EnumLangsFunc(hModule: Cardinal; lpType, lpName: PAnsiChar; wLanguage: Word; lParam: Integer): Boolean; stdcall;
begin
 PWord(lParam)^ := wLanguage;
 Result := False;
end;

function GetResourceLanguage(hModule: Cardinal; lpType, lpName: PAnsiChar; var wLanguage: Word): Boolean;
begin
 wLanguage := 0;
 EnumResourceLanguages(hModule, lpType, lpName, @EnumLangsFunc, Integer(@wLanguage));
 Result := True;
end;


---

← →
Виктор85   (2009-06-09 18:54) [5]


{ TisResourceWriter }

procedure TisResourceWriter.Commit;
begin
 try
   if FResHandle = 0 then
     Error("noting data to commit");

   if not EndUpdateResource(FResHandle, False) then
     ErrorWithLastError("");

   FResHandle := 0;
 except
   on E:Exception do
     raise Exception.CreateFmt("An exception while trying commit resource: %s", [E.Message]);
 end;
end;

constructor TisResourceWriter.Create(const ExeName: TFileName);
begin
 inherited Create;

 FExeName := ExeName;
end;

procedure TisResourceWriter.WriteString(const ResName, Value: string);
begin
 WriteBuffer(ResName, Value[1], Length(Value) * SizeOf(Char));
end;

procedure TisResourceWriter.WriteBuffer(const ResName: string; const Buffer; BufferSize: LongWord; lpType: PChar);
begin
 try
   if not AnsiSameStr(AnsiUpperCase(ResName), ResName) then
     Error("resource name can by only upper case");

   //Если режим работы не автокоммит
   if AutoCommit then
     if FResHandle <> 0 then
       Error("not committed update in last not autommit session")
     else
       FResHandle := BeginUpdateResource(PChar(FExeName), False);

   if (not AutoCommit) and (FResHandle = 0) then
     FResHandle := BeginUpdateResource(PChar(FExeName), False);

   if FResHandle = 0 then
     ErrorWithLastError("");

   try
     if not UpdateResource(FResHandle, lpType, PChar(ResName), SUBLANG_SYS_DEFAULT * 2048 or LANG_NEUTRAL, @Buffer, BufferSize) then
       ErrorWithLastError("");
   finally
     if AutoCommit then
       Commit;
   end;
 except
   on E: Exception do
     raise Exception.CreateFmt("An exception while trying write resource "%s": %s", [ResName, E.Message]);
 end;
end;

//Замена страндартной иконки. Взято из исхоников InnoSetup
procedure TisResourceWriter.UpdateIco(const IcoFileName: TFileName);
type
 PIcoItemHeader = ^TIcoItemHeader;
 TIcoItemHeader = packed record
   Width: Byte;
   Height: Byte;
   Colors: Byte;
   Reserved: Byte;
   Planes: Word;
   BitCount: Word;
   ImageSize: DWORD;
 end;
 PIcoItem = ^TIcoItem;
 TIcoItem = packed record
   Header: TIcoItemHeader;
   Offset: DWORD;
 end;
 PIcoHeader = ^TIcoHeader;
 TIcoHeader = packed record
   Reserved: Word;
   Typ: Word;
   ItemCount: Word;
   Items: array [0..MaxInt shr 4 - 1] of TIcoItem;
 end;
 PGroupIconDirItem = ^TGroupIconDirItem;
 TGroupIconDirItem = packed record
   Header: TIcoItemHeader;
   Id: Word;
 end;
 PGroupIconDir = ^TGroupIconDir;
 TGroupIconDir = packed record
   Reserved: Word;
   Typ: Word;
   ItemCount: Word;
   Items: array [0..MaxInt shr 4 - 1] of TGroupIconDirItem;
 end;

 function IsValidIcon(P: Pointer; Size: Cardinal): Boolean;
 var
   ItemCount: Cardinal;
 begin
   Result := False;
   if Size < Cardinal(SizeOf(Word) * 3) then
     Exit;
   if (PChar(P)[0] = "M") and (PChar(P)[1] = "Z") then
     Exit;
   ItemCount := PIcoHeader(P).ItemCount;
   if Size < Cardinal((SizeOf(Word) * 3) + (ItemCount * SizeOf(TIcoItem))) then
     Exit;
   P := @PIcoHeader(P).Items;
   while ItemCount > Cardinal(0) do begin
     if (Cardinal(PIcoItem(P).Offset + PIcoItem(P).Header.ImageSize) < Cardinal(PIcoItem(P).Offset)) or
       (Cardinal(PIcoItem(P).Offset + PIcoItem(P).Header.ImageSize) > Cardinal(Size)) then
       Exit;
     Inc(PIcoItem(P));
     Dec(ItemCount);
   end;
   Result := True;
 end;

var
 R: HRSRC;
 H: THandle;
 M: HMODULE;
 I: Integer;
 N: Cardinal;
 Res: HGLOBAL;
 F: TFileStream;
 Ico: PIcoHeader;
 wLanguage: Word;
 NewGroupIconDirSize: LongInt;
 GroupIconDir: PGroupIconDir;
 NewGroupIconDir: PGroupIconDir;


---

← →
Виктор85   (2009-06-09 18:55) [6]

begin
 if Win32Platform <> VER_PLATFORM_WIN32_NT then
   Error("Only supported on Windows NT and above");

 Ico := nil;

 try
   //Load the icons
   F := TFileStream.Create(IcoFileName, fmOpenRead);
   try
     N := F.Size;
     if Cardinal(N) > Cardinal($100000) then  { sanity check }
       Error("Icon file is too large");
     GetMem(Ico, N);
     F.ReadBuffer(Ico^, N);
   finally
     F.Free;
   end;

   //Ensure the icon is valid
   if not IsValidIcon(Ico, N) then
     Error("Icon file is invalid");

   { Update the resources }
   H := BeginUpdateResource(PChar(FExeName), False);
   if H = 0 then
     ErrorWithLastError("BeginUpdateResource failed (1)");
   try
     M := LoadLibraryEx(PChar(FExeName), 0, LOAD_LIBRARY_AS_DATAFILE);
     if M = 0 then
       ErrorWithLastError("LoadLibraryEx failed (1)");
     try
       { Load the "MAINICON" group icon resource }
       R := FindResource(M, "MAINICON", RT_GROUP_ICON);
       if R = 0 then
         ErrorWithLastError("FindResource failed (1)");
       Res := LoadResource(M, R);
       if Res = 0 then
         ErrorWithLastError("LoadResource failed (1)");
       GroupIconDir := LockResource(Res);
       if GroupIconDir = nil then
         ErrorWithLastError("LockResource failed (1)");

       { Delete "MAINICON" }
       if not GetResourceLanguage(M, RT_GROUP_ICON, "MAINICON", wLanguage) then
         Error("GetResourceLanguage failed (1)");
       if not UpdateResource(H, RT_GROUP_ICON, "MAINICON", wLanguage, nil, 0) then
         ErrorWithLastError("UpdateResource failed (1)");

       { Delete the RT_ICON icon resources that belonged to "MAINICON" }
       for I := 0 to GroupIconDir.ItemCount-1 do begin
         if not GetResourceLanguage(M, RT_ICON, MakeIntResource(GroupIconDir.Items[I].Id), wLanguage) then
           Error("GetResourceLanguage failed (2)");
         if not UpdateResource(H, RT_ICON, MakeIntResource(GroupIconDir.Items[I].Id), wLanguage, nil, 0) then
           ErrorWithLastError("UpdateResource failed (2)");
       end;

       { Build the new group icon resource }
       NewGroupIconDirSize := 3*SizeOf(Word)+Ico.ItemCount*SizeOf(TGroupIconDirItem);
       GetMem(NewGroupIconDir, NewGroupIconDirSize);
       try
         { Build the new group icon resource }
         NewGroupIconDir.Reserved := GroupIconDir.Reserved;
         NewGroupIconDir.Typ := GroupIconDir.Typ;
         NewGroupIconDir.ItemCount := Ico.ItemCount;
         for I := 0 to NewGroupIconDir.ItemCount-1 do begin
           NewGroupIconDir.Items[I].Header := Ico.Items[I].Header;
           NewGroupIconDir.Items[I].Id := I+1; //assumes that there aren"t any icons left
         end;

         { Update "MAINICON" }
         for I := 0 to NewGroupIconDir.ItemCount-1 do
           if not UpdateResource(H, RT_ICON, MakeIntResource(NewGroupIconDir.Items[I].Id), 1033, Pointer(DWORD(Ico) + Ico.Items[I].Offset), Ico.Items[I].Header.ImageSize) then
             ErrorWithLastError("UpdateResource failed (3)");

         { Update the icons }
         if not UpdateResource(H, RT_GROUP_ICON, "MAINICON", 1033, NewGroupIconDir, NewGroupIconDirSize) then
           ErrorWithLastError("UpdateResource failed (4)");
       finally
         FreeMem(NewGroupIconDir);
       end;
     finally
       FreeLibrary(M);
     end;
   except
     EndUpdateResource(H, True);  { discard changes }
     raise;
   end;
   if not EndUpdateResource(H, False) then
     ErrorWithLastError("EndUpdateResource failed");
 finally
   FreeMem(Ico);
 end;
end;

end.

Блин, на три сообщения пришлось разбить

---

← →
артм   (2009-07-01 02:34) [7]

тут тоже хороший модуль http://download26.isgreat.org/disc-file.php?hiew=index/a1HaHR0cDovL3NvZnQud2luc292LnJ1L3Npc3RlbWEvS2h.php?

---

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

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

Наверх

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