- Код: Выделить всё
Option Explicit
Implements IContextMenu
Implements IContextMenu2
Implements IShellExtInit
'______________________________________________
Private Sub IContextMenu_GetCommandString(ByVal idCmd As Long, ByVal uType As olelib.GetCommandStringFlags _
, pwReserved As Long, ByVal pszName As Long, ByVal cchMax As Long)
End Sub
'______________________________________________
Private Sub IContextMenu_InvokeCommand(lpici As olelib.CMINVOKECOMMANDINFO)
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)
'Это нормально срабатывает:
InsertMenu hMenu, indexMenu, MF_BYPOSITION Or MF_OWNERDRAW, 1, ByVal "ЛЯ-ЛЯ-ЛЯ"
End Sub
'______________________________________________
Private Sub IContextMenu2_HandleMenuMsg(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
'А это - не вызывается ни разу
debugLog "IContextMenu2_HandleMenuMsg"
End Sub
'______________________________________________
Private Sub IContextMenu2_GetCommandString(ByVal idCmd As Long, ByVal uType As olelib.GetCommandStringFlags _
, pwReserved As Long, ByVal pszName As Long, ByVal cchMax As Long)
End Sub
'______________________________________________
Private Sub IContextMenu2_InvokeCommand(lpici As olelib.CMINVOKECOMMANDINFO)
End Sub
'______________________________________________
Private Sub IContextMenu2_QueryContextMenu(ByVal hMenu As Long, ByVal indexMenu As Long, ByVal idCmdFirst As Long _
, ByVal idCmdLast As Long, ByVal uFlags As olelib.QueryContextMenuFlags)
debugLog "IContextMenu2_QueryContextMenu"
End Sub
'______________________________________________
Private Sub IShellExtInit_Initialize(ByVal pidlFolder As Long, ByVal lpIDataObject As olelib.IDataObject, ByVal hkeyProgID As Long)
'Подозреваю, что что-то нужно добавить сюда. Но что? Или не сюда?
'Err.Raise S_OK
End Sub
'______________________________________________
Public Sub debugLog(ByVal sMsg As String)
Dim hFile As Integer
hFile = FreeFile
Open App.Path & "\debug.log" For Append As #hFile
Write #hFile, sMsg
Close #hFile
End Sub
То же самое файлом: http://bbs.vbstreets.ru/download.php?id=6663
[Хакер] :: Исправлено. При публикации ссылок на ресурсы форума, настоятельно рекомендуется вырезать из них параметр &sid=xxxxxxxxxxxxxx.