Comment puis-je savoir qu'un répertoire est le bac de recyclage dans VB6?

Question

J'essaye de porter le code dans this article à VB6, mais j'éprouve l'écrasement. Je suis assez sûr que mon erreur est dans mon appel à SHBindToParent (MSDN entry) depuis SHParseDisplayName renvoie 0 (S_OK) et ppidl est en cours de définition. J'avoue que mon mécanisme de réglage du riid (j'ai utilisé un type équivalent, un UUID) est assez moche, mais je pense qu'il est plus probable que je fasse quelque chose de mal avec psf.

Private Declare Function SHParseDisplayName Lib "shell32" (ByVal pszName As Long, ByVal IBindCtx As Long, ByRef ppidl As ITEMIDLIST, sfgaoIn As Long, sfgaoOut As Long) As Long 
Private Declare Function SHBindToParent Lib "shell32" (ByVal ppidl As Long, ByRef shellguid As UUID, ByVal psf As Long, ByVal ppidlLast As Long) As Long 

Private Sub Main() 
    Dim hr As Long 
    Dim ppidl As ITEMIDLIST 
    Dim topo As String 
    Dim psf As IShellFolder 
    Dim pidlChild As ITEMIDLIST 
    topo = "c:\tmp\" '"//This VB comment is here to make SO's rendering look nicer. 
    Dim iid_shellfolder As UUID 
    iid_shellfolder.Data1 = 136422 
    iid_shellfolder.Data2 = 0 
    iid_shellfolder.Data3 = 0 
    iid_shellfolder.Data4(0) = 192 
    iid_shellfolder.Data4(7) = 70 
    hr = SHParseDisplayName(StrPtr(topo), 0, ppidl, 0, 0) 
    Debug.Print hr, Hex(hr) 
    hr = SHBindToParent(VarPtr(ppidl), iid_shellfolder, VarPtr(psf), VarPtr(pidlChild)) 'Crashes here 
End Sub 

Answer 1

Je crois que votre appel à SHBindToParent se bloque parce que vous devez passer languit, puis utilisez les pointeurs retournés pour copier la mémoire dans vos types. J'ai trouvé plusieurs messages quand j'ai googlé la fonction SHBindToParent qui mentionnait le support du système d'exploitation, principalement 95 et 98. Quand je l'ai essayé sur XP SP3 j'ai eu une erreur "Aucune interface de ce type n'est supportée."

Voici comment j'ai modifié votre code pour franchir le GPF:

Option Explicit 

Private Declare Function SHParseDisplayName Lib "shell32" (ByVal pszName As Long, ByVal IBindCtx As Long, ByRef ppidl As Long, ByVal sfgaoIn As Long, ByRef sfgaoOut As Long) As Long 
Private Declare Function SHBindToParent Lib "shell32" (ByVal ppidl As Any, ByRef shellguid As UUID, ByRef psf As Any, ByRef ppidlLast As Any) As Long 

Private Type SHITEMID 
    cb As Long 
    abID As Byte 
End Type 

Private Type ITEMIDLIST 
    mkid As SHITEMID 
End Type 

Private Type UUID 
    Data1 As Long 
    Data2 As Integer 
    Data3 As Integer 
    Data4(7) As Byte 
End Type 


Private Sub Command1_Click() 
    Dim hr As Long 
    Dim ppidl As Long 
    Dim topo As String 
    Dim psf As IShellFolder 
    Dim pidlChild As Long 
    Dim iid_shellfolder As UUID 
    Dim lpIDList2 As Long 

    topo = "C:\Temp" 

    ' create a uuid = {B7534046-3ECB-4C18-BE4E-64CD4CB7D6AC}' 
    iid_shellfolder.Data1 = &HB7534046 
    iid_shellfolder.Data2 = &H3ECB 
    iid_shellfolder.Data3 = &H4C18 
    iid_shellfolder.Data4(0) = 190 
    iid_shellfolder.Data4(1) = 78 
    iid_shellfolder.Data4(2) = 100 
    iid_shellfolder.Data4(3) = 205 
    iid_shellfolder.Data4(4) = 76 
    iid_shellfolder.Data4(5) = 183 
    iid_shellfolder.Data4(6) = 214 
    iid_shellfolder.Data4(7) = 172 

    hr = SHParseDisplayName(StrPtr(topo), ByVal 0&, lpIDList2, ByVal 0&, ByVal 0&) 
    ' Debug.Print hr, Hex(hr)' 
    hr = SHBindToParent(lpIDList2, iid_shellfolder, psf, pidlChild) 'retuns "No such interface supported" error 

End Sub 

Answer 2

Un prototype que je suis arrivé au travail, pour ceux qui en ont besoin.

Private Declare Function SHParseDisplayName Lib "shell32" (ByVal pszName As Long, ByVal IBindCtx As Long, ByRef ppidl As Long, ByVal sfgaoIn As Long, ByRef sfgaoOut As Long) As Long 
Private Declare Function SHBindToParent Lib "shell32" (ByVal ppidl As Any, ByRef shellguid As UUID, ByRef psf As IShellFolder, ByRef ppidlLast As Any) As Long 

Private Sub Main() 
    Dim iid_shellfolder As UUID 
    Dim hr As Long 
    Dim ppidl As Long 
    Dim topo As String 
    Dim psf As IShellFolder 
    Dim pidlChild As Long 
    Dim lpIDList2 As Long 
    Dim pdid As shdescriptionid 
    iid_shellfolder.Data1 = 136422 
    iid_shellfolder.Data2 = 0 
    iid_shellfolder.Data3 = 0 
    iid_shellfolder.Data4(0) = 192 
    iid_shellfolder.Data4(7) = 70 
    Dim bin As UUID 
    bin.Data1 = &H645FF040 
    bin.Data2 = &H5081 
    bin.Data3 = &H101B 
    bin.Data4(0) = &H9F 
    bin.Data4(1) = &H8 
    bin.Data4(2) = &H0 
    bin.Data4(3) = &HAA 
    bin.Data4(4) = &H0 
    bin.Data4(5) = &H2F 
    bin.Data4(6) = &H95 
    bin.Data4(7) = &H4E 

    'topo = "C:\Temp" 
    topo = "c:\$Recycle.Bin\S-1-5-21-725345543-1972579041-1417001333-1192\" 
    hr = SHParseDisplayName(StrPtr(topo), ByVal 0&, lpIDList2, ByVal 0&, ByVal 0&) 
    hr = SHBindToParent(lpIDList2, iid_shellfolder, psf, pidlChild) 
    Dim objShell As shell32.Shell 
    Set objShell = CreateObject("Shell.Application.1") 'New Shell32.Shell  win.Shell.SHGetDataFromIDList psf, pidlChild, SHGDFIL_DESCRIPTIONID, pdid, LenB(pdid) 
    Ole32.CoTaskMemFree lpIDList2 
    Debug.Print equalUUID(pdid.clsid, bin) 
end sub