2009-11-04 43 views
1

我试图将代码this article移植到VB6,但我遇到崩溃。我很确定我的错误是在我拨打SHBindToParentMSDN entry)时发生的,因为SHParseDisplayName正在返回0(S_OK),并且正在设置ppidl。我承认我设置riid的机制(我使用了一个等效类型,一个UUID)非常难看,但我认为我更可能在psf上做错了什么。如何判断一个目录是VB6中的回收站?

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 
+0

(C++代码这个标记是指在问题中引用) – Brian 2009-11-04 23:16:12

回答

1

我相信你到SHBindToParent通话崩溃,因为你需要传递多头,然后使用返回的指针指向的内存复制到你的类型。当我搜索提到操作系统支持的SHBindToParent函数(主要是95和98)时,我发现了几篇文章。当我在XP SP3上尝试它时,出现错误“没有支持此类接口”。

这里是我的代码修改方式,让过去的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 
+0

我测试的C++和在同一台机器上VB代码,所以问题应该是单纯的移植问题,而不是一个操作系统支持问题。我尝试过多次传球,但没有奏效。但我可能会把他们错误的传递给别人。 – Brian 2009-11-05 20:46:30

+0

您使用的uuid(这是我意识到的bitbucket的uuid)不起作用,但我在原始程序中使用的uuid正常工作。 – Brian 2009-11-06 19:14:37

1

的原型,我开始工作,对于那些谁需要它。

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 
+0

注意:在Windows Vista上成功测试。 – Brian 2009-11-06 22:13:03

+0

我很高兴你发布了解决方案。路要走。 – jac 2009-11-07 22:27:09

相关问题