CSDN首页 空间 新闻 论坛 Blog 下载 读书 网摘 搜索 .NET Java 视频 接项目 求职 在线学习 买书 程序员 通知
山寨机中的战斗机! 程序优化工程师到底对IT界有没有贡献
CSDN社区
搜索 收藏 打印 关闭
CSDN社区 >  VB >  API

急急急急急急急急急急急,菜鸟求教,文件夹右键原理提问,急急急急急急急急

楼主klj218(诺法克の魔法)2005-09-23 10:43:29 在 VB / API 提问

小弟想实现类似WINRAR的功能,就是能实现文件夹上按鼠标右键能打开我写的VB程序,请问是要修改注册表哪里?? 问题点数:20、回复次数:12Top

1 楼klj218(诺法克の魔法)回复于 2005-09-23 14:22:36 得分 0

急Top

2 楼viena(维也纳N02)回复于 2005-09-23 14:36:19 得分 20

[以下转贴,参考]  
  Windows外壳扩展编程    
  出自:http://grace7450.xiloo.com   2002年10月18日   23:09    
   
    在Windows下的一些软件提供了这样的功能:当安装了这些软件之后,当在Windows的Explore中鼠标右键单击文件或者文件夹后,在弹出菜单中就会多出与该软件操作相关的菜单项,点击该项就会激活相应的程序对用户选中的文件进行相应的操作。例如安装了Winzip之后,当用户选中一个文件夹后单击右键,在弹出菜单中就会多出一个Add   To   Zip和一个   Add   To   xxx.zip的选项,其中xxx为选中的文件夹的名称。只要单击上面的两个菜单项中的一个,就可以方便的压缩目录了。这样的功能称为Windows外壳扩展(Shell   Extensions)  
   
    外壳扩展概述  
    下面是与外壳扩展相关的三个重要术语:  
  (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_ROOT\CLSID键之下进行注册。在该键下面可以找到许多名字像{0000002F-0000-0000-C000-000000000046}的键,这类键就是全局唯一类标识符。每一个外壳扩展都必须有一个全局唯一类标识符,Windows正是通过此唯一类标识符来找到外壳扩展处理程序的。在类标识符之下的InProcServer32子键下记录着外壳扩展动态链接库在系统中的位置。与某种文件类型关联的外壳扩展注册在相应类型的shellex主键下。如果所处的Windows操作系统为Windows   NT,则外壳扩展还必须在注册表中的HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\ShellExtensions\Approved主键下登记。  
   
    注册表HKEY_CLASSES_ROOT主键下有几个特殊的子键,如*、Folder、Drive以及Printer。如果把外壳扩展注册在*子键下,那么这个外壳扩展将对Windows中所有类型的文件有效;如果把外壳扩展注册在Folder子键下,则对所有目录有效。  
   
    上面提到的在Windows   Explore中在鼠标右键菜单中添加菜单项(我们成为上下文相关菜单)的操作属于外壳扩展的第一类,即Context   menu   handlers向特定类型的文件对象增添上下文相关菜单。要动态地在上下文相关菜单中增添菜单项,可以通过写Context   Menu   Handler来实现。  
   
    编写Context   Menu   Handler必须实现IShellExtInit和IContextMenu两个接口。除了IUnknown接口所定义的函数之外,Context   Menu   Handler还需要用到QueryContextMenu、InvokeCommand和GetCommandString这三个非常重要的成员函数。  
   
    (1)QueryContextMenu函数:每当系统要显示一个文件对象的上下文相关菜单时,它首先要调用该函数。为了在上下文相关菜单中添加菜单项,我们在该函数中调用InsertMenu函数。  
    (2)InvokeCommand函数:当用户选定了某个Context   Menu   Handler登记过的菜单项后,该函数将会被调用,系统将会传给该函数一个指向LPCMINVOKECOMMANDINFO结构的指针。在该函数中要执行与所选菜单项相对应的操作。  
    (3)GetCommandString函数:当鼠标指针移到一个上下文相关菜单项上时,在当前窗口的状态条上将会出现与该菜单项相关的帮助信息,此信息就是系统通过调用该函数获取的。  
   
    下面我通过具体的例程来说明编写一个比较完整的上下文菜单程序,这个程序是一个文件操作程序,当安装并注册了外壳扩展的服务器动态连接库之后,当选择一个或者多个文件并单击鼠标右键后,在右键菜单中就会多出一个“执行文件操作”的上下文菜单,点击菜单就会弹出相应的程序执行文件操作。  
   
    在整个程序的编写中,外壳扩展的服务器动态连接库是有Delphi4.0编写的,而动态连接库调用的文件操作程序是由VB6编写的。下面首先介绍服务器动态连接库的编写:  
   
    服务器动态连接库的工程文件内容如下:  
  library   contextmenu;  
   
  uses  
   ComServ,   ContextMenuHandler   in   'Unit2.pas';  
   //   contmenu_TLB   in   'contmenu_TLB.pas';  
   exports,   DllGetClassObject,   DllCanUnloadNow,   DllRegisterServer,   DllUnregisterServer;  
   
  {$R   *.TLB}  
   
  {$R   *.RES}  
   
  begin  
   
  end.    
   
    将工程文件保存为contextmenu.dpr。  
    服务器动态连接库的单位文件内容如下:  
  unit   ContextMenuHandler;  
  interface  
  uses  
   Windows,   ActiveX,   ComObj,   ShlObj,   Classes;  
  type  
   TContextMenu   =   class(TComObject,   IShellExtInit,   IContextMenu)  
   private  
    FFileName:   array[0..MAX_PATH]   of   Char;  
   protected  
    function   IShellExtInit.Initialize   =   SEIInitialize;   //   Avoid   compiler   warning  
    function   SEIInitialize(pidlFolder:   PItemIDList;   lpdobj:   IDataObject;  
  hKeyProgID:   HKEY):   HResult;   stdcall;  
    function   QueryContextMenu(Menu:   HMENU;   indexMenu,   idCmdFirst,   idCmdLast,   uFlags:   UINT):   HResult;   stdcall;  
    function   InvokeCommand(var   lpici:   TCMInvokeCommandInfo):   HResult;   stdcall;  
    function   GetCommandString(idCmd,   uType:   UINT;   pwReserved:   PUINT;  
    pszName:   LPSTR;   cchMax:   UINT):   HResult;   stdcall;  
  end;  
   
  const  
   Class_ContextMenu:   TGUID   =   '{19741013-C829-11D1-8233-0020AF3E97A9}';  
   {全局唯一标识符(GUID)是一个16字节(128为)的值,它唯一地标识一个接口(interface)}  
  var  
   FileList:TStringList;  
   Buffer:array[1..1024]of   char;  
   
  implementation  
  uses  
   ComServ,   SysUtils,   ShellApi,   Registry,   UnitForm;  
   
  function   TContextMenu.SEIInitialize(pidlFolder:   PItemIDList;   lpdobj:   IDataObject;hKeyProgID:   HKEY):   HResult;  
  var  
   StgMedium:   TStgMedium;  
   FormatEtc:   TFormatEtc;  
   FileNumber,   i:Integer;  
  begin  
   //如果lpdobj等于Nil,则本调用失败  
   if   (lpdobj   =   nil)   then  
   begin  
    Result   :=   E_INVALIDARG;  
    Exit;  
   end;  
   //首先初始化并清空FileList以添加文件  
   FileList:=TStringList.Create;  
   FileList.Clear;  
   //初始化剪贴版格式文件  
   with   FormatEtc   do  
   begin  
    cfFormat   :=   CF_HDROP;  
    ptd   :=   nil;  
    dwAspect   :=   DVASPECT_CONTENT;  
    lindex   :=   -1;  
    tymed   :=   TYMED_HGLOBAL;  
   end;  
   Result   :=   lpdobj.GetData(FormatEtc,   StgMedium);  
   if   Failed(Result)   then   Exit;  
   //首先查询用户选中的文件的个数  
   FileNumber   :=   DragQueryFile(StgMedium.hGlobal,   $FFFFFFFF,   nil,   0);  
   //循环读取,将所有用户选中的文件保存到FileList中  
   for   i:=0   to   FileNumber-1   do  
   begin  
    DragQueryFile(StgMedium.hGlobal,   i,   FFileName,   SizeOf(FFileName));  
    FileList.Add(FFileName);  
    Result   :=   NOERROR;  
   end;  
   ReleaseStgMedium(StgMedium);  
  end;  
   
  function   TContextMenu.QueryContextMenu(Menu:   HMENU;   indexMenu,   idCmdFirst,   idCmdLast,   uFlags:   UINT):   HResult;  
  begin  
   Result   :=   0;  
   if   ((uFlags   and   $0000000F)   =   CMF_NORMAL)   or   ((uFlags   and   CMF_EXPLORE)   <>   0)   then  
   begin  
    //   往Context   Menu中加入一个菜单项  
    InsertMenu(Menu,   indexMenu,   MF_STRING   or   MF_BYPOSITION,   idCmdFirst,   PChar('执行文件操作'));  
    //   返回增加菜单项的个数  
    Result   :=   1;  
   end;  
  end;Top

3 楼viena(维也纳N02)回复于 2005-09-23 14:37:21 得分 0

function   TContextMenu.InvokeCommand(var   lpici:   TCMInvokeCommandInfo):   HResult;  
  var  
   //   sFile:TFileStream;  
   charSavePath:array[0..1023]of   char;  
   sSaveFile:String;  
   i:Integer;  
   F:   TextFile;  
   FirstLine:   string;  
  begin  
   //   首先确定该过程是被系统而不是被一个程序所调用  
   if   (HiWord(Integer(lpici.lpVerb))   <>   0)   then  
   begin  
    Result   :=   E_FAIL;  
    Exit;  
   end;  
   //   确定传递的参数的有效性  
   if   (LoWord(lpici.lpVerb)   <>   0)   then  
   begin  
    Result   :=   E_INVALIDARG;  
    Exit;  
   end;  
   //建立一个临时文件保存用户选中的文件名  
   GetTempPath(1024,   charSavePath);  
   sSaveFile:=charSavePath+'chen0001.tmp';  
   AssignFile(F,   sSaveFile);   {   next   file   in   Files   property   }  
   ReWrite(F);  
   //将文件名保存到临时文件中  
   for   i:=   0   to   FileList.Count   -1   do  
   begin  
    FirstLine:=FileList.S  
   
  ///add///  
   
    将该单位文件保存为unit2.pas,文件同contextmenu.dpr位于同一个目录下。  
   
    打开Delphi,选菜单中的   file   |   open   project   打开contextmenu.dpr文件,然后选   Project   |   build   contextmenu菜单项编译连接程序,如果编译成功的话,会建立一个contextmenu.dll的动态连接库文件,这个文件就是服务器动态连接库。  
   
    下面来建立文件操作程序。打开VB,建立一个新的工程文件,在Form1中加入一个ListBox控件和三个CommandButton控件,将ListBox的MultiSelect属性设置为2。然后在Form1的代码窗口中加入以下代码:  
   
  Option   Explicit  
  Private   Type   BrowseInfo  
  hwndOwner   As   Long  
  pIDLRoot   As   Long  
  pszDisplayName   As   Long  
  lpszTitle   As   Long  
  ulFlags   As   Long  
  lpfnCallback   As   Long  
  lParam   As   Long  
  iImage   As   Long  
  End   Type  
  Private   Type   SHFILEOPSTRUCT  
  hwnd   As   Long  
  wFunc   As   Long   '对文件的操作指令  
  pFrom   As   String   '源文件或路径  
  pTo   As   String   '目的文件或路径  
  fFlags   As   Integer   '操作标志  
  fAnyOperationsAborted   As   Long  
  hNameMappings   As   Long  
  lpszProgressTitle   As   String  
  End   Type  
  Const   FO_COPY   =   &H2  
  Const   FO_DELETE   =   &H3  
  Const   FO_MOVE   =   &H1  
  Const   FO_RENAME   =   &H4  
  Const   FOF_ALLOWUNDO   =   &H40  
  Const   BIF_RETURNONLYFSDIRS   =   1  
  Const   MAX_PATH   =   260  
  Private   Declare   Function   ShellAbout   Lib   "shell32.dll"   Alias   _  
  ShellAboutA  
  (ByVal   hwnd   As   Long  
  ByVal   szApp   As   _  
  String  
  ByVal   szOtherStuff   As   String  
  ByVal   hIcon   As   Long)   _  
  As   Long  
  Private   Declare   Sub   CoTaskMemFree   Lib   "ole32.dll"   (ByVal   hMem   As   Long)  
  Private   Declare   Function   lstrcat   Lib   "kernel32"   Alias   _  
  lstrcatA  
  (ByVal   lpString1   As   String  
  ByVal   lpString2   _  
  As   String)   As   Long  
  Private   Declare   Function   SHBrowseForFolder   Lib   "shell32"   (lpbi   _  
  As   BrowseInfo)   As   Long  
  Private   Declare   Function   SHGetPathFromIDList   Lib   "shell32"   _  
  (ByVal   pidList   As   Long  
  ByVal   lpBuffer   As   String)   As   Long  
  Private   Declare   Function   SHFileOperation   Lib   "shell32"   _  
  (lpFileOp   As   SHFILEOPSTRUCT)   As   Long  
  Private   Declare   Function   GetWindowsDirectory   _  
  Lib   "kernel32"   Alias   "GetWindowsDirectoryA"   _  
  (ByVal   lpBuffer   As   String  
  ByVal   nSize   As   _  
  Long)   As   Long  
  Dim   DirString   As   String  
  Dim   sFile   As   String  
  Sub   UpdateList()  
  'UpdateList函数检查列表框中的文件是否存在,如果不存在,就将其  
  '从文件列表中删除  
  Dim   bEndList   As   Boolean  
  Dim   i   As   Integer  
  bEndList   =   True  
  i   =   0  
  While   bEndList  
  '检查文件是否存在,如果不存在就删除  
  If   Dir$(List1.List(i))   =   ""   Then  
  List1.RemoveItem   (i)  
  Else   '如果文件存在就转移到下一个列表项  
  i   =   i   +   1  
  If   i   >   List1.ListCount   -   1   Then  
  bEndList   =   False  
  End   If  
  End   If  
  Wend  
  Command1.Enabled   =   False  
  Command2.Enabled   =   False  
  Command3.Enabled   =   False  
  End   Sub  
  Top

4 楼viena(维也纳N02)回复于 2005-09-23 14:37:37 得分 0

Function   BrowseForFolder(hwndOwner   As   Long  
  sPrompt   As   String)   As   String  
  Dim   iNull   As   Integer  
  Dim   lpIDList   As   Long  
  Dim   lResult   As   Long  
  Dim   sPath   As   String  
  Dim   udtBI   As   BrowseInfo  
  '初试化udtBI结构  
  With   udtBI  
  .hwndOwner   =   hwndOwner  
  .lpszTitle   =   lstrcat(sPrompt)  
  .ulFlags   =   BIF_RETURNONLYFSDIRS  
  End   With  
  '弹出文件夹查看窗口  
  lpIDList   =   SHBrowseForFolder(udtBI)  
  If   lpIDList   Then  
  sPath   =   String$(MAX_PATH,   0)  
  lResult   =   SHGetPathFromIDList(lpIDList,   sPath)  
  Call   CoTaskMemFree(lpIDList)  
  iNull   =   InStr(sPath,   vbNullChar)  
  If   iNull   Then   sPath   =   Left$(sPath,   iNull   -   1)  
  End   If  
  BrowseForFolder   =   sPath  
  End   Function  
  Private   Sub   Command1_Click()   '执行文件拷贝操作  
  Dim   sPath   As   String  
  Dim   tCopy   As   SHFILEOPSTRUCT  
  Dim   i   As   Integer  
  '选择拷贝到的文件夹  
  sPath   =   BrowseForFolder(Form1.hwnd,   选择拷贝到的文件夹)  
  If   sPath   <>   ""   Then  
  With   tCopy  
  .hwnd   =   Form1.hwnd  
  .lpszProgressTitle   =   "正在拷贝"  
  .pTo   =   sPath  
  .fFlags   =   FOF_ALLOWUNDO  
  .wFunc   =   FO_COPY  
  End   With  
  For   i   =   0   To   List1.ListCount   -   1  
  If   List1.Selected(i)   Then   '如果文件被选中则拷贝文件    
  tCopy.pFrom   =   List1.List(i)  
  SHFileOperation   tCopy  
  End   If  
  Next   i  
  UpdateList  
  End   If  
  Kill   sFile  
  End   Sub  
  Private   Sub   Command2_Click()   '执行文件移动操作  
  Dim   sPath   As   String  
  Dim   tCopy   As   SHFILEOPSTRUCT  
  Dim   i   As   Integer  
  '选择移动到的文件夹  
  sPath   =   BrowseForFolder(Form1.hwnd,   选择转移到的文件夹)  
  If   sPath   <>   ""   Then  
  With   tCopy  
  .hwnd   =   Form1.hwnd  
  .lpszProgressTitle   =   "正在移动"  
  .pTo   =   sPath  
  .fFlags   =   FOF_ALLOWUNDO  
  .wFunc   =   FO_MOVE  
  End   With  
  For   i   =   0   To   List1.ListCount   -   1  
  If   List1.Selected(i)   Then   '如果文件被选中则拷贝文件  
  tCopy.pFrom   =   List1.List(i)  
  SHFileOperation   tCopy  
  End   If  
  Next   i  
  UpdateList  
  End   If  
  Kill   sFile  
  End   Sub  
  Private   Sub   Command3_Click()   '执行文件删除操作  
  Dim   sPath   As   String  
  Dim   tCopy   As   SHFILEOPSTRUCT  
  Dim   i   As   Integer  
  With   tCopy  
  .hwnd   =   Form1.hwnd  
  .lpszProgressTitle   =   "正在删除"  
  .pTo   =   sPath  
  .fFlags   =   FOF_ALLOWUNDO  
  .wFunc   =   FO_DELETE  
  End   With  
  For   i   =   0   To   List1.ListCount   -   1  
  If   List1.Selected(i)   Then  
  tCopy.pFrom   =   List1.List(i)  
  SHFileOperation   tCopy  
  End   If  
  Next   i  
  UpdateList  
  Kill   sFile  
  End   Sub  
  Private   Sub   Form_Load()  
  Dim   hFileHandle   As   Long  
  Dim   TextLine   As   String  
  Command1.Caption   =   "拷贝"  
  Command2.Caption   =   "移动"  
  Command3.Caption   =   "删除"  
  Command1.Enabled   =   False  
  Command2.Enabled   =   False  
  Command3.Enabled   =   False  
  'sFile接受由Windows外壳扩展库contextmenu.dll传递过来的文件参数  
  sFile   =   Command$  
  hFileHandle   =   FreeFile  
  Open   sFile   For   Input   As   hFileHandle  
  Do   While   Not   EOF(hFileHandle)  
  Line   Input   #1  
  TextLine  
  If   Dir$(TextLine)   <>   ""   Then  
  List1.AddItem   TextLine  
  End   If  
  Loop  
  Close   hFileHandle  
  End   Sub  
  Private   Sub   Form_Unload(Cancel   As   Integer)  
  If   Dir$(sFile)   <>   ""   Then  
  Kill   sFile  
  End   If  
  End   Sub  
  Private   Sub   List1_Click()  
  If   Not   Command1.Enabled   Then  
  Command1.Enabled   =   True  
  Command2.Enabled   =   True  
  Command3.Enabled   =   True  
  End   If  
  End   Sub  
   
    保存文件并将工程文件编译为FileOP.exe文件,将文件拷贝到C盘根目录下。然后注册contextmenu.dll,注册的方法是,在DOS窗口中进入Windows\system子目录,输入   Regsvr32   x:\xxxxx\contextmenu.dll   。其中x:\xxxxx\为Contextmenu.dll文件所在的驱动器和目录。如果注册成功,系统会弹出对话框,显示   DllRegisterServer   in   ..\xxx\contextmenu.dll   Success   提示注册成功。  
   
    注册成功后,再选择文件并单击右键,就会发现在弹出菜单中多了一个“执行文件操作”的菜单项,点击该项,系统就会调用FileOP.exe执行文件操作,在窗口的列表框中会出现用户选择的文件名,点击相应的文件并点击“拷贝”、“移动”或“删除”按钮就可以对列表框中的选中的文件进行相应的操作。Top

5 楼kmlxk(xiaoKKKK)回复于 2005-09-23 15:10:56 得分 0

超强啊~Top

6 楼starlwg(赛沙)回复于 2005-09-23 16:01:32 得分 0

崇拜。。。Top

7 楼vansoft(Vansoft Workroom)回复于 2005-09-23 17:18:08 得分 0

那段代碼怎麽很眼熟啊。Top

8 楼VBAHZ(凌云(E文词汇量580))回复于 2005-09-23 18:52:12 得分 0

作个记号  
  Top

9 楼dancewith(共舞)回复于 2005-09-23 22:45:41 得分 0

已经写的十分详细了。Top

10 楼klj218(诺法克の魔法)回复于 2005-09-25 14:37:14 得分 0

楼上真强Top

11 楼klj218(诺法克の魔法)回复于 2005-09-26 10:30:32 得分 0

有没有全VB版的资料啊?Top

12 楼javacb(java)回复于 2005-10-12 11:00:58 得分 0

bjTop

相关问题

  • win2000SP4文件夹-右键-属性-没有安全选项????
  • 右键单击一个文件或者文件夹,如何获取该文件或者文件夹的句柄?
  • IE右键提问
  • 有关 文件/文件夹 操作的提问
  • 提问.关于项目文件夹里的文件
  • 提问:关于窗体验证的问题!根文件夹和子文件夹下的设置
  • 请问怎样在文件夹鼠标右键菜单中增加Cmd命令?
  • 对文件夹浏览器右键的新建的内容怎么调整?
  • 如何将文件夹右键菜单的共享键值去掉
  • 用TREEVEIW控件怎么做成象资源管理器中的文件夹,点击右键可以动态的添加删除修改节点(文件夹)

关键词

  • 文件
  • 函数
  • 扩展
  • 文件夹
  • 拷贝
  • 菜单项
  • 急急急急
  • 外壳扩展
  • 调用
  • 对象

得分解答快速导航

  • 帖主:klj218
  • viena

相关链接

  • Visual Basic类图书
  • Visual Basic类源码下载

广告也精彩

反馈

请通过下述方式给我们反馈
反馈
提问
网站简介|广告服务|VIP资费标准|银行汇款帐号|网站地图|帮助|联系方式|诚聘英才|English|问题报告
北京创新乐知广告有限公司 版权所有, 京 ICP 证 070598 号
世纪乐知(北京)网络技术有限公司 提供技术支持
Copyright © 2000-2008, CSDN.NET, All Rights Reserved
GongshangLogo