delphi – 从EXE中提取所有图标而不使用ExtractIconEx

我需要从EXE中提取所有图标并将它们保存为磁盘文件,但我无法使用最简单的解决方案( ExtractIconEx),因为我需要以保留大尺寸图标的方式提取ICO文件,即使代码运行在运行Windows XP的系统上.我稍后会使用其他代码提取想要的图标(128×128和其他vista大小图标),但我需要一种方法来提取所有图标,包括它们在EXE中存在的所有资源,无论我的代码是否运行PC on正在运行XP,Vista或Win7.

到目前为止,我知道图标在RT_GROUP_ICONS.

我知道有些人之前必须在Delphi中这样做,因为像IcoFX和resource-explorer这样的实用程序似乎已经这样做了.我曾经记得看到一个完全开源的Delphi工具可以做到这一点,但它是在几年前.

重述我使用ExtractIconEx的问题 – 它不会访问整个.ico文件,它只会提取支持的图标资源格式,这是平台支持的单一分辨率(大小).因此,在XP上,它将提取32×32或48×48图标,但不提取Vista格式的128×128图标.

更新：这是已接受答案的修改版本,解决了我未来的担忧.如果我们调用的函数以某种方式在未来的Windows版本中从User32.dll中消失,我希望它更优雅地失败,而不是加载我的整个应用程序.

unit ExtractIconUtils;

interface

uses Graphics,Forms,Windows;

//----------------------------------------------------------------------------
// ExtractIcons
// Call "private" MS Api to extract Icon file. This calls a publically
// documented function marked as deprecated in the MSDN documentation.
// It was no doubt Not Originally Intended to be documented,or publically
// accessed,but it provides functionality that its hard to live without.
// It exists on Windows 2000,XP,Vista,and Windows7,but might not exist
// in some future Windows version (released after year 2011).
//
// uses global   hUserDll    : THandle;
//----------------------------------------------------------------------------
function ExtractIcons(exeFilename,icoOutFileName:String;icoSize:Integer):Boolean;



var
  hUserDll    : THandle;





implementation



function ExtractIcons(exeFilename,icoOutFileName:String;icoSize:Integer):Boolean;
const
{$ifdef UNICODE}
 ExtractProcName='PrivateExtractIconsW';
{$else}
 ExtractProcName='PrivateExtractIconsA';
{$endif}
type
  TExtractFunc = function(lpszFile: PChar; nIconIndex,cxIcon,cyIcon: integer; phicon: PHANDLE; piconid: PDWORD; nicon,flags: DWORD): DWORD; stdcall;
var
  hIcon   : THandle;
  nIconId : DWORD;
  Icon    : TIcon;
  PrivateExtractIcons:TExtractFunc;
begin
  result := false;
  if (hUserDll<4) then begin
    hUserDll := LoadLibrary('user32.dll');
    if (hUserDll<4) then exit;
  end;

     { PrivateExtractIcons:
        MSDN documentation says that this function could go away in a future windows
        version,so we must try to load it,and if it fails,return false,rather than
        doing a static DLL import.
     }
    PrivateExtractIcons :=     GetProcAddress(hUserDll,ExtractProcName);

    if not Assigned(PrivateExtractIcons) then exit;

    //extract a icoSize x icoSize  icon where icoSize is one of 256,128,64,48,32,16
    if PrivateExtractIcons ( PWideChar(exeFilename),icoSize,@hIcon,@nIconId,1,LR_LOADFROMFILE) <>0 then
    try
      Icon:=TIcon.Create;
      try
        Icon.Handle:=hIcon;
        Icon.SaveToFile(icoOutFileName);
        result := true;
      finally
        Icon.Free;
      end;
    finally
      DestroyIcon (hIcon);
    end;
end ;


initialization
  // none

finalization
   if (hUserDll>4) then
      FreeLibrary(hUserDll);

end.

{$IFDEF UNICODE}
    function PrivateExtractIcons(lpszFile: PChar; nIconIndex,flags: DWORD): DWORD; stdcall ; external 'user32.dll' name 'PrivateExtractIconsW';
{$ELSE}
    function PrivateExtractIcons(lpszFile: PChar; nIconIndex,flags: DWORD): DWORD; stdcall ; external 'user32.dll' name 'PrivateExtractIconsA';
{$ENDIF}

procedure TMainForm.Button1Click(Sender: TObject);
var
    hIcon   : THandle;
    nIconId : DWORD;
    Icon    : TIcon;
begin
    //Extract a 128x128 icon
    if PrivateExtractIcons ('C:UsersPublicDocumentsRAD StudioProjects2010Aero ColorizerAeroColorizer.exe',LR_LOADFROMFILE) <>0 then
    try
        Icon:=TIcon.Create;
        try
            Icon.Handle:=hIcon;
            Icon.SaveToFile(ExtractFilePath(ParamStr(0))+'Aicon.ico');
        finally
            Icon.Free;
        end;
    finally
        DestroyIcon (hIcon);
    end;
end ;