Delphi 从线程调用 shgetfileinfo 失败

Question

    function GetFileIcon(const filename:string): HICON;
var
  shfi: TShFileInfo;
begin
  try
    FillChar(shfi, SizeOf(TShFileInfo), 0);
    ShGetFileInfo(PChar(filename), 0, shfi, SizeOf(TShFileInfo), SHGFI_ICON or SHGFI_LARGEICON);
    Result := shfi.hIcon;
  except
    Result := 0;
  end;
end;

使用delphi xe2，在win 7 64位上，这个函数在Tthread中调用时通常会返回0，但从主线程调用时总是正常工作。它看起来像一个 shell 初始化问题，因为过一段时间它也会在 Thread 中工作。 我在堆栈溢出（Calling SHGetFileInfo in thread to avoid UI freeze）中发现了一个类似的问题，但它是针对 c++ 语言的，所以我没有整理出来。

• 更新：看来 ShGetFileInfo 不是线程安全的。当有多个线程同时调用它时，它会失败。见大卫 赫弗曼的回答如下。同样使用 CoInitializeEx 而不是 Coinitialize 对多线程没有帮助。您必须使用 TCriticalSection 对访问进行序列化。

Answer 1

来自documentation：

在调用 SHGetFileInfo 之前，您必须使用 CoInitialize 或 OleInitialize 初始化组件对象模型 (COM)。

在 GUI 应用程序中，COM 在主线程中初始化。但是来自不会自动发生的其他线程。您需要明确地执行此操作。

除此之外，您没有正确处理错误。请记住，Windows API 函数不会引发异常。所以你的异常处理程序是没有意义的，应该被删除。相反，您需要检查对SHGetFileInfo 的调用的返回值，如文档中所述。

除了您的代码可以正常工作之外，正如该程序所演示的：

{$APPTYPE CONSOLE}

uses
  Classes, Windows, ActiveX, ShellAPI;

var
  hThread: THandle;
  ThreadId: Cardinal;

function ThreadFunc(Parameter: Pointer): Integer;
var
  shfi: TSHFileInfo;
begin
  CoInitialize(nil);
  Try
    if ShGetFileInfo('C:\windows\explorer.exe', 0, shfi, SizeOf(shfi), SHGFI_ICON or SHGFI_LARGEICON)=0 then
    begin
      Writeln('ShGetFileInfo Failed');
      Result := 1;
      exit;
    end;
    Writeln(shfi.hIcon);
  Finally
    CoUninitialize;
  End;
  Result := 0;
end;

begin
  hThread := BeginThread(nil, 0, ThreadFunc, nil, 0, ThreadId);
  WaitForSingleObject(hThread, INFINITE);
  CloseHandle(hThread);
  Readln;
end.

我希望您观察到的任何故障实际上都与您尝试检查的特定文件有关。

---

更新：似乎ShGetFileInfo 不是线程安全的。当有多个线程同时调用它时，它会失败。我相信您需要使用锁序列化对ShGetFileInfo 的调用。例如，TCriticalSection。

以下程序基于您在 cmets 中提供的 SSCCE，演示了这一点：

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes,
  SyncObjs,
  Windows,
  ActiveX,
  ShellAPI;

var
  hThreads: TWOHandleArray;
  ThreadId: Cardinal;
  Lock: TCriticalSection;

function ThreadFunc(Parameter: Pointer): Integer;
var
  shfi: TSHFileInfo;
  randomnumber: integer;
  fname: string;
begin
  CoInitialize(nil);
  Try
    fname := 'c:\desktop\file'+IntToStr(Integer(Parameter))+'.exe';

    Lock.Acquire;
    try
      if ShGetFileInfo(pchar(fname), 0, shfi, SizeOf(shfi), SHGFI_ICON or SHGFI_LARGEICON)=0 then
      begin
        Writeln('ShGetFileInfo Failed');
        Result := 1;
        exit;
      end;
      Writeln(shfi.hIcon);
    finally
      Lock.Release;
    end;
  Finally
    CoUninitialize;
  End;
  Result := 0;
end;

var
i: integer;
begin
  Lock := TCriticalSection.Create;
  for i := 0 to 9 do
    hThreads[i] := BeginThread(nil, 0, ThreadFunc, Pointer(i), 0, ThreadId);

  WaitForMultipleObjects(10, @hThreads,true, INFINITE);

  Readln;
end.

删除临界区，对ShGetFileInfo 的调用成功，但为图标句柄返回0。使用临界区，返回有效的图标句柄。