title: Multithreaded File Preview (Lazarus + WinAPI)
body: <br>
  Hello all,
  <p>i am having problems getting the file preview (the one shown on the right side in the Windows Explorer window) for a certain file.<br>
  So far fetching the file preview works fine, but it takes a long time (between 0.5 and 2 seconds). Thus i do not want it to be executed in the main thread (as this would interrupt the program gui).</p>
  <p>I tried to execute the file preview extraction in a worker thread, but this yields a <code>SIGSEGV</code>.
  <a href="https://i.stack.imgur.com/6TAEe.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/6TAEe.png" alt="&quot;External: SIGSEGV&quot;" /></a></p>
  <p>The call stack is also not really useful, it only shows that the exception is raised in <code>ShellObjHelper</code> in Line 141 (see source code below).<br>
  <a href="https://i.stack.imgur.com/y3Jew.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/y3Jew.png" alt="Call Stack" /></a></p>
  <p><strong>Source Code for main unit:</strong></p>
  <pre><code>type
      TThreadedImageInfo = record
          fileName: String;
          width: integer;
          height: integer;
          icon: TIcon;
          image: TImage;
          bmp: TBitmap;
          infoOut: String;
          memo: TMemo;
      end;
      PThreadedImageInfo = ^TThreadedImageInfo;
  
  procedure loadThumbnailImageFromFile(aData: Pointer);
  var
      XtractImage: IExtractImage;
      ColorDepth: integer;
      Flags: DWORD;
      RT: IRunnableTask;
  
      FileName: string;
      pThreadInfo: PThreadedImageInfo;
  begin
      pThreadInfo := PThreadedImageInfo(aData);
      if assigned(pThreadInfo) then begin
          FileName := pThreadInfo^.fileName;
          ColorDepth := 32;
          Flags := IEIFLAG_ASPECT or IEIFLAG_QUALITY or IEIFLAG_ORIGSIZE;     // = 580
  
          if FileExists(FileName) then begin
              if GetExtractImageItfPtr(FileName, XTractImage) then begin
                  if ExtractImageGetFileThumbnail(XtractImage, pthreadinfo^.Image.Width,
                          pthreadinfo^.Image.Height, ColorDepth, Flags, RT, pthreadinfo^.Bmp) then begin
                      if (Flags and IEIFLAG_CACHE) &lt;&gt; 0 then
                          pThreadInfo^.infoOut := pThreadInfo^.infoOut + 'Extractor does not cache the thumbnail.' + #13;
                      if (Flags and IEIFLAG_GLEAM) &lt;&gt; 0 then
                          pThreadInfo^.infoOut := pThreadInfo^.infoOut + 'The image has a gleam.' + #13;
                      if (Flags and IEIFLAG_NOSTAMP) &lt;&gt; 0 then
                          pThreadInfo^.infoOut := pThreadInfo^.infoOut + 'Extractor does not want an icon stamp on the thumbnail.' + #13;
                      if (Flags and IEIFLAG_NOBORDER) &lt;&gt; 0 then
                          pThreadInfo^.infoOut := pThreadInfo^.infoOut + 'Extractor does not want an a border around the thumbnail.' + #13;
                  end else if GetFileLargeIcon(FileName, pThreadInfo^.icon) then begin
                      pThreadInfo^.infoOut := 'Thumbnail is not available. Default icon displayed.';
                  end;
              end else begin
                  pThreadInfo^.infoOut := 'Error loading IExtractImage.';
              end;
          end else begin
              pThreadInfo^.infoOut := 'Error: File does not exist.';
          end;
      end;
  end;
  
  procedure threadDone(Sender: TObject; aData: Pointer);
  var
      pThreadInfo: PThreadedImageInfo;
  begin
      pthreadInfo := PThreadedImageInfo(aData);
      if assigned(pThreadInfo) then begin
          if assigned(pthreadInfo^.Bmp) then begin
              pthreadinfo^.Image.Picture.Assign(pthreadInfo^.Bmp);
          end else if assigned(pthreadInfo^.icon) then begin
              pthreadinfo^.Image.Picture.Assign(pthreadInfo^.icon);
          end else begin
              pThreadInfo^.Image.Picture.Assign(nil);
          end;
          if assigned(pThreadInfo^.memo) then
              pThreadInfo^.memo.Lines.Text := pThreadInfo^.infoOut;
          if assigned(pthreadInfo^.icon) then
              pthreadInfo^.icon.free();
          if assigned(pthreadInfo^.bmp) then
              pthreadInfo^.bmp.free();
      end;
      dispose(pthreadinfo);
  end;
  
  procedure TForm1.Button1Click(Sender: TObject);
  var
      pThreadInfo: PThreadedImageInfo;
  begin
      new(pThreadInfo);
      pThreadInfo^.fileName := Edit1.Text;
      pThreadInfo^.image := Image1;
      pThreadInfo^.memo := Memo1;
      pThreadInfo^.icon := nil;
      pThreadInfo^.bmp := nil;
      pThreadInfo^.infoOut := '';
  
      // use worker thread:
      //TThread.ExecuteInThread(@loadThumbnailImageFromFile, pThreadInfo, @threadDone);
  
      // use main thread:
      loadThumbnailImageFromFile(pThreadInfo);
      threadDone(nil, pThreadInfo);
  end;     
  </code></pre>
  <p><strong>Source code for helper unit:</strong></p>
  <pre><code>unit ShellObjHelper;
  
  {$MODE objfpc}{$H+}
  
  {$IFDEF VER100}{$DEFINE DELPHI3}{$ENDIF}
  
  interface
  
  uses
      Windows, ShlObj, ActiveX, ShellAPI, Graphics, SysUtils, ComObj;
  
  type
      { from ShlObjIdl.h }
      IExtractImage = interface
          ['{BB2E617C-0920-11D1-9A0B-00C04FC2D6C1}']
          function GetLocation(Buffer: PWideChar; BufferSize: DWORD; var Priority: DWORD; var Size: TSize;
                  ColorDepth: DWORD; var Flags: DWORD): HResult; stdcall;
          function Extract(var BitmapHandle: HBITMAP): HResult; stdcall;
      end;
  
      IRunnableTask = interface
          ['{85788D00-6807-11D0-B810-00C04FD706EC}']
          function Run: HResult; stdcall;
          function Kill(fWait: BOOL): HResult; stdcall;
          function Suspend: HResult; stdcall;
          function Resume: HResult; stdcall;
          function IsRunning: Longint; stdcall;
      end;
  
  const
      { from ShlObjIdl.h }
      ITSAT_MAX_PRIORITY      = 2;
      ITSAT_MIN_PRIORITY      = 1;
      ITSAT_DEFAULT_PRIORITY  = 0;
  
      IEI_PRIORITY_MAX        = ITSAT_MAX_PRIORITY;
      IEI_PRIORITY_MIN        = ITSAT_MIN_PRIORITY;
      IEIT_PRIORITY_NORMAL    = ITSAT_DEFAULT_PRIORITY;
  
      IEIFLAG_ASYNC     = $001;   // ask the extractor if it supports ASYNC extract (free threaded)
      IEIFLAG_CACHE     = $002;   // returned from the extractor if it does NOT cache the thumbnail
      IEIFLAG_ASPECT    = $004;   // passed to the extractor to beg it to render to the aspect ratio of the supplied rect
      IEIFLAG_OFFLINE   = $008;   // if the extractor shouldn't hit the net to get any content needs for the rendering
      IEIFLAG_GLEAM     = $010;   // does the image have a gleam? this will be returned if it does
      IEIFLAG_SCREEN    = $020;   // render as if for the screen  (this is exlusive with IEIFLAG_ASPECT)
      IEIFLAG_ORIGSIZE  = $040;   // render to the approx size passed, but crop if neccessary
      IEIFLAG_NOSTAMP   = $080;   // returned from the extractor if it does NOT want an icon stamp on the thumbnail
      IEIFLAG_NOBORDER  = $100;   // returned from the extractor if it does NOT want an a border around the thumbnail
      IEIFLAG_QUALITY   = $200;   // passed to the Extract method to indicate that a slower, higher quality image is desired,
                                  // re-compute the thumbnail
  
  // IShellFolder methods helper
  procedure ShellFolderBindToObject(const ShellFolder: IShellFolder; PIDL: PItemIDList; const riid: TGUID; out pv);
  function ShellFolderGetUIObjectOf(const ShellFolder: IShellFolder; cidl: DWORD; var PIDL: PItemIDList;
          riid: TGUID; out pv): Boolean;
  procedure ShellFolderParseDisplayName(const ShellFolder: IShellFolder; const DisplayName: string; out PIDL: PItemIDList);
  
  function GetExtractImageItfPtr(const FileName: string; out XtractImage: IExtractImage): Boolean;
  function GetFileLargeIcon(const FileName: string; out LargeIcon: TIcon): Boolean;
  function ExtractImageGetFileThumbnail(const XtractImage: IExtractImage; ImgWidth, ImgHeight, ImgColorDepth: Integer;
          var Flags: DWORD; out RunnableTask: IRunnableTask; out Bmp: TBitmap): Boolean;
  procedure GetShellFolderItfPtr(const FolderName: string; Malloc: IMalloc; out TargetFolder: IShellFolder);
  
  implementation
  
  procedure ShellFolderBindToObject(const ShellFolder: IShellFolder; PIDL: PItemIDList; const riid: TGUID; out pv);
  begin
      OleCheck(ShellFolder.BindToObject(PIDL, nil, riid, {$IFDEF DELPHI3}Pointer(pv){$ELSE}pv{$ENDIF}));
  end;
  
  function ShellFolderGetUIObjectOf(const ShellFolder: IShellFolder; cidl: DWORD; var PIDL: PItemIDList;
          riid: TGUID; out pv): Boolean;
  begin
      Result := NOERROR = ShellFolder.GetUIObjectOf(0, cidl, PIDL, riid, nil, {$IFDEF DELPHI3}Pointer(pv){$ELSE}pv{$ENDIF});
  end;
  
  procedure ShellFolderParseDisplayName(const ShellFolder: IShellFolder; const DisplayName: string; out PIDL: PItemIDList);
  var
      Attributes, Eaten: DWORD;
  begin
      OleCheck(ShellFolder.ParseDisplayName(0, nil, PWideChar(WideString(DisplayName)), Eaten, PIDL, Attributes));
  end;
  
  function GetExtractImageItfPtr(const FileName: string; out XtractImage: IExtractImage): Boolean;
  var
      TargetFolder: IShellFolder;
      FilePath: string;
      ItemIDList: PItemIDList;
      Malloc: IMalloc;
  begin
      FilePath := ExcludeTrailingBackslash(ExtractFilePath(FileName));
      OleCheck(SHGetMalloc(Malloc));
      GetShellFolderItfPtr(FilePath, Malloc, TargetFolder);
      ShellFolderParseDisplayName(TargetFolder, ExtractFileName(FileName), ItemIDList);
      try
          Result := ShellFolderGetUIObjectOf(TargetFolder, 1, ItemIDList, IExtractImage, XtractImage);
      finally
          Malloc.Free(ItemIDList);
      end;
  end;
  
  function GetFileLargeIcon(const FileName: string; out LargeIcon: TIcon): Boolean;
  var
      SFI: TSHFileInfo;
  begin
      result := SHGetFileInfo(PChar(FileName), FILE_ATTRIBUTE_ARCHIVE, SFI, sizeof(SFI), SHGFI_ICON or SHGFI_LARGEICON) &lt;&gt; 0;
      if result then begin
          LargeIcon := TIcon.Create;
          LargeIcon.Handle := SFI.hIcon;
      end;
  end;
  
  function ExtractImageGetFileThumbnail(const XtractImage: IExtractImage; ImgWidth, ImgHeight, ImgColorDepth: Integer;
          var Flags: DWORD; out RunnableTask: IRunnableTask; out Bmp: TBitmap): Boolean;
  var
      Size: TSize;
      Buf: array[0..MAX_PATH] of WideChar;
      BmpHandle: HBITMAP;
      Priority: DWORD;
      GetLocationRes: HRESULT;
  
      procedure FreeAndNilBitmap;
      begin
          {$IFNDEF DELPHI3}
          FreeAndNil(Bmp);
          {$ELSE}
          Bmp.Free;
          Bmp := nil;
          {$ENDIF}
      end;
  
  begin
      Result := False;
      RunnableTask := nil;
      Size.cx := ImgWidth;
      Size.cy := ImgHeight;
      Priority := IEIT_PRIORITY_NORMAL;
      Flags := Flags or IEIFLAG_ASYNC;
  
      ////////////////////////// EXCEPTION HERE, but only when multithreading /////////////////////////////////////////////////////
      GetLocationRes := XtractImage.GetLocation(Buf, sizeof(Buf), Priority, Size, ImgColorDepth, Flags);
  
      if (GetLocationRes = NOERROR) or (GetLocationRes = E_PENDING) then begin
          if GetLocationRes = E_PENDING then begin
              { if QI for IRunnableTask succeed, we can use RunnableTask
              interface pointer later to kill running extraction process.
              We could spawn a new thread here to extract image. }
              if S_OK &lt;&gt; XtractImage.QueryInterface(IRunnableTask, RunnableTask) then
                  RunnableTask := nil;
          end;
          Bmp := TBitmap.Create;
          try
              // This could consume a long time.
              // If RunnableTask is available then calling Kill() method will immediately abort the process.
              OleCheck(XtractImage.Extract(BmpHandle));
              Bmp.Handle := BmpHandle;
              Result := True;
          except
              on E: EOleSysError do begin
                  //-------------
                  OutputDebugString(PChar(string(E.ClassName) + ': ' + E.Message));
                  //-------------
                  FreeAndNilBitmap;
                  Result := False;
              end else begin
                  FreeAndNilBitmap;
                  raise;
              end;
          end; { try/except }
      end;
  end;
  
  procedure GetShellFolderItfPtr(const FolderName: string; Malloc: IMalloc; out TargetFolder: IShellFolder);
  var
      DesktopFolder: IShellFolder;
      ItemIDList: PItemIDList;
  begin
      OleCheck(SHGetDesktopFolder(DesktopFolder));
      ShellFolderParseDisplayName(DesktopFolder, FolderName, ItemIDList);
      try
          ShellFolderBindToObject(DesktopFolder, ItemIDList, IShellFolder, TargetFolder);
      finally
          Malloc.Free(ItemIDList);
      end;
  end;
  
  end.
  </code></pre>
  <p><strong>The actual question(s):</strong><br>
  Why is the image extraction working without multithreading, but failing when using a worker thread?<br>
  How can i make this work?</p>
  <p>I already started studying <a href="https://stackoverflow.com/questions/19523599/how-to-get-thumbnail-of-file-using-the-windows-api">this post</a> for another solution, but i am not yet sure how to do this.</p>
  <p><strong>Useful Informations:</strong><br>
  Source for helper unit code: <a href="https://stackoverflow.com/questions/2911837/how-to-retrieve-the-file-previews-used-by-windows-explorer-in-windows-vista-and">How to retrieve the file previews used by windows explorer in Windows vista and seven?</a>
  <br>Multithreading example: <a href="https://lazarus-ccr.sourceforge.io/docs/rtl/classes/tthread.executeinthread.html" rel="nofollow noreferrer">https://lazarus-ccr.sourceforge.io/docs/rtl/classes/tthread.executeinthread.html</a>
  <br>Activating PDF preview: open Adobe Acrobat Reader -&gt; Edit -&gt; Preferences -&gt; General -&gt; check &quot;Enable PDF thumbnail previews&quot;
  <br><br>
  I am using Lazarus v2.0.10 r63526 on Windows 10 Pro 64 bit.</p>