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, на победу 7 64bits, эта функция будет часто возвращать 0 при вызове внутри TThread, но всегда работает хорошо, когда вызывается из основного потока. Это похоже на проблему инициализации оболочки, потому что через некоторое время она будет работать и в Thread. Я нашел аналогичный вопрос в переполнении стека (Calling SHGetFileInfo in thread to avoid UI freeze), но он предназначен для языка C++, поэтому я не разобрался.

• Update: Кажется SHGetFileInfo не поточно. При одновременном вызове нескольких потоков он терпит неудачу. См. David Ответ Хеффермана ниже. Также использование CoInitializeEx вместо Coinitialize не помогает с несколькими потоками. Вы должны выполнить сериализацию доступа с помощью TCriticalSection.

Answer 1

Из documentation:

Вы должны инициализировать Component Object Model (COM) с CoInitialize или OleInitialize до вызова SHGetFileInfo.

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

Кроме того, вы неправильно обрабатываете ошибки. Помните, что в функциях Windows API не возникают исключения. Поэтому ваш обработчик исключений бессмыслен и должен быть удален. Вместо этого вам нужно проверить возвращаемое значение вашего звонка на SHGetFileInfo, как описано в документации.

Beyond, что ваш код работает, как показывает эта программа:

{$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. 

Я ожидаю, что любая неудача вы замечаете на самом деле связано с конкретным файлом, который вы пытаетесь осмотреть.

---

Update: Кажется 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 за значок ручки. С критической секцией возвращаются правильные значки.