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

Question

我找了一段源码，注册在所有文件中显示出菜单，
问题1：当选中的某个或某些文件中有快捷方式文件存在时点击菜单项就会导致Explorer崩溃，别的种类的文件完全正常
问题2：当选中单个快捷方式文件后右键菜单返回的选中文件为快捷方式所指向的真实文件，当先中多个文件，其中包含快捷方式文件焦点为非快捷方式文件时返回的多个文件名中，快捷方式文件为快捷方式文件名（非所指向的真实文件名），这样造成返回文件名不统一实在搞不懂为什么会导致崩溃，高手们帮帮忙看一下吧
第一段：模块mdlFilesFromIDOOption ExplicitPublic 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
第二段：模块mdlFunctionsOption 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 FunctionPublic 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 FunctionPublic 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
第三段：类模块HandlerOption ExplicitImplements olelib.IContextMenu
Implements olelib.IShellExtInitPrivate Type MenuItem
   Caption As String
   HelpStr As String
   Verb As String
End TypePrivate m_Items() As MenuItem
Private m_OldQuery As Long
Private m_SelectedFiles() As StringFriend 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 FunctionPrivate 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 SelectEnd SubPrivate 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 SubPrivate 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 SubPrivate 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 SubPrivate 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

Answer 1

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

Answer 2

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

Answer 3

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

Answer 4

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

Answer 5

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

Answer 6

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

Answer 7

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

Answer 8

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

Answer 9

最好的解决方式：Debug  ！！

Answer 10

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

Answer 11

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

Answer 12

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

Answer 13

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

Answer 14

嘿嘿。。
我前些天在网上也找了个SHELL扩展的源码
我运行度了下。。他的问题跟你这个一样
或许是同一个也说不定
就不去硬盘里翻了。。你在类里面找下哪个接口参数中有文件名信息
如果判断是快捷方式Lnk后缀就不添加扩展菜单因为当你右击快捷方式时。。 他的右链菜单会将目标文件的扩展菜单加上去(这里我猜想下。。如果是快捷方式。。扩展菜单他会调用两次。。一个扩展目标文件的右键菜单。。另一个是快捷方式的右键菜单)
这时 将有两个相同的菜单项且ID相同。。  应该就是这里出错的你发送一个Rar文件到桌面快捷方式 点右键看看就知道了。。他同样有“解压到” 这些菜单。。
可以这么说。。 快捷方式的右键会自动继承目标文件的扩展菜单项所以我想应该在哪个接口参数中带有文件名信息。。你找下看

Answer 15

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

Answer 16

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

Answer 17

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