Pergunta

Eu estou tentando porta o código este artigo para VB6, mas eu estou experimentando falhando. Eu estou certo de que meu erro está na minha chamada para SHBindToParent ( MSDN entrada ) desde SHParseDisplayName está retornando 0 (S_OK) e ppidl está sendo definido. Admito meu mecanismo de definir o riid (eu usei um tipo equivalente, uma UUID) é muito feio, mas eu acho mais provável que eu estou fazendo algo de errado com 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
Foi útil?

Solução

Eu acredito que a sua chamada para SHBindToParent está falhando, porque você precisa passar longs, em seguida, usar os ponteiros retornados para copiar a memória em seus tipos. Eu encontrei vários posts quando eu pesquisei a função SHBindToParent que mencionado suporte OS, principalmente 95 e 98. Quando eu tentei no XP SP3 Eu tenho um erro "Nenhuma interface suportada".

Aqui está como eu modificar seu código para passar o 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

Outras dicas

Um protótipo que eu comecei a trabalhar, para aqueles que podem precisar.

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
Licenciado em: CC-BY-SA com atribuição
Não afiliado a StackOverflow
scroll top