Mudar ícone de um executável via código

[lucke]

Olá a todos!

Pessoal, meu problema é o seguinte...

Como alterar o ícone de um executável feito no delphi?Não usando o menu da própria IDE, mas sim, por código?

Procurei na net, e achei este código:

procedure UpdateIcons(const FileName, IcoFileName: String);
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 GetResLang(hModule: Cardinal; lpType, lpName: PAnsiChar; var wLanguage: Word): Boolean;
function EnumLangs(hModule: Cardinal; lpType, lpName: PAnsiChar; wLanguage: Word; lParam: Integer): BOOL; stdcall;
begin
  PWord(lParam)^ := wLanguage;
  Result := False;
end;
begin
  wLanguage := 0;
  EnumResourceLanguages(hModule, lpType, lpName, @EnumLangs, Integer(@wLanguage));
  Result := True;
end;

  function IsIcon(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
  H: THandle;
  M: HMODULE;
  R: HRSRC;
  Res: HGLOBAL;
  GroupIconDir, NewGroupIconDir: PGroupIconDir;
  I: Integer;
  wLanguage: Word;
  F: TFileStream;
  Ico: PIcoHeader;
  N: Cardinal;
  NewGroupIconDirSize: LongInt;
begin
  if Win32Platform <> VER_PLATFORM_WIN32_NT then
    ShowMessage('Somete Plataformas NT');
  Ico := nil;
  try
    F := TFileStream.Create(IcoFileName, FmOpenRead);
    try
      N := F.Size;
      if Cardinal(N) > Cardinal($100000) then  { sanity check }
        ShowMessage('Tamanho de Icone não suportado');
      GetMem(Ico, N);
      F.ReadBuffer(Ico^, N);
    finally
      F.Free;
    end;
    if not IsIcon(Ico, N) then
      ShowMessage('Formato de icone desconhecido');
    H := BeginUpdateResource(PChar(FileName), False);
    if H = 0 then
      ShowMessage('Falhou no Passo (1)');
    try
      M := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE);
      if M = 0 then
        ShowMessage('Falhou no Passo (2)');
      try
        R := FindResource(M, 'MAINICON', RT_GROUP_ICON);
        if R = 0 then
          ShowMessage('Falhou no Passo (3)');
        Res := LoadResource(M, R);
        if Res = 0 then
          ShowMessage('Falhou no Passo (4)');
        GroupIconDir := LockResource(Res);
        if GroupIconDir = nil then
          ShowMessage('Falhou no Passo (5)');
        if not GetResLang(M, RT_GROUP_ICON, 'MAINICON', wLanguage) then
          ShowMessage('Falhou no Passo (6)');
        if not UpdateResource(H, RT_GROUP_ICON, 'MAINICON', wLanguage, nil, 0) then
          ShowMessage('Falhou no Passo (7)');
        for I := 0 to GroupIconDir.ItemCount-1 do begin
          if not GetResLang(M, RT_ICON, MakeIntResource(GroupIconDir.Items[I].Id), wLanguage) then
            ShowMessage('Falhou no Passo (8)');
          if not UpdateResource(H, RT_ICON, MakeIntResource(GroupIconDir.Items[I].Id), wLanguage, nil, 0) then
            ShowMessage('Falhou no Passo (9)');
        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; //assumes that there aren't any icons left
          end;
          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('Falhou no Passo (10)');
          if not UpdateResource(H, RT_GROUP_ICON, 'MAINICON', 1033, NewGroupIconDir, NewGroupIconDirSize) then
            ShowMessage('Falhou no Passo (11)');
        finally
          FreeMem(NewGroupIconDir);
        end;
      finally
        FreeLibrary(M);
      end;
    except
      EndUpdateResource(H, True);  { discard changes }
      raise;
    end;
    if not EndUpdateResource(H, False) then
      ShowMessage('Falhou no Passo (12)');
  finally
    FreeMem(Ico);
  end;
end;

E usei desta forma:

UpdateIcons('Endereço da aplicação', 'Endereço do icone')

Mas o problema, é que as vezes funciona e as vezes, para de funcionar do nada, dando erro sempre no passo 3!

alguém poderia me ajudar?

(

OBS:Vou usar para alterar apenas arquivos executaveis criados pelo próprio Delphi;

Todas as vezes, uso a mesma imagem .ico e as vezes funciona e as vezes não;

)

[Jhonas]

tente esse

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

abraço

[lucke]

Olá Jhonas!

Deu erro usando esse exemplo tambem...

Erro:EndUpdateResource failed

Flws!

[Jhonas]

o codigo funciona no delphi XE2

amigo, porque voce precisa mudar o icone da aplicação em tempo de execução ?

abraço