Pesquisar na Comunidade

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; )