Enum a folder the com way

[Edwin Knoppert]

The following 2 entries enums a folders.
Usually it's string is used, the callback can be used to obtain more info.

PB/702 was used but not the latest inc's

The following is the include file:

 
Declare Function SHGetMalloc Lib "SHELL32.DLL" Alias "SHGetMalloc" ( pMalloc As Dword ) As Long
 
%SHCONTF_FOLDERS            = 32    '// For Shell browser
%SHCONTF_NONFOLDERS         = 64    '// For Default view
%SHCONTF_INCLUDEHIDDEN      = 128   '// For hidden/system objects
 
%SHGDN_FORPARSING           = &H8000&
 
%STRRET_CSTR                = 2
%STRRET_OFFSET              = 1
%STRRET_WSTR                = 0
 
Union EnumFolder_STRRETUNION
 
    pOleStr As Byte Ptr              '  // must be freed by caller of GetDisplayNameOf
    pStr    As Dword                 '  // Not USED
    uOffset As Dword                 '  // Offset into SHITEMID
    cStr    As Asciiz * %MAX_PATH    '  // Buffer To fill In (ANSI)
 
End Union
 
Type EnumFolder_STRRET
 
    uType As Dword
    Dummy As EnumFolder_STRRETUNION
 
End Type
 
Declare Function EnumFolder_ComCall( _
      ByVal pUnk As Dword Ptr _
    , Opt ByVal lParam1 As Any _
    , ByVal lParam2 As Any _
    , ByVal lParam3 As Any _
    , ByVal lParam4 As Any _
    , ByVal lParam5 As Any _
    , ByVal lParam6 As Any _
    , ByVal lParam7 As Any _
    , ByVal lParam8 As Any _
    ) As Long
 
Declare Function EnumFolder_EnumCallBack( _
      ByVal pObject     As Dword _
    , ByVal sFolderName As String _
    , ByVal pPidl       As Dword _
    , ByVal lParam      As Long _
    ) As Long
 
Declare Function EnumFolder_GetDisplayNameOf( ByVal pUnk As Dword Ptr, ByVal pPidl As Dword, ByVal uFlags As Dword ) As String
Declare Function EnumFolder_GetDisplayNameOf_( ByVal pUnk As Dword, ByVal pPidl As Dword, ByVal uFlags As Dword, lpName As EnumFolder_STRRET ) As Long
 
Function EnumFolder_Enum( _
      ByVal sPath       As String _
    , ByVal dwEnumFlags As Dword _
    , ByVal pCallBack   As Dword _
    , ByVal lParam      As Long _
    ) As String
 
    Dim pMalloc             As Dword Ptr
    Dim pidlDocFiles        As Dword
    Dim chEaten             As Long
    Dim pidlItems           As Dword
    Dim celtFetched         As Dword
    Dim nResult             As Long
    Dim nFileCount          As Long
    Dim psfDeskTop          As Dword Ptr
    Dim psfDocFiles         As Dword Ptr
    Dim ppenum              As Dword Ptr
    Dim T                   As String
    Dim IID_IShellFolder    As String * 16
    Dim nCount              As Long
    Dim sOut                As String
 
    sPath = UCode$( sPath )
    IID_IShellFolder = Mkl$( &H000214E6 ) & Chr$( 0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46 )
 
    '// Obtain Malloc interface
    SHGetMalloc pMalloc
    If pMalloc = 0 Then Exit Function
 
    '// Get the folder object
    SHGetDesktopFolder ByVal VarPtr( psfDeskTop )
    If psfDeskTop = 0 Then
        '// Release
        Call Dword @@pMalloc[2] Using EnumFolder_ComCall( pMalloc )
        Exit Function
    End If
 
    '// IShellFolder::ParseDisplayName
    Call Dword @@psfDeskTop[3] Using EnumFolder_ComCall( _
        psfDeskTop _
        , 0 _
        , 0 _
        , StrPtr( sPath ) _
        , VarPtr( chEaten ) _
        , VarPtr( pidlDocFiles ) _
        , 0 _
        )
 
    '// IShellFolder::BindToObject
    Call Dword @@psfDeskTop[5] Using EnumFolder_ComCall( psfDeskTop, pidlDocFiles, 0, ByVal VarPtr( IID_IShellFolder ), VarPtr( psfDocFiles ) )
    '// Release
    Call Dword @@psfDeskTop[2] Using EnumFolder_ComCall( psfDeskTop )
 
    '// IShellFolder::EnumObjects
    Call Dword @@psfDocFiles[4] Using EnumFolder_ComCall( psfDocFiles, 0, dwEnumFlags, VarPtr( ppenum ) )
 
    Do
 
        '// IEnumIDList::Next
        Call Dword @@ppenum[3] Using EnumFolder_ComCall( ppenum, 1, VarPtr( pidlItems ), VarPtr( celtFetched ) ) To nResult
        If nResult = %S_OK And celtFetched = 1 Then Else Exit Do
 
        T = EnumFolder_GetDisplayNameOf( psfDocFiles, pidlItems, %SHGDN_FORPARSING )
        If Len( T ) Then sOut = sOut & T & $CrLf
 
        If pCallBack <> 0 Then
            Call Dword pCallBack Using EnumFolder_EnumCallBack( psfDocFiles, T, pidlItems, lParam )
        End If
 
        '// IMalloc::Free
        Call Dword @@pMalloc[5] Using EnumFolder_ComCall( pMalloc, pidlItems )
        Incr nCount
 
    Loop
 
    '// Release
    Call Dword @@ppenum[2] Using EnumFolder_ComCall( ppenum )
 
    '// IMalloc::Free
    Call Dword @@pMalloc[5] Using EnumFolder_ComCall( pMalloc, pidlDocFiles )
 
    '// Release
    Call Dword @@psfDocFiles[2] Using EnumFolder_ComCall( psfDocFiles )
 
    '// Release
    Call Dword @@pMalloc[2] Using EnumFolder_ComCall( pMalloc )
 
    Function = RTrim$( sOut, $CrLf )
 
End Function
 
Function EnumFolder_GetDisplayNameOf( ByVal pUnk As Dword Ptr, ByVal pPidl As Dword, ByVal uFlags As Dword ) As String
 
    Dim pszText As Asciiz Ptr
    Dim lpName  As EnumFolder_STRRET
    Dim sBuffer As String
 
    If pUnk  = 0 Then Exit Function
    If pPidl = 0 Then Exit Function
 
    Call Dword @@pUnk[11] Using EnumFolder_GetDisplayNameOf_( pUnk, pPidl, uFlags, lpName )
 
    Select Case lpName.uType
    Case %STRRET_CSTR:  Function = lpName.Dummy.cStr
    Case %STRRET_OFFSET: pszText = pPidl + lpName.Dummy.uOffSet: Function = @pszText
    Case %STRRET_WSTR
        sBuffer = String$( WideCharToMultiByte( %CP_ACP, ByVal 0&, ByVal lpName.Dummy.pOleStr, -1&, ByVal 0&, 0&, ByVal 0&, 0& ), 0 )
        WideCharToMultiByte %CP_ACP, ByVal 0&, ByVal lpName.Dummy.pOleStr, -1&, ByVal StrPtr( sBuffer ), Len( sBuffer ), ByVal 0&, 0&
        pszText = StrPtr( sBuffer ): Function = @pszText
    End Select
 
End Function

------------------
http://www.hellobasic.com

[This message has been edited by Edwin Knoppert (edited September 08, 2003).]

[Edwin Knoppert]

Here is an example:
Change "" for an existing folder or "" for desktop folder.

#Compile Exe
 
Option Explicit
 
#Include "win32api.inc"
#Include "EnumFldr.inc"
 
Function My_EnumCallBack( _
      ByVal pObject     As Dword _
    , ByVal sFolderName As String _
    , ByVal pPidl       As Dword _
    , ByVal lParam      As Long _
    ) As Long
 
    SendMessage lParam, %LB_ADDSTRING, 0, StrPtr( sFolderName )
 
End Function
 
CallBack Function DlgProc() As Long
 
    Select Case CbMsg
    Case %WM_INITDIALOG
    Case %WM_DESTROY
    End Select
 
End Function
 
Function WinMain ( ByVal hCurInstance  As Long, _
                   ByVal hPrevInstance As Long, _
                   lpszCmdLine         As Asciiz Ptr, _
                   ByVal nCmdShow      As Long ) As Long
 
    Dim a       As Long
    Dim hDlg    As Long
    Dim Result  As Long
    Dim sFolders As String
 
    Dialog New 0, "Enum folder via com",,, 240, 180 _
        ,  %WS_OVERLAPPED _
        Or %WS_SYSMENU _
        Or %WS_MINIMIZEBOX _
        Or %WS_MAXIMIZEBOX _
        Or %WS_THICKFRAME _
        Or %WS_CLIPSIBLINGS _
        Or %WS_CLIPCHILDREN _
        To hDlg
 
    If hDlg = 0 Then Exit Function
 
    Control Add ListBox, hDlg, 100, , 5, 2, 200, 160
 
    sFolders = EnumFolder_Enum( "", %SHCONTF_FOLDERS Or %SHCONTF_NONFOLDERS, CodePtr( My_EnumCallBack ), GetDlgItem( hDlg, 100 ) )
    MsgBox sFolders
 
    Dialog Show Modal hDlg Call DlgProc To Result
 
End Function

------------------
http://www.hellobasic.com

[This message has been edited by Edwin Knoppert (edited September 08, 2003).]