PureBasic Forums - English

dige wrote: Mon Apr 07, 2025 9:08 am maybe thats helps..

Proper COM result checking
Null checks for all COM pointers
Safe resource cleanup
Encapsulated image copy logic
Stack remains intact
Prevents memory corruption that caused TestProc() to return NaN.

Code: Select all

Procedure GetShellThumbnail(Filename.s, ImageNr, Width, Height, Depth=32)
   Protected Result = #False
   Protected Desktop.IShellFolder, Folder.IShellFolder, Extract.IExtractImage
   Protected *pidlFolder.ITEMIDLIST = #Null, *pidlFile.ITEMIDLIST = #Null
   Protected Bitmap = 0, Priority, Flags = 0
   Protected ImageTempNr, iws, BuffPos, ix, iy
   Protected size.SIZE, bm.BITMAP, res

   size\cx = Width
   size\cy = Height
   Flags | $4  ; #IEIFLAG_ASPECT
   Flags | $40 ; #IEIFLAG_ORIGSIZE
   
   
   res = CoInitialize_(0)
   If res = #S_OK Or res = #S_FALSE
      If SHGetDesktopFolder_(@Desktop) = #S_OK And Desktop
         If Desktop\ParseDisplayName(#Null, #Null, GetPathPart(Filename), #Null, @*pidlFolder, #Null) = #S_OK And *pidlFolder
            If Desktop\BindToObject(*pidlFolder, #Null, ?IID_IShellFolder, @Folder) = #S_OK And Folder
               If Folder\ParseDisplayName(#Null, #Null, GetFilePart(Filename), #Null, @*pidlFile, #Null) = #S_OK And *pidlFile
                  If Folder\GetUIObjectOf(#Null, 1, @*pidlFile, ?IID_IExtractImage, 0, @Extract) = #S_OK And Extract
                     If Extract\GetLocation(Space(#MAX_PATH), #MAX_PATH, @Priority, @size, Depth, @Flags) = #S_OK
                        If Extract\Extract(@Bitmap) = #S_OK And Bitmap
                           If GetObject_(Bitmap, SizeOf(BITMAP), @bm)
                              ImageTempNr = CreateImage(ImageNr, bm\bmWidth, bm\bmHeight, bm\bmBitsPixel, #PB_Image_Transparent)
                              If ImageTempNr
                                 If ImageNr = #PB_Any : ImageNr = ImageTempNr : EndIf
                                 If StartDrawing(ImageOutput(ImageNr))
                                    iws = DrawingBufferPitch()
                                    BuffPos = DrawingBuffer() + (iws * bm\bmHeight) - iws
                                    For iy = 0 To bm\bmHeight - 1
                                       CopyMemory(bm\bmBits + (iy * bm\bmWidthBytes), BuffPos - (iy * iws), iws)
                                    Next
                                    StopDrawing()
                                    Result = ImageNr
                                 EndIf
                                 If Result = #False : FreeImage(ImageNr) : EndIf
                              EndIf
                           EndIf
                           DeleteObject_(Bitmap)
                        EndIf
                     EndIf
                     Extract\Release()
                  EndIf
                  CoTaskMemFree_(*pidlFile)
               EndIf
               Folder\Release()
            EndIf
            CoTaskMemFree_(*pidlFolder)
         EndIf
         Desktop\Release()
      EndIf
      CoUninitialize_()
   EndIf

   ProcedureReturn Result

   DataSection
      IID_IShellFolder:  ; {000214E6-0000-0000-C000-000000000046}
      Data.l $000214E6
      Data.w $0000, $0000
      Data.b $C0, $00, $00, $00, $00, $00, $00, $46

      IID_IExtractImage:  ; {BB2E617C-0920-11D1-9A0B-00C04FC2D6C1}
      Data.l $BB2E617C
      Data.w $0920, $11D1
      Data.b $9A, $0B, $00, $C0, $4F, $C2, $D6, $C1
   EndDataSection
EndProcedure

Unfortunately i am still getting NaN with your code. It seems that" Extract\Extract(@Bitmap)" causes the bug.

Edit: One thing i found out is that if i keep width and height at 256 or lower then the error never seems to happen (256 * 256 = 65536 (2 bytes)) maybe it has something to do with that and there is a wrong type defined somewhere. I find it also odd that it does work perfectly with the C backend. Maybe this is a compiler bug and should be posted in bugs section?