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 初始化问题,因为一段时间后它也会在线程中工作。 我在堆栈溢出( Calling SHGetFileInfo in thread to avoid UI freeze )中发现了类似的问题,但它是针对 c++ 语言的,所以我没有整理出来。
- 更新:看来ShGetFileInfo不是线程安全的。当有多个线程同时调用它时,就会失败。见大卫 赫弗曼的回答如下。另外,使用 CoInitializeEx 而不是 Coinitialize 对多线程没有帮助。您必须使用 TCriticalSection 序列化访问。
最佳答案
来自documentation :
You must initialize Component Object Model (COM) with CoInitialize or OleInitialize prior to calling SHGetFileInfo.
在 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
。
以下程序基于您在评论中提供的 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
。对于关键部分,将返回有效的图标句柄。
关于windows - Delphi 从线程调用 shgetfileinfo 失败,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/21885962/