关于SHELL扩展的一个奇怪问题，望高手们帮我看看问题出在哪里

我找了一段源码，注册在所有文件中显示出菜单，
问题1：当选中的某个或某些文件中有快捷方式文件存在时点击菜单项就会导致Explorer崩溃，别的种类的文件完全正常
问题2：当选中单个快捷方式文件后右键菜单返回的选中文件为快捷方式所指向的真实文件，当先中多个文件，其中包含快捷方式文件焦点为非快捷方式文件时返回的多个文件名中，快捷方式文件为快捷方式文件名（非所指向的真实文件名），这样造成返回文件名不统一

实在搞不懂为什么会导致崩溃，高手们帮帮忙看一下吧
第一段：模块mdlFilesFromIDO

Option Explicit

Public Sub GetSelectedFiles(Files() As String, IDO As IDataObject)
Dim FMT As FORMATETC, STM As STGMEDIUM
Dim Idx As Long     ' Current array index
Dim Max As Long     ' Filename count
    On Error Resume Next
    Erase Files()
     With FMT
        .cfFormat = CF_HDROP
        .TYMED = TYMED_HGLOBAL
        .dwAspect = DVASPECT_CONTENT
    End With
    If IDO.GetData(FMT, STM) = S_OK Then ' Get files only if GetData returns S_OK
      Max = DragQueryFile(STM.Data, -1, vbNullString, 0)
      ReDim Preserve Files(0 To Max - 1)
      For Idx = 0 To Max - 1
          Files(Idx) = String$(255, 0)
          DragQueryFile STM.Data, Idx, Files(Idx), Len(Files(Idx))
          If InStr(Files(Idx), vbNullChar) > 0 Then Files(Idx) = Left$(Files(Idx), InStr(Files(Idx), vbNullChar) - 1)
      Next
      ReleaseStgMedium STM
   End If
End Sub

第二段：模块mdlFunctions

Option Explicit
Public Declare Function VirtualProtect Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
Public Const PAGE_EXECUTE_READWRITE& = &H40&
Public Declare Function lstrcpynA Lib "kernel32" (lpString1 As Any, lpString2 As Any, ByVal MaxLen As Long) As Long
Declare Function InsertMenu Lib "User32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Declare Function CreatePopupMenu Lib "User32" () As Long
Public Const MF_BYPOSITION = &H400&
Public Const MF_SEPARATOR = &H800&
Public Const MF_OWNERDRAW = &H100&
Public Const MF_POPUP = &H10&
Public Const MF_STRING = &H0&

Public Function StrFromPtrA(ByVal lpszA As Long) As String
   StrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
   lstrcpyA ByVal StrFromPtrA, ByVal lpszA
End Function

Public Function ReplaceVTableEntry(ByVal oObject As Long, ByVal nEntry As Integer, ByVal pFunc As Long) As Long
Dim pFuncOld As Long, pVTableHead As Long
Dim pFuncTmp As Long, lOldProtect As Long
    MoveMemory pVTableHead, ByVal oObject, 4
    pFuncTmp = pVTableHead + (nEntry - 1) * 4
    MoveMemory pFuncOld, ByVal pFuncTmp, 4
    If pFuncOld <> pFunc Then
        VirtualProtect pFuncTmp, 4, PAGE_EXECUTE_READWRITE, lOldProtect
        MoveMemory ByVal pFuncTmp, pFunc, 4     ' *pFuncTmp = pfunc;
        VirtualProtect pFuncTmp, 4, lOldProtect, lOldProtect 'Optional
    End If
    ReplaceVTableEntry = pFuncOld
End Function

Public Function QueryContextMenu(ByVal This As Object, ByVal hMenu As Long, ByVal indexMenu As Long, ByVal idCmdFirst As Long, ByVal idCmdLast As Long, ByVal uFlags As Long) As Long
Dim ICtxMenu As Handler
    Set ICtxMenu = This
    QueryContextMenu = ICtxMenu.QueryContextMenu(hMenu, indexMenu, idCmdFirst, idCmdLast, uFlags)
    Set ICtxMenu = Nothing
End Function

第三段：类模块Handler

Option Explicit

Implements olelib.IContextMenu
Implements olelib.IShellExtInit

Private Type MenuItem
   Caption As String
   HelpStr As String
   Verb As String
End Type

Private m_Items() As MenuItem
Private m_OldQuery As Long
Private m_SelectedFiles() As String

Friend Function QueryContextMenu(ByVal hMenu As Long, ByVal indexMenu As Long, ByVal idCmdFirst As Long, ByVal idCmdLast As Long, ByVal uFlags As Long) As Long
Dim hSubMenu As Long, lIdx As Long

    If UBound(m_SelectedFiles) > 0 Then Exit Function
    hSubMenu = CreatePopupMenu()
    
    lIdx = idCmdFirst
    InsertMenu hSubMenu, 0, MF_BYPOSITION, lIdx, m_Items(1).Caption
    lIdx = lIdx + 1
    InsertMenu hSubMenu, 1, MF_BYPOSITION, lIdx, m_Items(2).Caption
    lIdx = lIdx + 1
    InsertMenu hSubMenu, 2, MF_BYPOSITION, lIdx, m_Items(3).Caption
    lIdx = lIdx + 1
    InsertMenu hSubMenu, 3, MF_BYPOSITION, lIdx, m_Items(4).Caption
    InsertMenu hMenu, indexMenu, MF_BYPOSITION Or MF_SEPARATOR, 0, ByVal 0&
    InsertMenu hMenu, indexMenu, MF_BYPOSITION Or MF_POPUP, hSubMenu, ByVal m_Items(0).Caption
    InsertMenu hMenu, indexMenu, MF_BYPOSITION Or MF_SEPARATOR, 0, ByVal 0&

    QueryContextMenu = UBound(m_Items) + 1
    
End Function

Private Sub IContextMenu_GetCommandString(ByVal idCmd As Long, ByVal uType As olelib.GetCommandStringFlags, pwReserved As Long, ByVal pszName As Long, ByVal cchMax As Long)

    On Error Resume Next
    Select Case uType

        Case GCS_HELPTEXT
            lstrcpynA pszName, m_Items(idCmd).HelpStr, cchMax

        Case (GCS_HELPTEXT Or GCS_UNICODE)
            Dim Unicode() As Byte

            Unicode = m_Items(idCmd).HelpStr & vbNullChar
            MoveMemory ByVal pszName, Unicode(0), IIf(cchMax > UBound(Unicode) + 1, UBound(Unicode) + 1, cchMax)

        Case GCS_VERB
            lstrcpynA pszName, m_Items(idCmd).Verb, cchMax

        Case Else
            lstrcpynA pszName, vbNullChar, cchMax

    End Select

End Sub

Private Sub IContextMenu_InvokeCommand(lpici As olelib.CMINVOKECOMMANDINFO)
Dim Idx As Long, Verb As String, Total As Currency

    On Error Resume Next

    If (lpici.lpVerb \ &H10000) <> 0 Then

        Verb = StrFromPtrA(lpici.lpVerb)

        For Idx = 0 To UBound(m_Items)
            If m_Items(Idx).Verb = Verb Then
                Exit For
            End If
        Next

    Else
        Idx = lpici.lpVerb
    End If
    MsgBox m_Items(Idx + 1).Caption
    Select Case Idx
        Case 0

        Case 1

        Case 2
        Case Else
    End Select
    
End Sub

Private Sub IContextMenu_QueryContextMenu(ByVal hMenu As Long, ByVal indexMenu As Long, ByVal idCmdFirst As Long, ByVal idCmdLast As Long, ByVal uFlags As olelib.QueryContextMenuFlags)

End Sub

Private Sub IShellExtInit_Initialize(ByVal pidlFolder As Long, ByVal lpIDataObject As olelib.IDataObject, ByVal hkeyProgID As Long)
    Dim i As Long
    
    GetSelectedFiles m_SelectedFiles, lpIDataObject
End Sub

Private Sub Class_Initialize()
Dim ICM As IContextMenu
    Set ICM = Me
    m_OldQuery = ReplaceVTableEntry(ObjPtr(ICM), 4, AddressOf mdlFunctions.QueryContextMenu)
    Set ICM = Nothing

    ReDim m_Items(0 To 4)

    With m_Items(0)
        .Caption = "&DocManage"
        .HelpStr = "Shows the file size in bytes."
        .Verb = "Item1"
    End With
    With m_Items(1)
        .Caption = "&A1"
        .HelpStr = "111"
        .Verb = "Item2"
    End With
    With m_Items(2)
        .Caption = "&B2"
        .HelpStr = "222"
        .Verb = "Item3"
    End With
    With m_Items(3)
        .Caption = "&C3"
        .HelpStr = "333"
        .Verb = "Item4"
    End With
    With m_Items(4)
        .Caption = "&D3"
        .HelpStr = "444"
        .Verb = "Item5"
    End With
End Sub

26 个解决方案

#1

没人能帮我看一下怎么回事吗，急求这个问题，在线等

#2

没动力。

#3

这个肯定出现的话调试就行了.

#4

没用，调不了，这个DLL是由系统的进程调用的，怪就怪在，一般文件都正常只有快捷方式文件就是(LNK)文件才会出问题

#5

可能在 GetSelectedFiles 中对快捷方式的 lpIDataObject 处理不正确。

#6

我也是这样感觉的，因为一样的程序我用C++写了后就是可以用的，但VB就怪在调用菜单点击后才崩溃，生成菜单和读取文件名我都调试过，读出来快捷方式文件名也是正确的

#7

好像 IShellLink 是用来处理快捷方式的。

#8

既然C程序可行，说明功能上没问题。
VB会对字符串、对象进行自动释放，如果不正确地释放了资源通常引发崩溃，这方面要仔细检查。

#9

谢谢楼上的建议，我再去查一下代码

#10

MARK

#11

还是没有进展，感觉还是出在菜单点击后的过程中

#12

不要猜想了。
用 OutputDebugString 输出调试信息，然后下载一个叫 DebugView 的工具监视输出。

#13

现在我DLL全用C++的写了，系统是不崩溃了，不过又有一个新问题，选中快捷方式文件（LNK）返回文件为快捷方式所指向的文件多选文件后点在快捷方式上后别的文件就不显示了

#14

引用 13 楼 ftz820127 的回复:

选中快捷方式文件（LNK）返回文件为快捷方式所指向的文件多选文件后点在快捷方式上后别的文件就不显示了

实在是理解不了。
还是推荐 OutputDebugString，VB、VC 都适用，看看实际运行与你的预期在哪里不一致。光靠猜是找不出问题的。

#15

这个东东我倒是没用过，能给我说详细点吗，我拿去试试

#16

我只是路过，好象是有人介绍来的。




看下！！

#17

最好的解决方式：Debug  ！！

#18

引用 15 楼 ftz820127 的回复:

这个东东我倒是没用过，能给我说详细点吗，我拿去试试

http://technet.microsoft.com/en-us/sysinternals/bb896647.aspx
就是你在程序中调用 OutputDebugString，会被该工具实时接受并显示出来，很好很简单。

#19

又：www.sysinternals.com 下又许多不错的小工具（不一定是编程的），虽然现在归微软名下，不过一直在更新，值得看看。

#20

我现在在快捷方式上一点菜单项还没有进到
Private Sub IContextMenu_InvokeCommand(lpici As olelib.CMINVOKECOMMANDINFO)
这个过程资源管理器进程就崩溃了，根本无法调试，会不会是olelib的CMINVOKECOMMANDINFO定义上有问题引起的？
或者根本就是olelib组件存在问题？

#21

你可以用 Visual Studio 自带的工具 OLE View 将 olelib.tlb 翻译成 IDL 语法，然后与 VC 的格式比较一下。

#22

谢谢楼上的提示我这就去查一下

#23

嘿嘿。。
我前些天在网上也找了个SHELL扩展的源码
我运行度了下。。他的问题跟你这个一样
或许是同一个也说不定
就不去硬盘里翻了。。

你在类里面找下哪个接口参数中有文件名信息
如果判断是快捷方式Lnk后缀就不添加扩展菜单

因为当你右击快捷方式时。。 他的右链菜单会将目标文件的扩展菜单加上去(这里我猜想下。。如果是快捷方式。。扩展菜单他会调用两次。。一个扩展目标文件的右键菜单。。另一个是快捷方式的右键菜单)
这时 将有两个相同的菜单项且ID相同。。  应该就是这里出错的

你发送一个Rar文件到桌面快捷方式 点右键看看就知道了。。他同样有“解压到。。。” 这些菜单。。
可以这么说。。 快捷方式的右键会自动继承目标文件的扩展菜单项

所以我想应该在哪个接口参数中带有文件名信息。。你找下看

#24

我记得我找的那份源码是能正常添加上。。能显示
但点击菜单项时才会导致Explorer挂掉的

#25

如果是23楼所猜想的原因，楼主用 OutputDebugString 就可以发现的。

#26

VB代码最后还是没搞定，用OLEVIEW看过了结构体应该是一样的，搞不懂了，VC写的用是能用了但处理快捷方式上还是有问题
试了一下WINRAR后发现也存在这样的问题，不知道怎么回事，只能先不管了，先这样做了，希望以后有高手能解决这问题，一会儿去结贴了
谢谢楼上几位的帮忙