Datei/Ordner/Exe icon ?!?

[Weazy]

Das wurde bstimmt schon 1000 mal gefragt, aber alles was ich gefunden habe funktionierte nicht vollständig, also verzeiht mir die Frage 8)

Ich suche einen code der mir ein grosses und kleines Icon einer beliebigen Datei zurückgibt. Der code soll auch das icon eines Ordners zurückgeben können und auch das icon einer exe (nicht nur das default exe icon sondern das jeweilige icon).

Danke für eure Antworten!

[Luckie]

Zitat:

Zitat von Weazy

aber alles was ich gefunden habe funktionierte nicht vollständig,

Dann zeig uns doch mal,was du schon hast, damit man den Fehler beheben kann.

[Weazy]

Dies ist der Code den ich gefunden habe, alles andere was ich gefunden habe ist im prinzip das gleiche, manchmal etwas umgeschrieben aber das gleiche. Zudem fehlen überal "=":

Delphi-Quellcode:

unit AIconos;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  PHICON = ^HICON;

var
  Form1: TForm1;
  PLargeIcon, PSmallIcon: phicon;

implementation

uses shellapi, registry;

{$R *.DFM}

procedure GetAssociatedIcon(FileName: TFilename; PLargeIcon, PSmallIcon: PHICON);
var
  IconIndex: SmallInt;  // Position of the icon in the file
  Icono: PHICON;       // The LargeIcon parameter of ExtractIconEx
  FileExt, FileType: string;
  Reg: TRegistry;
  p: Integer;
  p1, p2: PChar;
  buffer: array [0..255] of Char;

Label
  noassoc, NoSHELL; // ugly! but I use it, to not modify to much the original code :(
begin
  IconIndex := 0;
  Icono := nil;
  // ;Get the extension of the file
  FileExt := UpperCase(ExtractFileExt(FileName));
  if ((FileExt  '.EXE') and (FileExt  '.ICO')) or not FileExists(FileName) then
  begin
    // If the file is an EXE or ICO and exists, then we can
    // extract the icon from that file. Otherwise here we try
    // to find the icon in the Windows Registry.
    Reg := nil;
    try
      Reg := TRegistry.Create;
      Reg.RootKey := HKEY_CLASSES_ROOT;
      if FileExt = '.EXE' then FileExt := '.COM';
      if Reg.OpenKeyReadOnly(FileExt) then
        try
          FileType := Reg.ReadString('');
        finally
          Reg.CloseKey;
        end;
      if (FileType <> '') and Reg.OpenKeyReadOnly(FileType + '\DefaultIcon') then
        try
          FileName := Reg.ReadString('');
        finally
          Reg.CloseKey;
        end;
    finally
      Reg.Free;
    end;

    // If there is not association then lets try to
    // get the default icon
    if FileName = '' then goto noassoc;

    // Get file name and icon index from the association
    // ('"File\Name",IconIndex')
    p1 := PChar(FileName);
    p2 := StrRScan(p1, ',');
    if p2  nil then
    begin
      p         := p2 - p1 + 1; // Position de la coma
      IconIndex := StrToInt(Copy(FileName, p + 1, Length(FileName) - p));
      SetLength(FileName, p - 1);
    end;
  end; //if ((FileExt  '.EX ...

  // Try to extract the small icon
  if ExtractIconEx(PChar(FileName), IconIndex, Icono^, PSmallIcon^, 1) <> 1 then
  begin
    noassoc:
    // That code is executed only if the ExtractIconEx return a value but 1
    // There is not associated icon
    // try to get the default icon from SHELL32.DLL

    FileName := 'C:\Windows\System\SHELL32.DLL';
    if not FileExists(FileName) then
    begin  //If SHELL32.DLL is not in Windows\System then
      GetWindowsDirectory(buffer, SizeOf(buffer));
      //Search in the current directory and in the windows directory
      FileName := FileSearch('SHELL32.DLL', GetCurrentDir + ';' + buffer);
      if FileName = '' then
        goto NoSHELL; //the file SHELL32.DLL is not in the system
    end;

    // Determine the default icon for the file extension
    if (FileExt = '.DOC') then IconIndex := 1
    else if (FileExt = '.EXE') or (FileExt = '.COM') then IconIndex := 2
    else if (FileExt = '.HLP') then IconIndex := 23
    else if (FileExt = '.INI') or (FileExt = '.INF') then IconIndex := 63
    else if (FileExt = '.TXT') then IconIndex := 64
    else if (FileExt = '.BAT') then IconIndex := 65
    else if (FileExt = '.DLL') or (FileExt = '.SYS') or (FileExt = '.VBX') or
      (FileExt = '.OCX') or (FileExt = '.VXD') then IconIndex := 66
    else if (FileExt = '.FON') then IconIndex := 67
    else if (FileExt = '.TTF') then IconIndex := 68
    else if (FileExt = '.FOT') then IconIndex := 69
    else
      IconIndex := 0;
    // Try to extract the small icon
    if ExtractIconEx(PChar(FileName), IconIndex, Icono^, PSmallIcon^, 1) <> 1 then
    begin
      //That code is executed only if the ExtractIconEx return a value but 1
      // Fallo encontrar el icono. Solo "regresar" ceros.
      NoSHELL:
      if PLargeIcon  nil then PLargeIcon^ := 0;
      if PSmallIcon  nil then PSmallIcon^ := 0;
    end;
  end; //if ExtractIconEx

  if PSmallIcon^ 0 then
  begin //If there is an small icon then extract the large icon.
    PLargeIcon^ := ExtractIcon(Application.Handle, PChar(FileName), IconIndex);
    if PLargeIcon^ = Null then
      PLargeIcon^ := 0;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  SmallIcon, LargeIcon: HIcon;
  Icon: TIcon;
begin
  if not (OpenDialog1.Execute) then
    Exit;
  Icon := TIcon.Create;
  try
    GetAssociatedIcon(OpenDialog1.FileName, @LargeIcon, @SmallIcon);
    if LargeIcon <> 0 then
    begin
      Icon.Handle := LargeIcon;
      Image2.Picture.icon := Icon;
    end;
    if SmallIcon <> 0 then
    begin
      Icon.Handle := SmallIcon;
      Image1.Picture.icon := Icon;
    end;
  finally
    Icon.Destroy;
  end;
end;

end.

[chest3rs]

Hallo,

ich kenne zwei Funktionen, mit denen man die Icons auslesen kann.

Die Methode verbraucht viel Arbeitsspeicher. Es ist aber möglich, die Symbole für bestimmte Dateitypen zu ermitteln, z.B. '*.bmp'...

Delphi-Quellcode:

function SHGetIconHandle(szIconFile: String; HUGE, SELECTED: BOOL): HICON;
var
  shfi: shFileInfo;
begin
  SHGetFileInfo(PChar(szIconFile), 0, shfi, sizeof(shFileInfo),
    SHGFI_USEFILEATTRIBUTES or SHGFI_ICON or SHGFI_SMALLICON * Ord(not HUGE) or SHGFI_SELECTED * Ord(SELECTED));
  Result := shfi.hIcon;
end;

Mit der nächsten Funktion kann man ein bestimmtes Icon mit Hilfe des Indexes ermitteln.

Delphi-Quellcode:

function ExtractIcon(lpszFile: String; nIconIndex: Integer; HUGE: BOOL): HICON;
var
  bIcon, sIcon: HICON;
begin
  ExtractIconEx(PChar(lpszFile), nIconIndex, bIcon, sIcon, 1);
  if HUGE then
    Result := bIcon
  else
    Result := sIcon;
end;

Gruß

[Luckie]

Und was funktioniert daran jetzt nicht?

Btw. SHGetFileInfo das sollte sein, was du suchst.

Zitat:

Zitat von chest3rs

Die Methode verbraucht viel Arbeitsspeicher.

Warum verbraucht die denn viel Arbeitsspeicher?

[chest3rs]

Ich habe beide Funktionen miteinander verglichen, indem ich für eine Prozessliste die Symbole ausgelesen habe. Der Unterschied zwischen SHGetFileInfo und ExtractIconEx lag bei ca. 1 MB Arbeitspeicher, bei einer Anwendung von max. 5 MB hat sich das bemerkbar gemacht. ;)

[Weazy]

Werde mich mal mit SHGetFileInfo befassen, vielen Dank, ihr antwortet echt schnell :-D