Results 1 to 11 of 11

Thread: Finally I have found the root of my problems...

  1. #1

    Thread Starter
    Fanatic Member
    Join Date
    Mar 2023
    Posts
    705

    Finally I have found the root of my problems...

    I'm a oldie (48 years) and was young back in EnumDesk era and learned alot from Randy Birch, Steve McMahon, Brad Martinez, the CCRP Project and many more I learned that "wierd and unexpected" COM errors can come from your own projects, specially if you are dealing with ActiveX which is a "wrapping" of COM into Controls.
    As this problem with ShGetFileInfo I now sorted and forked out and it depends on some wrong coding from my side that lay within any of my Controls within my on going project. (COM error so to speak).
    Therefore I find it very interesting that Fafalone says it depends on the layout of the ShGetFileInfo's Type which I knew it didn't depended on. And he did get support from VanGoghGaming in this matter.
    However I took all my BAS files and CLS-files and runned them WITH Fafanoe's TypeLib separated from all my CTL-files and WHOALA - everything worked fine again. I tried every case:
    Code:
    Public Type SHFILEINFO
            hIcon As Long                      '  out: icon
            iIcon As Long          '  out: icon index
            dwAttributes As Long               '  out: SFGAO_ flags
            szDisplayName(MAX_PATH - 1) As Integer '  out: display name (or path)
            szTypeName(79) As Integer        '  out: type name
    End Type
    
    Public Type SHFILEINFOA
        hIcon As Long
        iIcon As Long
        dwAttributes As Long
        szDisplayName As String * MAX_PATH
        szTypeName As String * 80
    End Type
    
    Public Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoW" (ByVal lpPath As Long, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
    Public Declare Function SHGetFileInfoFromPath Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal sPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFOA, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
    
    Public Declare Function SHGetFileInfoFromPidl Lib "shell32.dll" Alias "SHGetFileInfoW" (ByVal pidl As Long, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
    
    Private Sub Command1_Click()
      Dim pidl As Long
      
      pidl = ILCreateFromPath(StrPtr("C:\"))
    
      If pidl Then
        MsgBox GetItemIconIndexFromPath("c:\")
        MsgBox m_cShell32.GetItemIconIndex(pidl, True)
      End If
      
     m_cShell32.EnumLVItem pidl
    
    End Sub
    All versions worked as should without any COM errors.
    So the endpoint is that the problem lays within my controls (COM wrapping).
    All enums with ShGetFileInfo involved works fine without any ctl-files involved.
    I got a big job to sort out where the faults are.

    BUT the question still remains - Why did Fafalone focused on the differences in the SHGetFileInfo's Types? Instead of question me on if I done anything wrong in the ctl-files? One or more tiny errors which not detects of the debugger can cause unexpected exeption errors when dealing with ActiveX (COM).

  2. #2

    Thread Starter
    Fanatic Member
    Join Date
    Mar 2023
    Posts
    705

    Re: Finally I have found the root of my problems...

    I'm working from the last "problem child" and back.
    Now I nearly solved the problem with the ComboBoxEx ActiveX (COM Wrapper)
    A complete drivelist if drivelist = true
    Or shellbrowser if property Fillfrom = pidl/path or object
    No problems at all with the ShGetFileInfo.
    Still problems with the rest of the list - it doesn't show the dropdownlist when button pressed.
    Attached Images Attached Images  

  3. #3
    PowerPoster
    Join Date
    Nov 2017
    Posts
    3,081

    Re: Finally I have found the root of my problems...

    Quote Originally Posted by nebeln View Post
    BUT the question still remains - Why did Fafalone focused on the differences in the SHGetFileInfo's Types? Instead of question me on if I done anything wrong in the ctl-files? One or more tiny errors which not detects of the debugger can cause unexpected exeption errors when dealing with ActiveX (COM).
    I think fafalone has spent plenty of time trying to assist you with the numerous issues you've posted about recently. So to question why they didn't or weren't able to immediately hone in on the specific underlying issue in your project seems rather unappreciative on your part.

  4. #4

    Thread Starter
    Fanatic Member
    Join Date
    Mar 2023
    Posts
    705

    Re: Finally I have found the root of my problems...

    The underlaying problem/issue was not ShGerFileInfo.

  5. #5
    PowerPoster
    Join Date
    Nov 2017
    Posts
    3,081

    Re: Finally I have found the root of my problems...

    Does your project with with this definition (taken from your own earlier code)?

    Code:
    Public Type SHFILEINFO
        hIcon As Long
        iIcon As Long
        dwAttributes As SFGAO_Flags
        lpDisplayName As Long
        lpTypeName As Long
    End Type

  6. #6

    Thread Starter
    Fanatic Member
    Join Date
    Mar 2023
    Posts
    705

    Re: Finally I have found the root of my problems...

    Yes.

  7. #7
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,513

    Re: Finally I have found the root of my problems...

    Because 99.99% of the time, when a function is not working while you're calling it with the wrong UDT, it's because of the wrong UDT. Not just that, but on 64bit, SHGetFileInfo is much less forgiving and I myself had trouble with it not 6 months ago, so presumably the enhanced size checks could make it into 32bit as well.

    It's still going to come back to bite you if you ever want to use those last two members and haven't put the right buffer size.

  8. #8

    Thread Starter
    Fanatic Member
    Join Date
    Mar 2023
    Posts
    705

    Re: Finally I have found the root of my problems...

    I'm complete confused about this now. Earlier today worked all three varaints and now I got wierd memory exceptions causing it to crash for all three variants.

    Code:
    Public Type SHFILEINFOW
            hIcon As Long                      '  out: icon
            iIcon As Long          '  out: icon index
            dwAttributes As Long               '  out: SFGAO_ flags
            szDisplayName(MAX_PATH - 1) As Integer  '  out: display name (or path)
            szTypeName(79) As Integer         '  out: type name
    End Type
    
    Public Type SHFILEINFOA
        hIcon As Long
        iIcon As Long
        dwAttributes As Long
        szDisplayName As String * MAX_PATH
        szTypeName As String * 80
    End Type
    
    Public Type SHFILEINFOA
        hIcon As Long
        iIcon As Long
        dwAttributes As Long
        szDisplayName As Long
        szTypeName As Long
    End Type

  9. #9

    Thread Starter
    Fanatic Member
    Join Date
    Mar 2023
    Posts
    705

    Re: Finally I have found the root of my problems...

    Now I have spent some more time to investigate this matter and I *belive* to have found the answer once and for all.
    The problem itself is not within the UDT's because I tried to comment out and switch to following:
    Code:
    Public Function GetIImageList2(Optional ByVal iImageFlag As SHIL = SHIL_JUMBO) As IImageList2
      Dim pIml2 As IImageList2
      Dim ppIml2 As Long
      Dim hr As Long
      
      CoInitializeEx 0&, ByVal COINIT_APARTMENTTHREADED
      
      If FileIconInit(1) = 1 Then
        hr = SHGetImageList(iImageFlag, IID_IImagelist2, pIml2)
        If hr = S_OK Then
          MoveMemory GetIImageList2, pIml2, 4
        Else
          MsgBox "Error in SHGetImageList: #" & Hex(hr), vbExclamation
        End If
      Else
        MsgBox "Unable to Initialize Imagelists!", vbCritical
        Exit Function
      End If
      
    End Function
    
    hImlCB = ObjPtr(GetIImageList2(SHIL_LARGE)) <--- This is what I commented out (It's my routine)
    Shell_GetImageLists hImlLarge, hImlSmall <--- This is what I switched to (This is a Shell32 API)
    And guess what? This UDT below is now working again.

    Code:
    Public Type SHFILEINFO2W
            hIcon As Long                      '  out: icon
            iIcon As Long          '  out: icon index
            dwAttributes As Long               '  out: SFGAO_ flags
            szDisplayName As Long '(MAX_PATH - 1) As Integer  '  out: display name (or path)
            szTypeName As Long '(79) As Integer         '  out: type name
    End Type
    So my concultion is that IImageList2 interface if it's used with ObjPtr and same time using ShGetFileInfo dissrupt or corrupt the UDT's for ShGetFileInfo and forcing ShGetFileInfo to allocate wrong memory.

  10. #10
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,513

    Re: Finally I have found the root of my problems...

    In principle your CoInitialeEx call should be ignored since VB already called CoInitialize, but it would probably be better not to risk the chance since it's a different call. You don't need to try to initialize COM twice. When you have Sub Main() or Form1_Load, that's not actually the first thing that runs. There is an initialization routine VB6 inserts ahead of that which, among other things, initializes COM. You also haven't needed to call FileIconInit since pre-XP unless it's to reset it.

    But I think I see a much bigger problem: Since IImageList2 is a local variable, it's destroyed when it goes out of scope-- when that function exits. VB6 has no idea you're holding a reference to it. So himlCB is pointing to a null object. That's likely why what you commented out isn't working.

  11. #11

    Thread Starter
    Fanatic Member
    Join Date
    Mar 2023
    Posts
    705

    Re: Finally I have found the root of my problems...

    I'm a bit confused but not complete confused because this works fine partily as it should do.
    This is the code for the Drivelist option for the ComboBoxEx:
    Code:
    Public Property Let DriveList(ByVal bNewValue As Boolean)
      Dim objAllDrives As Drives
      Dim objDrive As Drive
      Dim iCount As Integer
      Dim sDrive As String
      Dim iIconIndex As Integer
      Dim pidlDrive As Long
      
      m_bDriveList = bNewValue
      
      If m_bDriveList = True Then
        SendMessage m_hWndCB, CB_RESETCONTENT, 0, 0
        
        Set FSO = New FileSystemObject
        Set objAllDrives = FSO.Drives
        
        For Each objDrive In objAllDrives
           sDrive = objDrive.DriveLetter & ":\"
           pidlDrive = ILCreateFromPathW(StrPtr(sDrive))
           sDrive = m_cShell32.GetDisplayName(pidlDrive, SIGDN_NORMALDISPLAY)
           iIconIndex = m_cShell32.GetItemIconIndex(pidlDrive)
           AddItem iCount, StrPtr(sDrive), iIconIndex, iIconIndex, 0
           iCount = iCount + 1
           CoTaskMemFree pidlDrive
        Next
         SendMessage m_hWndCB, CB_SETCURSEL, 0&, 0&
      Else
        SendMessage m_hWndCB, CB_RESETCONTENT, 0, 0
      End If
    And here is the code for the "FillFrom" option which also works nice as it should be.

    Code:
    Private Function pEnumShellItem(vItem)
      Dim pidlRoot As Long
      Dim nCSIDLs As CSIDLs
      Dim pidlEnum As Long
      Dim sPathOrFilename As String
      Dim lpPathOrFilename As Long
      Dim pISI As IShellItem
      Dim pISI_Child As IShellItem
      Dim pIESI As IEnumShellItems
      Dim hr As Long
      Dim lpDispName As Long
      Dim iCount As Integer
      Dim iIconIndex As Integer
      
      If VarType(vItem) = vbString Then
        sPathOrFilename = vItem
        If (sPathOrFilename = "") Or (Len(sPathOrFilename) = 0) Then Exit Function
        pidlRoot = ILCreateFromPathW(StrPtr(sPathOrFilename))
      End If
      
      If VarType(vItem) = vbLong Then
        lpPathOrFilename = vItem
        If lpPathOrFilename = 0 Then Exit Function
        'If the long value is a pidl
        If ILCreateFromPathW(lpPathOrFilename) = 0 Then
          If ILIsEmpty(lpPathOrFilename) <> 0 Then
            pidlRoot = lpPathOrFilename
          End If
        Else
          lpPathOrFilename = ILCreateFromPathW(lpPathOrFilename)
        End If
      End If
      
      If VarType(vItem) = vbObject Then
        Call SHGetIDListFromObject(ObjPtr(vItem), pidlRoot)
      End If
      
      If VarType(vItem) = vbInteger Or vbUserDefinedType Then
        If vItem >= &H0 Or vItem <= &HFF00 Then
          nCSIDLs = vItem
          pidlRoot = m_cShell32.GetPIDLFromSpecialFolder(nCSIDLs)
        End If
      End If
      
      hr = SHCreateItemFromIDList(pidlRoot, IID_IShellItem, pISI)
      
      If hr <> S_OK Then
        MsgBox "SHCreateItemFromIDList API Failed!", vbExclamation
        CoTaskMemFree pidlRoot
        Exit Function
      Else
        hr = pISI.BindToHandler(0&, BHID_EnumItems, IID__IEnumShellItems, pIESI)
        If hr <> S_OK Then
          MsgBox "IShellItem::BindToHandler Method Failed!", vbExclamation
          CoTaskMemFree pidlRoot
          Set pISI = Nothing
          Exit Function
        Else
          Call SendMessage(m_hWndCB, CB_RESETCONTENT, 0&, 0&)
          Do While pIESI.Next(1, pISI_Child, 0) = S_OK
            pISI_Child.GetDisplayName SIGDN_NORMALDISPLAY, lpDispName
            sDispName = StrConv(SysAllocString(lpDispName), vbFromUnicode)
            SHGetIDListFromObject ObjPtr(pISI_Child), pidlEnum
            iIconIndex = m_cShell32.GetItemIconIndex(pidlEnum)
            Debug.Print "iIconIndex: " & iIconIndex
            AddItem iCount, lpDispName, iIconIndex, iIconIndex, 4, 0, pidlEnum
            CoTaskMemFree lpDispName
            CoTaskMemFree pidlEnum
            iCount = iCount + 1
            SendMessage m_hWndCB, CB_SETMINVISIBLE, ByVal iCount, ByVal 0&
            UpdateWindow m_hWndCB
          Loop
          SendMessage m_hWndCB, CB_SETCURSEL, 0&, 0&
          Set pISI = Nothing
          Set pISI_Child = Nothing
          CoTaskMemFree pidlRoot
        End If
      End If
    End Function
    And here we got the problem child....

    Code:
    Public Function EnumLVItem(ByVal pidlRoot As Long, ByVal ucLV As ucBrowseForFolderList, Optional ByRef nCount As Long, Optional ByVal iGroupId As Integer = -1) As Long
      Dim pidlParent As Long
      Dim pidlEnum As Long
      Dim pidlChild As Long
      Dim pidlCombine As Long
      Dim pISI As IShellItem
      Dim pISI2 As IShellItem2
      Dim pISI_Child As IShellItem
      Dim pISIA As IShellItemArray
      Dim pIPAI As IParentAndItem
      Dim pISM As IShellMenu
      Dim pISF As IShellFolder2
      Dim pEIDL As IEnumIDList
      Static BHID_StorageEnum As UUID
      Dim pIESHI As IEnumShellItems
      Dim hr As Long
      Dim lpName As Long
      Dim lpNameRoot As Long
      Dim sName As String
      Dim sNameRoot As String
      Dim sTypeName As String
      Dim sExt As String
    
      Dim hIcon As Long
      Dim iIconIndex As Long
      Dim iRootIcon As Integer
      Dim dwAttribs As Long
      Dim hWndIL As Long
      Dim hWndILThumb As Long
      Dim n As Long
      Dim pHTN As Long
    
      n = 0
    
      If ucLV.UseThumbNails = True Then
        hWndILThumb = SendMessage(ucLV.Handle, LVM_GETIMAGELIST, ByVal LVSIL_NORMAL, 0)
      Else
        Set g_ILLV = GetIImageList2(SHIL_EXTRALARGE)
        g_hWndIL = ObjPtr(g_ILLV)
        Call SendMessage(ucLV.Handle, LVM_SETIMAGELIST, ByVal LVSIL_NORMAL, ByVal g_hWndIL)
      End If
      
      hr = SHCreateItemFromIDList(pidlRoot, IID_IShellItem, pISI)
    '
    '  'IIDFromString StrPtr("{4621A4E3-F0D6-4773-8A9C-46E77B174840}"), BHID_StorageEnum
    '  'BHID_EnumItems
      hr = pISI.BindToHandler(0, BHID_EnumItems, IID__IEnumShellItems, pIESHI)
    '  'hr = pISI.BindToHandler(0, BHID_SFObject, IID__IShellFolder, pISF)
    '
      Do While pIESHI.Next(1, pISI_Child, 0) = S_OK
           Set pIPAI = pISI_Child
           Set pISI2 = pISI_Child
    
           pIPAI.GetParentAndItem pidlParent, pISF, pidlChild
    
           pISI_Child.GetDisplayName SIGDN_NORMALDISPLAY, lpName
    
           pidlEnum = GetPIDLFromObject(pISI_Child)
    
           pidlCombine = ILCombine(pidlParent, pidlChild)
           'iIconIndex = GetItemIconIndex(pidlEnum) <-- THIS CAUSING FATAL CRASH!!!
           Debug.Print iIconIndex
           'hIcon = GetItemIconHandle(pidlEnum, True) <-- THIS CAUSING FATAL CRASH!!!
           DoEvents
    
           If ucLV.UseThumbNails = True Then
             'ImageList_SetIconSize hWndILThumb, ucLV.ThumbNailSize, ucLV.ThumbNailSize
             GetThumbNailFromPidlItem pidlEnum, ucLV, pHTN
             If pHTN <> 0 Then
               iIconIndex = ImageList_Add(hWndILThumb, pHTN, pHTN)
               If iIconIndex > -1 Then
                 Form1.Caption = iIconIndex & " Thumbnails Added to the ImageList!"
                 DeleteObject pHTN
               End If
             Else
               'Error - item probably has no thumbnail.
               hIcon = GetItemIconHandle(pidlEnum, True)
               If hIcon <> 0 Then
                 iIconIndex = ImageList_AddIcon(hWndILThumb, hIcon)
                 DestroyIcon hIcon
               End If
             End If
           Else
             iIconIndex = GetItemIconIndex(pidlEnum) '<-- THIS CAUSING FATAL CRASH!!!
             Debug.Print "iIconIndex: " & iIconIndex
           End If
    '
    '       'GetIShellLibrary pidlEnum  '<---- HOW TO JUMP OVER THE AUTOMATION ERROR?
           If ucLV.IsGroupViewEnabled = True Then
             SHGetNameFromIDList pidlRoot, SIGDN_NORMALDISPLAY, lpNameRoot
             sNameRoot = StrConv(SysAllocString(lpNameRoot), vbFromUnicode)
             'iRootIcon = GetItemIconIndex(pidlRoot) <-- THIS CAUSING FATAL CRASH!!!
             'sNameRoot = StrConv(SysAllocString(lpNameRoot), vbFromUnicode)
    '
             ucLV.AddGroup n, sNameRoot, iRootIcon, sNameRoot & " Mappar - Fälls ut eller fälls in via pilikonen i högra hörnet.    " & n & " Object."
    
             pidlCombine = ILCombine(pidlParent, pidlChild)
    
             SHGetNameFromIDList pidlCombine, SIGDN_NORMALDISPLAY, lpName
    
             sName = StrConv(SysAllocString(lpName), vbFromUnicode)
    
             ucLV.AddItems n, sName, iIconIndex, iGroupId, pidlCombine
           Else
    
             pidlCombine = ILCombine(pidlParent, pidlChild)
    
             SHGetNameFromIDList pidlCombine, SIGDN_NORMALDISPLAY, lpName
    
             sName = StrConv(SysAllocString(lpName), vbFromUnicode)
    
             ucLV.AddItems n, sName, iIconIndex, 2, pidlCombine
           End If
           'ucLV.fSetTileInfo n, 0, 0
           n = n + 1
           nCount = n
           CoTaskMemFree pidlEnum
           CoTaskMemFree pidlChild
           CoTaskMemFree pidlCombine
           CoTaskMemFree lpName
           CoTaskMemFree lpNameRoot
    
           'SHUpdateImageW StrPtr(sName), iIconIndex, &H2, iIconIndex
           'iIconIndex = Shell_GetCachedImageIndexW(lpName, iIconIndex, 0&)
           lpNameRoot = 0
           pidlRoot = 0
           lpName = 0
           sNameRoot = 0
      Loop
      
      Set pISF = Nothing
      Set pISI_Child = Nothing
      Set pIPAI = Nothing
    
    End Function
    As you can see I have pointed out with arrows where ShGetFileInfo causing the fatal crashes

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width