HI @all,

wie im Anhang zu sehen ist, zeigt der Explorer alle seine Icons für die Dateien aus der Registry (HKEY_CLASSES_ROOT). Bloß, wie geht man jetzt da vor, wenn man die Icons gerne in einem anderen Programm nutzen möchte?
Klar, man kann jetzt alle Icons aus den entsprechenden Quellen extrahieren und dann in das eigene Programm einbauen, was das Programm ja nur aufbläht, aber keinen wirklichen Sinn dahinter erkennen lässt. Möchte man jetzt neue Icons registrieren, dann hat das zur Folge, dass das Programm rekompiliert werden muss.

In der Registry findet man jetzt (hier z.B. für das Word-Dokumen-Icon) den Pfad "C:\WINDOWS\Installer\{00000407-78E1-11D2-B60F-006097C998E7}\wordicon.exe,1" oder "C:\PROGRA~1\WINDOW~2\wmplayer.exe,-120" (AVI-Datei).

Wie kann man diese Strings so verarbeiten, dass am Ende das richtige Icon erscheint?

Bernhard

Hallo,

guckst Du hier?, die für die dort genannte Funktion erforderlichen Parameter bekommst Du aus der Registry.

Das mit ExtractIcon ist schon klar, aber wie verarbeite ich die negativen Parameter?

Bernhard

Lass die Shell für dich die Arbeit machen, dann musst du nicht selbst in der Registry rumsuchen und die Icons aus den Modulen extrahieren...

zusammenfalten · markieren

Delphi-Quellcode:

{
  ShellImageList.pas

  TImageList variants providing the shell's set of icons for an explorer
  like view.

  Version 1.3a

  Copyright (C) 1998-2008 Volker Siebert
  All rights reserved.

  Permission is hereby granted, free of charge, to any person obtaining a
  copy of this software and associated documentation files (the "Software"),
  to deal in the Software without restriction, including without limitation
  the rights to use, copy, modify, merge, publish, distribute, sublicense,
  and/or sell copies of the Software, and to permit persons to whom the
  Software is furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  DEALINGS IN THE SOFTWARE.
}

unit ShellImageList;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, ImgList, ShlObj;

type
  TCustomShellImageList = class(TCustomImageList)
  protected
    FHandle: DWORD;
    FDefaultFileImageIndex: Integer;
    FFolderImageIndex: array [Boolean] of Integer;
    FSizeFlag: UINT;
    FWorkingDirectory: string;
    function GetIconIndex(const Name: string; MoreFlags: DWORD = 0): Integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ImageIndexForExtension(const Extension: string): Integer;
    function ImageIndexForFileName(const FileName: string): Integer;
    function ImageIndexForFilePath(const FilePath: string): Integer;
    function ImageIndexForFolder(Selected: Boolean): Integer;
    function ImageIndexForPidl(Pidl: PItemIdList): Integer;
    function ImageIndexForShellFolder(const Index: Integer): Integer;
    property DefaultFileImageIndex: Integer read FDefaultFileImageIndex;
    property NormalFolderImageIndex: Integer read FFolderImageIndex[False];
    property SelectedFolderImageIndex: Integer read FFolderImageIndex[True];
  end;

  TSmallShellImageList = class(TCustomShellImageList)
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TLargeShellImageList = class(TCustomShellImageList)
  public
    constructor Create(AOwner: TComponent); override;
  end;

function GetShellImageListHandle(Small: Boolean): THandle;

procedure Register;

implementation

uses
  ActiveX, ComObj, ShellApi;

{ The handle of the image list is managened by the shell API, either globally
  (Windows 95/98/ME) or on a per-process basis (Windows NT/2K/XP/Vista).

  This is to ensure that image list indexes are valid with each variant of
  the shell image list.

  More info at <http://support.microsoft.com/kb/q234310/en/> and
  <http://support.microsoft.com/kb/q192055/en/>.

  We create a new folder in the temporary directory. This is used to query
  icons for normal folders and for all files that do not really exist.

  Note that this doesn't work for filenames that have an icon handler because
  the file doesn't really exist. These are e.g. EXE, ICO, CUR, and TTF. They
  get a standard symbol assigned by the shell.
}

function GetShellImageListHandle(Small: Boolean): THandle;
var
  List: TCustomShellImageList;
begin
  if Small then
    List := TSmallShellImageList.Create(nil)
  else
    List := TLargeShellImageList.Create(nil);
  try
    Result := List.Handle;
  finally
    List.Free;
  end;
end;

{ Returns the fully qualified path to the temporary directory,
  always including a trailing backslash.
}
function TempDirectory: string;

  function CheckDir(const d: string): string;
  begin
    if (d = '') or not DirectoryExists(d) then
      Result := ''
    else
      Result := IncludeTrailingPathDelimiter(ExpandFileName(d));
  end;

begin
  if CachedTempDirectory = '' then
  begin
    CachedTempDirectory := CheckDir(GetEnvironmentVariable('TMP'));
    if CachedTempDirectory = '' then
      CachedTempDirectory := CheckDir(GetEnvironmentVariable('TEMP'));
    if CachedTempDirectory = '' then
      if Win32Platform = VER_PLATFORM_WIN32_NT then
        CachedTempDirectory := CheckDir(GetEnvironmentVariable('USERPROFILE'));
    if CachedTempDirectory = '' then
      CachedTempDirectory := IncludeTrailingPathDelimiter(WindowsDirectory);
  end;
  Result := CachedTempDirectory;
end;

{ TCustomShellImageList }

constructor TCustomShellImageList.Create(AOwner: TComponent);

  procedure GetOverlayImages;
  var
    TempFile: string;
    WideName: WideString;
    DesktopFolder, TempDirFolder: IShellFolder;
    Malloc: IMalloc;
    IconOverlay: IShellIconOverlay;
    pidlTempDir, pidlTempFile: PItemIdList;
    FileHandle: THandle;
    Eaten, Attributes: DWORD;
    OverlayIndex: Integer;
  begin
    // See <http://support.microsoft.com/kb/q192055/en/>
    if FAILED(SHGetMalloc(Malloc)) then
      Exit;

    pidlTempDir := nil;
    pidlTempFile := nil;
    try
      if FAILED(SHGetDesktopFolder(DesktopFolder)) then
        Exit;

      TempFile := Format('temp%d.lnk', [GetCurrentProcessId]);

      FileHandle := CreateFile(PChar(FWorkingDirectory + TempFile),
        GENERIC_WRITE, 0, nil, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0);
      CloseHandle(FileHandle);

      try
        WideName := FWorkingDirectory;
        Attributes := 0;
        if FAILED(DesktopFolder.ParseDisplayName(0, nil, PWideChar(WideName),
             Eaten, pidlTempDir, Attributes)) then
          Exit;

        if FAILED(DesktopFolder.BindToObject(pidlTempDir, nil,
             IID_IShellFolder, TempDirFolder)) then
          Exit;

        if not Supports(TempDirFolder, IShellIconOverlay, IconOverlay) then
          Exit;

        WideName := TempFile;
        Attributes := 0;
        if FAILED(TempDirFolder.ParseDisplayName(0, nil, PWideChar(WideName),
             Eaten, pidlTempFile, Attributes)) then
          Exit;

        IconOverlay.GetOverlayIndex(pidlTempFile, OverlayIndex);
      finally
        DeleteFile(PChar(FWorkingDirectory + TempFile));
      end;
    finally
      if pidlTempDir <> nil then
        Malloc.Free(pidlTempDir);
      if pidlTempFile <> nil then
        Malloc.Free(pidlTempFile);
    end;
  end;

begin
  inherited;

  // Get an empty working directory
  FWorkingDirectory := IncludeTrailingPathDelimiter(TempDirectory) +
    '{EEB74622-1B97-4687-84B6-11D85542A91E}'
    ;
  ForceDirectories(FWorkingDirectory);
  FWorkingDirectory := IncludeTrailingPathDelimiter(FWorkingDirectory);

  FFolderImageIndex[False] := GetIconIndex('');
  FFolderImageIndex[True ] := GetIconIndex('', SHGFI_OPENICON);
  FDefaultFileImageIndex := GetIconIndex(FWorkingDirectory + 'Dummy');

  if Win32Platform = VER_PLATFORM_WIN32_NT then
    GetOverlayImages;
end;

destructor TCustomShellImageList.Destroy;
begin
  RemoveDir(FWorkingDirectory);
  inherited;
end;

function TCustomShellImageList.GetIconIndex(const Name: string; MoreFlags: DWORD): Integer;
var
  Full: string;
  Attr, Flags: DWORD;
  Info: TSHFileInfo;
  Hdl: DWORD;
begin
  Flags := FSizeFlag or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES or
    (MoreFlags and $ffffff);
  if Name = '' then
  begin
    Full := ExcludeTrailingPathDelimiter(FWorkingDirectory);
    Attr := FILE_ATTRIBUTE_DIRECTORY;
  end
  else
  begin
    Full := Name;
    if MoreFlags and $10000000 <> 0 then
      Attr := FILE_ATTRIBUTE_NORMAL
    else
    begin
      Attr := GetFileAttributes(PChar(Full));
      if Attr = DWORD(-1) then
        Attr := FILE_ATTRIBUTE_NORMAL;
    end;
  end;

  FillChar(Info, SizeOf(Info), 0);
  Hdl := SHGetFileInfo(PChar(Full), Attr, Info, SizeOf(Info), Flags);
  if Hdl = 0 then
  begin
    if FHandle = 0 then
      RaiseLastOSError;

    Result := -1;
  end
  else
  begin
    if FHandle = 0 then
    begin
      Handle := Hdl;
      ShareImages := True;
      FHandle := Hdl;
    end;

    Result := Info.iIcon;
  end;
end;

function TCustomShellImageList.ImageIndexForExtension(const Extension: string): Integer;
begin
  if Extension = '' then
    Result := FDefaultFileImageIndex
  else if Extension[1] = '.' then
    Result := GetIconIndex(FWorkingDirectory + 'Dummy' + Extension)
  else
    Result := GetIconIndex(FWorkingDirectory + 'Dummy.' + Extension)
end;

function TCustomShellImageList.ImageIndexForFileName(const FileName: string): Integer;
begin
  if FileName = '' then
    Result := FDefaultFileImageIndex
  else
    Result := GetIconIndex(FWorkingDirectory + FileName, $10000000);
end;

function TCustomShellImageList.ImageIndexForFilePath(const FilePath: string): Integer;
begin
  if FilePath = '' then
    Result := FDefaultFileImageIndex
  else
    Result := GetIconIndex(FilePath);
end;

function TCustomShellImageList.ImageIndexForFolder(Selected: Boolean): Integer;
begin
  Result := FFolderImageIndex[Selected];
end;

function TCustomShellImageList.ImageIndexForPidl(Pidl: PItemIdList): Integer;
var
  Info: TSHFileInfo;
  Flags: DWORD;
begin
  if Pidl = nil then
    Result := FDefaultFileImageIndex
  else
  begin
    Flags := FSizeFlag or SHGFI_SYSICONINDEX or SHGFI_PIDL;
    if SHGetFileInfo(PChar(Pidl), 0, Info, SizeOf(Info), Flags) = 0 then
      RaiseLastOSError;
    Result := Info.iIcon;
  end;
end;

function TCustomShellImageList.ImageIndexForShellFolder(const Index: Integer): Integer;
var
  pidl: PItemIdList;
  Info: TSHFileInfo;
  Malloc: IMalloc;
  Flags: DWORD;
begin
  Result := NormalFolderImageIndex;

  pidl := nil;
  try
    if SUCCEEDED(SHGetSpecialFolderLocation(0, Index, pidl)) then
    begin
      FillChar(Info, SizeOf(Info), 0);
      Flags := FSizeFlag or SHGFI_SYSICONINDEX or SHGFI_PIDL;
      if SHGetFileInfo(PChar(pidl), 0, Info, SizeOf(Info), Flags) <> 0 then
        Result := Info.iIcon;
    end;
  finally
    if pidl <> nil then
      if SUCCEEDED(SHGetMalloc(Malloc)) then
        Malloc.Free(pidl);
  end;
end;

{ TSmallShellImageList }

constructor TSmallShellImageList.Create(AOwner: TComponent);
begin
  FSizeFlag := SHGFI_SMALLICON;
  inherited;
end;

{ TLargeShellImageList }

constructor TLargeShellImageList.Create(AOwner: TComponent);
begin
  FSizeFlag := SHGFI_LARGEICON;
  inherited;
end;

{ Registration }

procedure Register;
begin
  RegisterComponents('Flocke', [TSmallShellImageList, TLargeShellImageList]);
end;

end.

Sorry für den Quereinstieg aber habe ein sehr ähnliches Problem. Es geht darum die Icons aus der system32.dll in eine Imageliste zu laden. Hierbei sollte der Index eines jeden Icons gleich bleiben. Mein Ziel ist es in meinem Programm immer nur den Index speichern zu müssen damit ich über diesen an die jeweiligen Bilder kommen kann.

Dachte ich kann das evtl. mit dieser hier angehängten ShellImageList lösen doch wenn ich sie einbinde kommt die Fehlermeldung "Undefinierter Bezeichner CachedTempDirectory" fehlt mir da noch was?

Ja, eine globale Variable mit eben diesem Namen.

markieren

Delphi-Quellcode:

..
implementation
..
var
  CachedTempDirectory: string;
..

Das soll wohl die mehrfache Abfrage beschleunigen.

Grüsse, Dirk

Danke... hab jetzt in der Klasse die globale Variable angelegt und jetzt ist die Meldung weg. Habe jetzt mal den COnstructor aufgerufen und jeweils eine Small, Large und Costumlist estellt. Scheinbar fehlt da aber noch was weil er mir nur 6 Items pro Liste zählt.

Kann mir vielleicht jemand in ein paar kurzen Sätzen erklären was ich mit der Unit machen kann bzw. wie diese eingebunden wird?

Du möchtest diese Unit imho garnicht verwenden, sondern ExtractIconEx() benutzen um an alle Icons in einer Datei heranzukommen.

Das gehört eigentlich nicht in diesen Thread.

Grüsse, Dirk