代码文件:
--------------------------------------------------------------------------------

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses ShellAPI;

{从 EXE 或 DLL 中获取 ICO 图标的函数, 需要 uses ShellAPI}
function GetIco(const ExePath: string; SavePath: string): Integer; {返回获取总数}
var
ico: TIcon;
i,count: Integer;
FileName: string;
begin
Result := 0;
count := ExtractIcon(HInstance, PChar(ExePath), $FFFFFFFF);
if count = 0 then Exit;

if not DirectoryExists(SavePath) then ForceDirectories(SavePath);
FileName := ChangeFileExt(ExtractFileName(ExePath), '');
SavePath := ExcludeTrailingPathDelimiter(SavePath) + '\' + FileName + '_%.3d.ico';

ico := TIcon.Create;
for i := 0 to count - 1 do
begin
ico.Handle := ExtractIcon(HInstance, PChar(ExePath), i);
ico.SaveToFile(Format(SavePath, [i+1]));
end;
ico.Free;
Result := count;
end;

{测试: 获取当前程序图标}
procedure TForm1.Button1Click(Sender: TObject);
begin
GetIco(ParamStr(0), 'c:\temp');
end;

{测试: 获取记事本图标}
procedure TForm1.Button2Click(Sender: TObject);
var
buf: array[0..MAX_PATH] of Char;
begin
GetSystemDirectory(buf, Length(buf)*SizeOf(buf[0]));
GetIco(buf + '\notepad.exe', 'c:\temp');
end;

{测试: 获取 Windows 的标准图标库}
procedure TForm1.Button3Click(Sender: TObject);
var
buf: array[0..MAX_PATH] of Char;
begin
GetSystemDirectory(buf, Length(buf)*SizeOf(buf[0]));
GetIco(buf + '\Shell32.dll','c:\temp');
end;

end.