Работа с ресурсами в Delphi , ?

[IgorT]

Добрый день. Вобщем такой вот вопрос - допустим есть у меня два ехе файла. Надо програмно перенести иконку одного ехе в другой. Тоесть надо просто ресурс MAINICON переносить как-то из одного файла в другой, но как это сделать правильно ?

Написал такой код :

var
 ResourceHandle : THandle;
 wLanguage: Word;
 M: HMODULE;
 R: HRSRC;
 Res: HGLOBAL;
 
...
 
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;
 
...
 
 
  ResourceHandle := BeginUpdateResource(pChar(Edit5.Text), false);
  if (ResourceHandle <> 0) Then
   begin
   M := LoadLibraryEx(PChar(Edit3.Text), 0, LOAD_LIBRARY_AS_DATAFILE);
   R := FindResource(M, 'MAINICON', RT_GROUP_ICON);
   GetResourceLanguage(M, RT_GROUP_ICON, 'MAINICON', wLanguage);
   if R <> 0 then
    begin
    Res := LoadResource(M, R);
    UpdateResource(ResourceHandle, RT_GROUP_ICON, 'MAINICON', wLanguage, Pointer(Res), SizeOfResource(M,R) );
    EndUpdateResource(ResourceHandle, False);
    end;

Тут Edit3.Text - путь к файлу из которого надо перенести ресурс, а Edit5.Text - путь к файлу назначения... Но код не работает (просто ничего не происходит, ресурс не заменяется, а если его удалить предварительно в файле назначения, то создается пустой)... В чем может быть проблема ?

Сообщение отредактировано: IgorT - 19.06.10, 16:51

[IgorT]

Хоть подскажите в каком направлении двигатся... проблема все еще актуальна...

[andrew.virus]

IgorT, в свое время сталкивался с подобной проблемой (нужно было менять значки у исполняемых файлов) ... полазив по интернету и почитав литературу пришел к такому коду для решения проблемы:

procedure updateIcons(const fileName, icoFileName: string);
{-------------------------------------------------------------}
{|    Функция замены значка MAINICON в исполняемом файле     |}
{-------------------------------------------------------------}
{| Параметры:                                                |}
{|  fileName - файл, в котором производится изменение значка;|}
{|  icoFileName - значок на который проходит замена          |}
{-------------------------------------------------------------}
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(fP: pointer; fSize: cardinal): boolean;
  { Проверка корректности внедряемого значка для MAINICON }
  var
    itemCount: cardinal;
  begin
    result:=false;
    if fSize < cardinal(sizeOf(word) * 3) then exit;
    if (pChar(fP)[0] = 'M') and (pChar(fP)[1] = 'Z') then exit;
    ItemCount:=PIcoHeader(fP).ItemCount;
    if fSize < Cardinal((sizeOf(Word) * 3) + (itemCount * sizeOf(TIcoItem))) then exit;
    fP:=@PIcoHeader(fP).Items;
    while ItemCount > Cardinal(0) do
      begin
        if (Cardinal(PIcoItem(fP).Offset + PIcoItem(fP).Header.ImageSize) < Cardinal(PIcoItem(fP).Offset)) or
           (Cardinal(PIcoItem(fP).Offset + PIcoItem(fP).Header.ImageSize) > Cardinal(fSize)) then exit;
        inc(PIcoItem(fP));
        dec(itemCount)
      end;
    result:=true
  end;
 
var
  ch: char;
  H: THandle;
  M: HMODULE;
  R: HRSRC;
  Res: HGLOBAL;
  GroupIconDir, NewGroupIconDir: PGroupIconDir;
  I: integer;
  wLanguage: word;
  FS: TFileStream;
  Ico: PIcoHeader;
  N: cardinal;
  NewGroupIconDirSize: longint;
 
begin
  if Win32Platform <> VER_PLATFORM_WIN32_NT then
    showMessage('Возможность поддерживается только для' + #13#10 +
                'платформы Windows NT и более поздней');
  Ico:=nil;
  try
    { Загрузка значка }
    fs:=TFileStream.Create(IcoFileName,fmOpenRead,fmShareDenyWrite);
    try
      N:=fs.Size;
      if cardinal(N) > cardinal($100000) then
        showMessage('Файл со значком слишком большой');
      GetMem(Ico, N); fs.Read(Ico^,N)
    finally
        fs.Free
    end;
    { .... проверка правильности значка }
    if not IsValidIcon(Ico, N) then
      showMessage('Файл значка поврежден');
    { ... обновление ресурсов в файле }
    H:=BeginUpdateResource(pChar(FileName), false);
    if H = 0 then
      showMessage('Ошибка начала обновления (BeginUpdateResource failed (1))');
    try
      M:=LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE);
      if M = 0 then
        ShowMessage('LoadLibraryEx failed (1)');
      try
        { ... загрузка значков для 'MAINICON' из ресурса }
        R := FindResource(M, 'MAINICON', RT_GROUP_ICON);
        if R = 0 then
          showMessage('Ошибка поиска ресурса (FindResource failed (1))');
        Res:=LoadResource(M, R);
        if Res = 0 then
          showMessage('Ошибка загрузки ресурса (LoadResource failed (1))');
        GroupIconDir:=LockResource(Res);
        if GroupIconDir = nil then
          showMessage('Ресурс защищен от изменения (LockResource failed (1))');
        { ... удаление начального значка 'MAINICON' }
        wLanguage:=GetSystemDefaultLangID;
        if not UpdateResource(H, RT_GROUP_ICON, 'MAINICON', wLanguage, nil, 0) then
          showMessage('Ошибка обновления ресурса (UpdateResource failed (1))');
        for I:=0 to GroupIconDir.ItemCount-1 do
          begin
            wLanguage:=GetSystemDefaultLangID;
            if not UpdateResource(H, RT_ICON, MakeIntResource(GroupIconDir.Items[I].Id), wLanguage, nil, 0) then
              showMessage('Ошибка обновления ресурса (UpdateResource failed (2))')
          end;
        { ... создание новой группы ресурсов из значков }
        NewGroupIconDirSize:=3*SizeOf(word)+Ico.ItemCount*sizeOf(TGroupIconDirItem);
        GetMem(NewGroupIconDir, NewGroupIconDirSize);
        try
          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
            end;
          { ... обновление значка '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
              showMessage('Ошибка обновления ресурса (UpdateResource failed (3))');
          if not UpdateResource(H, RT_GROUP_ICON, 'MAINICON', 1033, NewGroupIconDir, NewGroupIconDirSize) then
            showMessage('Ошибка обновления ресурса (UpdateResource failed (4))');
          if not UpdateResource(H,RT_RCDATA, 'URL', wLanguage, addr(ch), 1024) then
            showMessage('Ошибка записи для значения URL')
        finally
          FreeMem(NewGroupIconDir)
        end
      finally
        FreeLibrary(M)
      end
    except
      EndUpdateResource(H, true);
      raise
    end;
    if not EndUpdateResource(H, False) then
      ShowMessage('Ошибка завершения обновления (EndUpdateResource failed)')
  finally
    FreeMem(Ico)
  end
end;

з.ы.: в прилагаемом архиве пример, в котором как приложение изменяющее значок с исходным кодом, так и внедряемый значок и код изменяемого приложения ...
Прикреплённый файлres_change_sample.zip (5.19 Кбайт, скачиваний: 287)

[andrew.virus]

IgorT, набросал дополнительно пример, который позволяет извлекать первую icon (для исполняемых файлов, она - MAINICON) из dll- и exe-файлов с прилинковкой в существующий проект вместо существующей MAINICON ...

з.ы.: полный код примера в прилагаемом архиве ...
Прикреплённый файлres_change_sample_ext.zip (14.69 Кбайт, скачиваний: 342)

[IgorT]

Спасибо огромное, пока все работает !