Hard coded paths aren't the best system, since they change from Windows version to version. So AAraya was asking about how to do this, and after seeing a StackOverflow and OldNewThing post about using IPersist to get the class ID of a folder, I wrote this in response. The code guarantees that the locations returned are the current, official system bin locations. Note that, especially on non-system drives, a Recycle Bin location may only exist when there are files in it, so if you don't get any results it doesn't mean that there won't be the next time you delete a file on that drive.
Main Code
This project wraps a single main function, FindRecycleBinsOnDrive:
Code:
Private Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal PV As Long) ' Frees memory allocated by the shell
Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
Private Declare Function SHCreateItemFromParsingName Lib "shell32" (ByVal pszPath As Long, pbc As Any, riid As UUID, ppv As Any) As Long
Private Function FindRecycleBinsOnDrive(sDrive As String) As String()
Dim pItem As IShellItem
Dim penum1 As IEnumShellItems, penum2 As IEnumShellItems
Dim pChild As IShellItem, pChild2 As IShellItem
Dim lpPath As Long, sPath As String
Dim sParent As String
Dim n As Long
Dim pcl As Long, pcl2 As Long
Dim gid As oleexp.UUID
Dim pPersist As oleexp.IPersist
Dim lAtr As SFGAO_Flags
Dim sOut() As String
ReDim sOut(0)
Call SHCreateItemFromParsingName(StrPtr(sDrive), ByVal 0&, IID_IShellItem, pItem)
If (pItem Is Nothing) = False Then
pItem.BindToHandler ByVal 0&, BHID_EnumItems, IID_IEnumShellItems, penum1
Do While penum1.Next(1&, pChild, pcl) = S_OK
pChild.GetAttributes SFGAO_FOLDER Or SFGAO_HIDDEN Or SFGAO_SYSTEM, lAtr
If ((lAtr And SFGAO_FOLDER) = SFGAO_FOLDER) And ((lAtr And SFGAO_HIDDEN) = SFGAO_HIDDEN) And ((lAtr And SFGAO_SYSTEM) = SFGAO_SYSTEM) Then
pChild.BindToHandler ByVal 0&, BHID_EnumItems, IID_IEnumShellItems, penum2
Do While penum2.Next(1&, pChild2, pcl2) = S_OK
pChild2.BindToHandler ByVal 0&, BHID_SFObject, IID_IPersist, pPersist
If (pPersist Is Nothing) = False Then
pPersist.GetClassID gid
pChild2.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpPath
If IsEqualGUID(gid, CLSID_RecycleBin) Then
pChild2.GetDisplayName SIGDN_FILESYSPATH, lpPath
ReDim Preserve sOut(n)
sOut(n) = LPWSTRtoStr(lpPath)
n = n + 1
End If
End If
Loop
End If
Loop
Else
Debug.Print "Failed to get drive object"
End If
FindRecycleBinsOnDrive = sOut
End Function
Private Function CLSID_RecycleBin() As UUID
'{645ff040-5081-101b-9f08-00aa002f954e}
Static iid As UUID
If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H645FF040, CInt(&H5081), CInt(&H101B), &H9F, &H8, &H0, &HAA, &H0, &H2F, &H95, &H4E)
CLSID_RecycleBin = iid
End Function
Private Function LPWSTRtoStr(lPtr As Long, Optional ByVal fFree As Boolean = True) As String
SysReAllocString VarPtr(LPWSTRtoStr), lPtr
If fFree Then
Call CoTaskMemFree(lPtr)
End If
End FunctionAlternative Method
I had also written a different method to get the top level bin names. This method uses the KnownFolderManager class to enumerate (just the first level of) files in the Recycle Bin virtual object (which includes all the physical locations on different drives), and then get the top level bin folders of all drives at once:
Code:
Private Sub EnumRecycleBinPaths(sBinPaths() As String)
Dim kfm As New KnownFolderManager
Dim pk As IKnownFolder
Dim pItem As IShellItem
Dim penum1 As IEnumShellItems
Dim pChild As IShellItem
Dim lpPath As Long, sPath As String
Dim sParent As String
Dim n As Long
Dim pcl As Long
ReDim sBinPaths(0)
kfm.GetFolder FOLDERID_RecycleBinFolder, pk
If (pk Is Nothing) = False Then
pk.GetShellItem KF_FLAG_DEFAULT, IID_IShellItem, pItem
pItem.BindToHandler ByVal 0&, BHID_EnumItems, IID_IEnumShellItems, penum1
Do While penum1.Next(1&, pChild, pcl) = S_OK
pChild.GetDisplayName SIGDN_FILESYSPATH, lpPath
sPath = LPWSTRtoStr(lpPath)
sParent = Left$(sPath, 3)
sPath = Mid$(sPath, 4)
sParent = sParent & Left$(sPath, InStr(sPath, "\"))
arr_add_dedupe sBinPaths, sParent
Loop
End If
End Sub
Private Sub arr_add_dedupe(sAr() As String, sNew As String)
Dim i As Long
For i = 0 To UBound(sAr)
If sAr(i) = sNew Then Exit Sub
Next
Debug.Print "New entry=" & sNew
If (UBound(sAr) = 0) And (sAr(0) = "") Then
sAr(0) = sNew
Else
ReDim Preserve sAr(UBound(sAr) + 1)
sAr(UBound(sAr)) = sNew
End If
End SubRequirements
-Windows Vista or newer (you can get to IPersist while enumerating with IShellFolder, if you really needed to do this on XP)
-oleexp.tlb v4.0 or higher
-oleexp AddOn mIID.bas (included in oleexp download)