1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92:
| uses ShellApi;
function TotalNumberOfIcons(const FileName: String): Integer; begin if not FileExists(FileName) then Result:= -1 else Result := ExtractIcon(HInstance, PChar(FileName), $FFFFFFFF); end;
function GetIconFromFile(const FileName: String; Index: Word; Icon: TIcon): Boolean; begin Result:= False; showmessage(inttostr(TotalNumberOfIcons(FileName))); if (TotalNumberOfIcons(FileName) < 1) or ((Index + 1 ) > TotalNumberOfIcons(FileName)) then exit; Icon.Handle:= ExtractIcon(HInstance, PChar(FileName), Index); Result:= true; end;
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; hUserDll: THandle; begin result:= false;
hUserDll:= LoadLibrary('user32.dll');
PrivateExtractIcons:= GetProcAddress(hUserDll, ExtractProcName); if not Assigned(PrivateExtractIcons) then exit; if PrivateExtractIcons(Pchar(exeFilename), 0, icoSize, icoSize, @hIcon, @nIconId, 1, LR_LOADFROMFILE) <>0 then begin try Icon:=TIcon.Create; try Icon.Handle:=hIcon; Icon.SaveToFile(icoOutFileName); result := true; finally Icon.Free; end; finally DestroyIcon(hIcon); end; end; end;
procedure TForm1.Button1Click(Sender: TObject); var OutFile: string; const FilePath = 'D:\Apps\GIMPPortable\GIMPPortable.exe'; begin OutFile:= 'C:\Users\<User>\Desktop\Icon'+inttostr(Random(500))+'.ico'; ExtractIcons(FilePath, OutFile, 256); end;
procedure TForm1.Button2Click(Sender: TObject); var Icon: TIcon; OutFile: string; const FilePath = 'D:\Apps\GIMPPortable\GIMPPortable.exe'; begin Icon:= TIcon.Create; GetIconFromFile(FilePath, 0, Icon); OutFile:= 'C:\Users\<User>\Desktop\Icon'+inttostr(Random(500))+'.ico'; if not Icon.Empty then Icon.SaveToFile(OutFile); Icon.Free; end;
procedure TForm1.FormCreate(Sender: TObject); begin Randomize; end; |