Форум: "WinAPI";
Текущий архив: 2011.03.20;
Скачать: [xml.tar.bz2];
ВнизКак файл иконки 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 вся ветка
Форум: "WinAPI";
Текущий архив: 2011.03.20;
Скачать: [xml.tar.bz2];
Память: 0.49 MB
Время: 0.005 c