我试图将this article中的代码移植到VB6,但遇到崩溃。我很确定我的错误是在我对SHBindToParent
(MSDN entry)的调用中,因为SHParseDisplayName
返回0(S_OK
)并且正在设置ppidl
。我承认我设置riid的机制(我使用了等效类型UUID
)非常难看,但是我认为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
最佳答案
我相信您对SHBindToParent的调用崩溃了,因为您需要传递long型,然后使用返回的指针将内存复制到您的类型中。当我搜索提到OS支持的SHBindToParent函数时,发现了几篇文章,主要是95和98。当我在XP SP3上尝试它时,出现错误“不支持这种接口(interface)”。
这是我修改您的代码以超越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