Замена для функции SHGetFileInfoW

Question

У меня проблема с используемой функцией SHGetFileInfoW.

Это довольно медленное и первое чтение при запуске (инициализация) занимает 100 мс.

В MSDN остается, что должно бытьчитать из потока, а не из основного потока, потому что он может заблокировать процесс.

Я хочу использовать какую-то другую функцию, если она есть, для чтения значков.

Другое дело.Как можно читать большие иконки, в настоящее время я могу читать до 32x32 (SHGFI_LARGEICON)

Спасибо!

Фактический код:

procedure TForm1.LoadIcons;
var
  Info:     TShFileInfo;
  Icon:     TIcon;
  Flags:    UINT;
  FileName: PAnsiChar;

begin
  FileName := '.txt';
  Flags := SHGFI_USEFILEATTRIBUTES or SHGFI_ICON or SHGFI_LARGEICON;
  Icon := TIcon.Create;
  try
    SHGetFileInfo(FileName, FILE_ATTRIBUTE_NORMAL, Info,
      SizeOf(Info), Flags);
    Icon.Handle := Info.hIcon;
    Image1.Picture.Assign(Icon);
    Image1.Refresh;
  finally
    DestroyIcon(Info.hIcon);
    Icon.Free;
  end;
end;

Answer 1

Вы можете найти DefaultIcon для данного расширения файла из реестра и использовать ExtractIconEx. Вот пример

Не знаю, быстрее ли это SHGetFileInfo

EDIT:

Я извлек (из образца) часть, которая получает ЗНАЧОК от Расширения. На самом деле это работает очень быстро. можно было бы оптимизировать больше. (Я немного изменил код):

// find the icon for a certain file extension in the registry
function TForm1.RegistryIconExtraction(Extension : string): integer;
var
    RegKey : TRegistry;
    IconPos : integer;
    AssocAppInfo : string;
    ExtractPath, FileName : string;
    IconHandle, PLargeIcon, PSmallIcon : HICON;
    AnIcon : TIcon;

begin
  Result := 0; // default icon

  if Extension[1] <> '.' then Extension := '.' + Extension;

  RegKey := TRegistry.Create(KEY_READ);
  try
    // KEY_QUERY_VALUE grants permission to query subkey data.
    RegKey.RootKey := HKEY_CLASSES_ROOT; // set folder for icon info lookup
    if RegKey.OpenKeyReadOnly(Extension) then // extension key exists?
    try
      AssocAppInfo := RegKey.ReadString('');  // read app key
      RegKey.CloseKey;
    except
      Exit;
    end;
    if ((AssocAppInfo <> '') and  // app key and icon info exists?
      (RegKey.OpenKeyReadOnly(AssocAppInfo + '\DefaultIcon'))) then
    try
      ExtractPath := RegKey.ReadString(''); // icon path
      RegKey.CloseKey;
    except
       Exit;
    end;
  finally
    RegKey.Free;
  end;

  // IconPos after comma in key  ie: C:\Program Files\Winzip\Winzip.Exe,0
  // did we get a key for icon, does IconPos exist after comma seperator?
  If ((ExtractPath <> '') and (pos(',', ExtractPath) <> 0)) then
  begin

    // Filename in registry key is before the comma seperator
    FileName := Copy(ExtractPath, 1, Pos(',', ExtractPath) - 1);
    // extract the icon Index from after the comma in the ExtractPath string
    try
      IconPos := StrToInt(copy(ExtractPath, Pos(',', ExtractPath) + 1,
        Length(ExtractPath) - Pos(',', ExtractPath) + 1));
    except
      Exit;
    end;

    IconHandle := ExtractIconEx(PChar(FileName), IconPos, PLargeIcon, PSmallIcon, 1);

    If (PLargeIcon <> 0) then
    begin
      AnIcon := TIcon.Create;
      AnIcon.Handle := PLargeIcon;

      Image1.Picture.Assign(AnIcon);
      Image1.Refresh;

      AnIcon.Free;
    end;

    DestroyIcon(PLargeIcon);
    DestroyIcon(PSmallIcon);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  t1, t2: DWORD;
begin
  t1 := GetTickCount;
  RegistryIconExtraction('.txt');
  t2 := GetTickCount;
  Memo1.Lines.Add(IntToStr(t2-t1));
end;

EDIT2: Пример кода теперь совместим с Vista / Win7 UAC.