用VB将自己的程序加进Windows右键菜单的三种方法.doc

用VB将自己的程序加进Windows右键菜单的三种方法引言：当我们在资源管理器中右键点击某个（或某些）文件时，Windows会调出对这些文件进行的相应操作，这就是Windows右键菜单，将自己的程序加进右键菜单，就可以很方便的进行我的相应操作了。这里给出加进右键菜单的三种方法。方法一、通过对注册表相应键新建项并赋值实现。首先介绍一下要执行的目标程序CopyPathToClipboard的作用，该程序的界面见图一，实现将选中的文件（或目录）的路径复制到剪切板供其它程序使用的功能。要实现对单个文件（或目录）进行右键操作，只需对注册表如下键添加相应键值就可以了。点击系统开始-运行-输入Regedit，打开注册表。展开HKEY_CLASSES_ROOT，继续打开*-shell-新建项CopyPathToClipboard-Command，在Command建默认值：E:Program FilesXZBCopyPathToClipboard.exe %1，“E:Program FilesXZB”是程序CopyPathToClipboard.exe的文件路径，见图二。如果还需对目录进行操作，定位到注册表项：HKEY_CLASSES_ROOTDirectoryshell进行同样添加项CopyPathToClipboard-Command，在Command建默认值：E:Program FilesXZBCopyPathToClipboard.exe %1。这样当你右击一个文件（或目录）时，就会在右键菜单中显示：CopyPathToClipboard，点击CopyPathToClipboard，就会调出主程序即可进行相应操作了，见图三。主程序CopyPathToClipboard在Private Sub Form_load()中有如下关键代码：Private Sub Form_load() If Command$ Then If Left$(Command$, 1) = Chr(34) And Right$(Command$, 1) = Chr(34) Then Combo1.Text = Mid$(Command$, 2, Len(Command$) - 2) 去除前后两个引号 Else Combo1.Text = Command$ End If End IfEnd Sub这样就实现了将参数传递进Combo1（CopyPathToClipboard的顶端组合框即为Combo1）中供后续程序代码调用处理。要说明的是：如果选择了多个文件，右键菜单中也有CopyPathToClipboard，如果此时点击执行CopyPathToClipboard将会打开多个CopyPathToClipboard主程序窗口。方法二、利用Windows右键菜单的发送到功能实现这里以另一个程序SendToSelect.exe为例说明，该程序运行界面见图四：实现将选中的文件含结构复制、含结构移动、合并、批量命名等功能。主程序窗体中上半部为RichTextBox1，供接收传递过来的参数。只要在Windows用户的SendTo文件夹下建一个要出现在右键菜单程序（如E:Program FilesXZBSendToSelect.exe）的快捷方式，比如用户名称为XZB，则该文件夹路径一般为：C:Documents and SettingsXZBSendTo，然后在右键菜单的发送到中就会出现你的程序，见图五。只要在主程序SendToSelect.exe的VB源代码中处理传递过来的参数就可以了，通过这种方式传递给主程序的参数（即文件路径集）格式为：每个文件名路径间用空格分隔，如果某个文件名路径中含有空格，该文件名路径就用引号引起来，通过一个函数GetCanShuNum对传递过来的文件路径集参数进行处理。Private Sub Form_Load() If Command$ Then Dim MyCanShu() As String, i, xPosition As Integer XX$ = Command$ GetCanShuNum XX$, , MyCanShu FenGeFu$ = Chr$(13) & Chr$(10) RichTextBox1.Text = Join(MyCanShu, Chr$(13) & Chr$(10) If Left$(RichTextBox1.Text, Len(FenGeFu$) = FenGeFu$ Then RichTextBox1.Text = Mid$(RichTextBox1.Text, Len(FenGeFu$) + 1) 去掉Join产生的第一个分隔符 End IfEnd Sub调用的过程GetCanShuNumFunction GetCanShuNum(ByVal s As String, FenGeFu$, CanShu() As String) As Long If s Then Dim i As Long, T As String Dim Si As Long, Ei As Long Dim Fl As Byte Dim Num As Long Fl = 0 Num = 0 s = FenGeFu$ & Replace(Replace(Trim$(s), Chr(10), ), Chr(13), ) & FenGeFu$ For i = 1 To Len(s) T = Mid(s, i, 1) Select Case Fl Case 0 开始分隔符 If T = FenGeFu$ Then 号 If Mid(s, i + 1, 1) = Chr(34) Then 判断分隔符后参数开始是否引号 Fl = 2 下次 For循环到 Case 引号 段 i = i + 1 Si = i + 1 参数开始位置 Else Fl = 1 Si = i + 1 End If End If Case 1 结束分隔符 Do Until T = FenGeFu$ 程序优化段 i = i + 1 T = Mid(s, i, 1) Loop If T = FenGeFu$ Then Fl = 0 Ei = i Num = Num + 1 ReDim Preserve CanShu(Num) CanShu(Num) = Mid(s, Si, Ei - Si) i = i - 1 End If Case 2 结束双引号 Do Until T = Chr(34) 程序优化段 i = i + 1 T = Mid(s, i, 1) Loop If T = Chr(34) Then Fl = 0 Ei = i Num = Num + 1 ReDim Preserve CanShu(Num) CanShu(Num) = Mid(s, Si, Ei - Si) End If End Select Next GetCanShuNum = Num End IfEnd Function这样在主程序的RichTextBox1即可得到文件列表，见图六有了这个列表，你要怎么处理每个文件都可以了，这里就不重点介绍了。该方法也有一定的限制，就是当文件选择较多，比如成百上千个文件时，点击执行时会跳出出错对话框，显示：“无法访问指定设备、路径、或文件，您可能没有合适的权限访问这个项目”，这是系统本身原因，当然VB对Command$长度也是有限制而造成的。方法三、通过外壳扩展编程实现Windows操作系统提供了颇受用户喜爱的图形界面(GUI)。微软为Windows的用户界面保留了可扩充性。基于32位Windows的应用程序可以通过多种方式来增强系统所提供的操作环境（也称为外壳）。通过对外壳的扩展，开发人员可以为用户提供其他的文件对象操作方式或者简化文件系统和网络的浏览，或者使用户能更方便地调用文件系统中对各种对象进行处理的工具。例如，用户可以将Word或者WordPad中的文档内容直接拖放到桌面上，Windows给History和Subscriptions文件夹赋予了与众不同的图标以显示它们的特殊性，还有一些应用程序（比如WinZip）可以向文件或目录的上下文相关菜单动态地添加命令等等。这些功能的实现都是依靠Windows外壳扩展(Shell Extensions)。1外壳扩展概述下面是与外壳扩展相关的三个重要术语：(1)文件对象(File Object)文件对象是外壳中的一项，大家最熟识的文件对象是文件和目录，此外，打印机、控制面板程序、共享网络等也都是文件对象。(2)文件类(File Class)文件类是具有某种共同特性的文件对象的集合，比如，扩展名相同的文件属于同一文件类。(3)处理程序(Handler)处理程序是具体实现某个外壳扩展的代码。Windows支持七种类型的外壳扩展（称为Handler），它们相应的作用简述如下：(1)Context menu handlers向特定类型的文件对象增添上下文相关菜单；(2)Drag-and-drop handlers用来支持当用户对某种类型的文件对象进行拖放操作时的OLE数据传输；(3)Icon handlers用来向某个文件对象提供一个特有的图标，也可以给某一类文件对象指定图标；(4)Property sheet handlers给文件对象增添属性页，属性页可以为同一类文件对象所共有，也可以给一个文件对象指定特有的属性页；(5)Copy-hook handlers在文件夹对象或者打印机对象被拷贝、移动、删除和重命名时，就会被系统调用，通过为Windows增加Copy-hook handlers，可以允许或者禁止其中的某些操作；(6)Drop target handlers在一个对象被拖放到另一个对象上时，就会被系统被调用；(7)Data object handlers在文件被拖放、拷贝或者粘贴时，就会被系统被调用。Windows的所有外壳扩展都是基于COM(Component Object Model) 组件模型的，外壳是通过接口(Interface)来访问对象的。外壳扩展被设计成32位的进程中服务器程序，并且都是以动态链接库的形式为操作系统提供服务的。因此，如果要对Windows的用户界面进行扩充的话，则具备写COM对象的一些知识是十分必要的。写好外壳扩展程序后，必须将它们注册才能生效。所有的外壳扩展都必须在Windows注册表的HKEY_CLASSES_ROOTCLSID键之下进行注册。在该键下面可以找到许多名字像0000002F-0000-0000-C000-000000000046的键，这类键就是全局唯一类标识符（GUID）。每一个外壳扩展都必须有一个全局唯一类标识符，Windows正是通过此唯一类标识符来找到外壳扩展处理程序的。在类标识符之下的InProcServer32子键下记录着外壳扩展动态链接库在系统中的位置。与某种文件类型关联的外壳扩展注册在相应类型的shellex主键下。如果所处的Windows操作系统为Windows NT，则外壳扩展还必须在注册表中的HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionShellExtensionsApproved主键下登记。注册表HKEY_CLASSES_ROOT主键下有几个特殊的子键，如*、Folder、Drive以及Printer。如果把外壳扩展注册在*子键下，那么这个外壳扩展将对Windows中所有类型的文件有效；如果把外壳扩展注册在Folder子键下，则对所有目录有效。以下是在*子键下注册的外壳扩展的一个示例（其中登记了一个属性页和一个WinZip提供的上下文相关菜单处理程序）：HKEY_CLASSES_ROOT*shellex=HKEY_CLASSES_ROOT*shellexPropertySheetHandlersHKEY_CLASSES_ROOT*shellexPropertySheetHandlers3EA48300-8CF6-101B-84FB-666CCB9BCD32=HKEY_CLASSES_ROOT*shellexContextMenuHandlers=HKEY_CLASSES_ROOT*shellexContextMenuHandlersWinZip=E0D79300-84BE-11CE-9641-444553540000编译完外壳扩展的DLL程序后就可以用Windows本身提供的regsvr32.exe来注册该DLL服务器程序了。如前所述，Windows的外壳扩展都是基于微软公司的COM组件模型的，从这个意义上来讲，编写外壳扩展的过程其实就是构造COM对象的过程。但由于各种外壳对象的功能不同，它们要遵循的规则也不同。鉴于Context Menu Handler这种类型的外壳扩展的应用性比较广，下面以一个实例来具体介绍Context Menu Handler外壳扩展的实现方法。只要熟练地掌握了其中一种外壳扩展程序的编写方法，在需要编写其他类型的外壳扩展时再具体查阅一下相应的规则，就可以比较容易地实现其他类型的外壳扩展了。建议读者到微软公司的网站上去找相关资料，为此先进入站点，然后单击Search按钮，输入Shell extension作为关键字，查找范围应选Developer Resources，再按Search按钮即可。2上下文相关菜单处理程序的编写在Windows中，用鼠标右键单击文件或者文件夹时弹出的那个菜单便称为上下文相关菜单。要动态地在上下文相关菜单中增添菜单项，可以通过写Context Menu Handler来实现。比如大家所熟悉的WinZip和UltraEdit等软件都是通过编写Context Menu Handler来动态地向菜单中增添菜单项的。如果系统中安装了WinZip，那么当用右键单击一个名为abc的文件（夹）时，其上下文相关菜单就会有一个名为Add to abc.zip的菜单项。下面的实例，动态地以每个文件名（含路径）作为菜单名建立一子菜单，同时建一菜单项SendToSelect，将所选文件的路径传递给方法二中的主程序SendToSelect.exe的RichTextBox1中供调用。编写Context Menu Handler必须实现IShellExtInit和IContextMenu两个接口。除了IUnknown接口所定义的函数之外，Context Menu Handler还需要用到QueryContextMenu、InvokeCommand和GetCommandString这三个非常重要的成员函数。(1)QueryContextMenu函数：每当系统要显示一个文件对象的上下文相关菜单时，它首先要调用该函数。为了在上下文相关菜单中添加菜单项，我们在该函数中调用InsertMenu函数。(2)InvokeCommand函数：当用户选定了某个Context Menu Handler登记过的菜单项后，该函数将会被调用，系统将会传给该函数一个指向LPCMINVOKECOMMANDINFO结构的指针。在该函数中要执行与所选菜单项相对应的操作。(3)GetCommandString函数：当鼠标指针移到一个上下文相关菜单项上时，在当前窗口的状态条上将会出现与该菜单项相关的帮助信息，此信息就是系统通过调用该函数获取的。3增添上下文相关菜单项说明上面方法一介绍的添加右键菜单是通过直接修改注册表来实现的，比较简单，然而它不具有交互性，所增添的菜单项是静态的，并且所能实现的功能也非常有限。但是Context Menu Handler则不同，它使我们可以根据上下文的具体情况动态地添加菜单项，比如可以判断当前选定的是哪一类文件、是不是文件夹、选定的文件（夹）的个数以及获取被选定文件（夹）的属性。有时，这些信息对于程序很有用，如果需要得到此类信息，并且需要根据不同的上下文来执行不同的操作，那么只好依靠Context Menu Hander来实现。下面的实例，动态地以每个文件名（含路径）作为菜单名建立一子菜单，当点选某一文件菜单时，显示该文件的大小，其动态性体现在仅当用户选定了文件时，才会在上下文相关菜单中增添菜单项，并且菜单项的名字随着所选文件名的不同而相应地变化，菜单项SendToSelect将所选文件的路径传递给方法二中的主程序SendToSelect.exe的RichTextBox1中供调用，当然通过外壳扩展编程实现的右键菜单没有了方法二中文件数量的限制。请先看程序实现的样式，见图七：下面详细介绍用VB实现上述右键菜单的方法。先准备一个库文件SHLEXT.tlb，读者可从这儿下载使用/c0e7izlpb2。其中的文件STclsID.stc是为了保证每次编译生成的DLL文件的clsID固定为FD5C7672-C824-4732-8EB3-A5925272118C用的。运行VB，新建工程选：ActiveX 控件，接下来从工程-引用-浏览，定位到下载下来的SHLEXT.tlb这个文件，选中它，并点击确定按钮。将默认控件UserControl1改名为：CtxMenuHandle以下为控件代码Option ExplicitImplements IContextMenuImplements IShellExtInitPrivate Type MenuItem Caption As String HelpStr As String Verb As StringEnd TypeDim m_Items() As MenuItemDim m_OldQuery As LongDim m_SelectedFiles() As StringPrivate Sub UserControl_Initialize() Dim ICM As IContextMenu Dim intXItem As Integer Set ICM = Me m_OldQuery = ReplaceVTableEntry(ObjPtr(ICM), 4, AddressOf mdlFunctions.QueryContextMenu) Set ICM = Nothing ReDim m_Items(0 To 2) intXItem = 0 必须从0开始 With m_Items(intXItem) .Caption = 文件大小 .HelpStr = .Verb = Item & Trim$(Str$(intXItem + 1) 必须从1开始 End With intXItem = 1 With m_Items(intXItem) .Caption = &SendToSelect .HelpStr = Call Program: SendToSelect .Verb = Item & Trim$(Str$(intXItem + 1) End With intXItem = 2 With m_Items(intXItem) .Caption = .HelpStr = 字节方式显示文件的长度 .Verb = Item & Trim$(Str$(intXItem + 1) End With End SubPrivate Sub UserControl_Terminate() Dim ICM As IContextMenu Set ICM = Me ReplaceVTableEntry ObjPtr(ICM), 4, m_OldQuery Set ICM = NothingEnd SubFriend 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 lIdx As Long, lRet As Long, LxIdx As Long InsertMenu hMenu, indexMenu, MF_BYPOSITION Or MF_SEPARATOR, 0, ByVal 0& 分隔线 LxIdx = idCmdFirst LxIdx = LxIdx + 1 InsertMenu hMenu, indexMenu, MF_BYPOSITION, LxIdx, ByVal m_Items(1).Caption 在此菜单(&SendToSelect)中插入一图标 lRet = SetMenuItemBitmaps(hMenu, LxIdx - idCmdFirst - 1, MF_BYPOSITION, Picture1.Picture, Picture1.Picture) 这里即是按所选文件添加动态子菜单了 hSubMenu = CreatePopupMenu() lIdx = UBound(m_SelectedFiles) For lIdx = 0 To lIdx LxIdx = LxIdx + 1 菜单数目要继续 AppendMenu hSubMenu, MF_BYPOSITION, LxIdx, ByVal m_SelectedFiles(lIdx) 按顺序添加 Next LxIdx = LxIdx + 1 InsertMenu hMenu, indexMenu, MF_BYPOSITION Or MF_POPUP, hSubMenu, ByVal m_Items(0).Caption LxIdx = LxIdx + 1 InsertMenu hMenu, indexMenu, MF_BYPOSITION Or MF_SEPARATOR, 0, ByVal 0& 分隔线 已添加菜单项的数目，必须的，赋值可以大于实际添加数，但绝对不能小于实际值 QueryContextMenu = LxIdx - idCmdFirst + 1End FunctionPrivate Sub IShellExtInit_Initialize(ByVal pidlFolder As Long, _ ByVal lpIDataObject As shlext.IDataObject, _ ByVal hkeyProgID As Long) GetSelectedFiles m_SelectedFiles, lpIDataObject End SubPrivate Sub IContextMenu_GetCommandString(ByVal idCmd As Long, _ ByVal uType As shlext.GCSFlags, _ pwReserved As Long, _ ByVal pszName As Long, _ ByVal cchMax As Long) On Error Resume Next Select Case uType Case GCS_HELPTEXTA lstrcpynA pszName, m_Items(idCmd).HelpStr, cchMax Case GCS_HELPTEXTW 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_VERBA lstrcpynA pszName, m_Items(idCmd).Verb, cchMax Case Else lstrcpynA pszName, vbNullChar, cchMax End SelectEnd SubPrivate Sub IContextMenu_InvokeCommand(lpici As shlext.CMINVOKECOMMANDINFO) Dim Idx As Long, Verb As String, Total As Currency, xx$ 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 Select Case Idx Case 1 Open C:FileList.txt For Output As #1 For Idx = 0 To UBound(m_SelectedFiles) Print #1, m_SelectedFiles(Idx) Next Close Shell SendToSelect.exe /F C:FileList.txt, vbNormalFocus 上句就是调用的主程序了，很明显，只要在你的主程序的的代码中用：RichTextBox1.LoadFile “C:FileList.txt”, rtfText就可以轻松得到所选文件的列表了，当然有了这个列表，你要怎么处理每个文件都可以了。 Case Is 1 MsgBox m_SelectedFiles(Idx - 2) & vbCrLf & vbCrLf & 文件字节长度: & FileLen(m_SelectedFiles(Idx - 2) End SelectEnd SubPrivate Sub IContextMenu_QueryContextMenu(ByVal hMenu As Long, _ ByVal indexMenu As Long, _ ByVal idCmdFirst As Long, _ ByVal idCmdLast As Long, _ ByVal uFlags As shlext.QueryContextMenuFlags)End Sub以下是mdlFilesFromIDO.bas模块代码Attribute VB_Name = mdlFilesFromIDOOption ExplicitPublic Declare Sub MoveMemory _ Lib KERNEL32 _ Alias RtlMoveMemory (dest As Any, _ Src As Any, _ ByVal L As Long)Public Declare Function lstrlenW Lib KERNEL32 (lpString As Any) As LongPublic Declare Function ShellExecute _ Lib shell32.dll _ Alias ShellExecuteA (ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long 打开文件关联程序打开文件Const S_OK = 0Const CF_HDROP = 15 GetSelectedFiles Fills an string array with the file names. Files(): array to fill IDO: IDataObject interface with selected filesPublic 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 Catch all error an ignore them. Why? Because if VB raises an error and Windows Explorer doesnt expects one it will produce a GPF On Error Resume Next Erase the array Erase Files() Fill the FORMATETC struct to retrieve the filename data in CF_HDROP format With FMT .cfFormat = CF_HDROP .TYMED = TYMED_HGLOBAL .dwAspect = DVASPECT_CONTENT End With Get the data from IDataObject This call will fill the STM struct with a pointer to the DROPFILES struct If IDO.GetData(FMT, STM) = S_OK Then Get files only if GetData returns S_OK Get file name count Max = DragQueryFile(STM.Data, -1, vbNullString, 0) ReDim Preserve Files(0 To Max - 1) Get filenames For Idx = 0 To Max - 1 Files(Idx) = String$(260, 0) Files(Idx) = String$(520, 0) xzb change 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 Release memory used by STM.Data ReleaseStgMedium STM End If End Sub以下是mdlFunctions.bas模块代码。Attribute VB_Name = mdlFunctionsOption ExplicitPublic hSubMenu As LongPublic Declare Function GetMenuItemCount Lib user32 (ByVal hMenu As Long) As LongPublic Declare Function GetMenuString _ Lib user32 _ Alias GetMenuStringA (ByVal hMenu As Long, _ ByVal wIDItem As Long, _ ByVal lpString As String, _ ByVal nMaxCount As Long, _ ByVal wFlag As Long) As LongPublic Declare Function CreateMenu Lib user32 () As LongPublic Declare Function VirtualProtect _ Lib KERNEL32 (ByVal lpAddress As Long, _ ByVal dwSize As Long, _ ByVal f