Delphi 替代SHGetFileInfoW函数

我使用的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;

---

您可以从注册表中找到给定文件扩展名的

default图标

，并使用

ExtractIconEx

我不知道它是否比SHGetFileInfo快

编辑：

我已经（从示例中）提取了从扩展中获取图标的部分。 它实际上工作得很快。可以进一步优化。 （我稍微修改了代码）：

//在注册表中查找特定文件扩展名的图标
函数TForm1.RegistryConExtraction（扩展名：string）：整数；
变量
雷基：树木学；
IconPos：整数；
ASSOCAPINFO：字符串；
提取路径，文件名：字符串；
IconHandle、PLargeIcon、PSmallIcon:HICON；
安尼康：提康；
开始
结果：=0；//默认图标
如果扩展名为[1]'.'，则扩展名为：='.'+扩展名；
RegKey:=TRegistry.Create（KEY\u READ）；
尝试
//KEY\u QUERY\u值授予查询子键数据的权限。
RegKey.RootKey:=HKEY_CLASSES_ROOT；//设置用于图标信息查找的文件夹
如果RegKey.OpenKeyReadOnly（扩展名），那么//扩展名是否存在？
尝试
AssocAppInfo:=RegKey.ReadString（“”）；//读取应用程序密钥
RegKey.CloseKey；
除了
出口
结束；
是否存在（（AssocAppInfo“”）和//应用程序密钥和图标信息？
（RegKey.OpenKeyReadOnly（AssocAppInfo+'\DefaultIcon'））然后
尝试
提取路径：=RegKey.ReadString（“”）；//图标路径
RegKey.CloseKey；
除了
出口
结束；
最后
RegKey.Free；
结束；
//IconPos键ie中逗号后的图标：C:\Program Files\Winzip\Winzip.Exe，0
//我们得到图标的键了吗？图标在逗号分隔符后是否存在？
如果（（提取路径“”）和（位置（“，”，提取路径）0）），则
开始
//注册表项中的文件名在逗号分隔符之前
文件名：=复制（提取路径，1，位置（'，'，提取路径）-1）；
//从ExtractPath字符串中逗号后提取图标索引
尝试
IconPos:=stroint（复制（提取路径，位置（'，，提取路径）+1，
长度（提取路径）-Pos（'，，提取路径）+1）；
除了
出口
结束；
IconHandle:=ExtractIconEx（PChar（文件名）、IconPos、PLargeIcon、PSmallIcon，1）；
如果（0），则
开始
AnIcon:=TIcon.Create；
AnIcon.Handle:=PLargeIcon；
图1.图片分配（AnIcon）；
图1.刷新；
免费的；
结束；
破坏图标（PLargeIcon）；
破坏图标（PSmallIcon）；
结束；
结束；
程序TForm1.按钮1单击（发送方：TObject）；
变量
t1，t2:DWORD；
开始
t1:=GetTickCount；
registryConExtraction（'.txt'）；
t2:=GetTickCount；
备忘录1.行。添加（IntToStr（t2-t1））；
结束；

---

EDIT2:示例代码现在与Vista/Win7 UAC兼容。

您可以从注册表中找到给定文件扩展名的

default图标，并使用
ExtractIconEx

我不知道它是否比SHGetFileInfo快

编辑：

我已经（从示例中）提取了从扩展中获取图标的部分。
它实际上工作得很快。可以进一步优化。
（我稍微修改了代码）：

//在注册表中查找特定文件扩展名的图标
函数TForm1.RegistryConExtraction（扩展名：string）：整数；
变量
雷基：树木学；
IconPos：整数；
ASSOCAPINFO：字符串；
提取路径，文件名：字符串；
IconHandle、PLargeIcon、PSmallIcon:HICON；
安尼康：提康；
开始
结果：=0；//默认图标
如果扩展名为[1]'.'，则扩展名为：='.'+扩展名；
RegKey:=TRegistry.Create（KEY\u READ）；
尝试
//KEY\u QUERY\u值授予查询子键数据的权限。
RegKey.RootKey:=HKEY_CLASSES_ROOT；//设置用于图标信息查找的文件夹
如果RegKey.OpenKeyReadOnly（扩展名），那么//扩展名是否存在？
尝试
AssocAppInfo:=RegKey.ReadString（“”）；//读取应用程序密钥
RegKey.CloseKey；
除了
出口
结束；
是否存在（（AssocAppInfo“”）和//应用程序密钥和图标信息？
（RegKey.OpenKeyReadOnly（AssocAppInfo+'\DefaultIcon'））然后
尝试
提取路径：=RegKey.ReadString（“”）；//图标路径
RegKey.CloseKey；
除了
出口
结束；
最后
RegKey.Free；
结束；
//IconPos键ie中逗号后的图标：C:\Program Files\Winzip\Winzip.Exe，0
//我们得到图标的键了吗？图标在逗号分隔符后是否存在？
如果（（提取路径“”）和（位置（“，”，提取路径）0）），则
开始
//注册表项中的文件名在逗号分隔符之前
文件名：=复制（提取路径，1，位置（'，'，提取路径）-1）；
//从ExtractPath字符串中逗号后提取图标索引
尝试
IconPos:=stroint（复制（提取路径，位置（'，，提取路径）+1，
长度（提取路径）-Pos（'，，提取路径）+1）；
除了
出口
结束；
IconHandle:=ExtractIconEx（PChar（文件名）、IconPos、PLargeIcon、PSmallIcon，1）；
如果（0），则
开始
AnIcon:=TIcon.Create；
AnIcon.Handle:=PLargeIcon；
图1.图片分配（AnIcon）；
图1.刷新；
免费的；
结束；
破坏图标（PLargeIcon）；
破坏图标（PSmallIcon）；
结束；
结束；
程序TForm1.按钮1单击（发送方：TObject）；
变量
t1，t2:DWORD；
开始
t1:=GetTickCount；
registryConExtraction（'.txt'）；
t2:=GetTickCount；
备忘录1.行。添加（IntToStr（t2-t1））；
结束；

EDIT2:示例代码现在与Vista/Win7 UAC兼容。
只需在线程中运行它。或者不要在启动时读取所有图标，j
// 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;