Delphi编写windows外壳扩展

Delphi编写windows外壳扩展

　　对于操作系统原理比较了解的朋友都会知道，一个完备的操作系统都会提供了一个外壳（shell），以方便普通的用户使用操作系统提供的各种功能。windows（在这里指的是windows 95/windows nt4.0以上版本的操作系统）的外壳不但提供了方便美观的gui图形界面，而且还提供了强大的外壳扩展功能，大家可能在很多软件中看到这些外壳扩展了。例如在你的系统中安装了winzip的话，当你在windows explore中鼠标右键点击文件夹或者文件后，在弹出菜单中就会出现winzip的压缩菜单。又或者bullet ftp中在windows资源管理器中出现的ftp站点文件夹。

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对象的一些知识是十分必要的。   由于篇幅所限，在这里就不介绍com，读者可以参考微软的msdn库或者相关的帮助文档，一个接口可以看做是一个特殊的类，它包含一组函数合过程可以用来操作一个对象。
　　写好外壳扩展程序后，必须将它们注册才能生效。所有的外壳扩展都必须在windows注册表的hkey_classes_root/clsid键之下进行注册。在该键下面可以找到许多名字像{0000002f-0000-0000-c000-000000000046}的键，这类键就是全局唯一类标识符(guid)。每一个外壳扩展都必须有一个全局唯一类标识符，windows正是通过此唯一类标识符来找到外壳扩展处理程序的。
在类标识符之下的inprocserver32子键下记录着外壳扩展动态链接库在系统中的位置。与某种文件类型关联的外壳扩展注册在
相应类型的shellex主键下。如果所处的windows操作系统为windows   nt，则外壳扩展还必须在注册表中的hkey_local_machine/software/microsoft/windows/currentversion/shellextensions/approved主键下登记。
          编译完外壳扩展的dll程序后就可以用windows本身提供的regsvr32.exe来注册该dll服务器程序了。如果使用delphi，也可
以在run菜单中选择register   activex   server来注册。

　　下面首先介绍一个比较常用的外壳扩展应用：上下文相关菜单，在windows中，用鼠标右键单击文件或者文件夹时弹出的那个菜单便称为上下文相关菜单。要动态地在上下文相关菜单中增添菜单项，可以通过写context   menu   handler来实现。比如大家所熟悉的winzip和ultraedit等软件都是通过编写context   menu   handler来动态地向菜单中增添菜单项的。如果系统中安装了winzip，那么当用右键单击一个名为windows的文件（夹）时，其上下文相关菜单就会有一个名为add   to   windows.zip的菜单项。
　　本文要实现的context   menu   handler与winzip提供的上下文菜单相似。它将在任意类型的文件对象的上下文相关菜单中添加一个文件操作菜单项，当点击该项后，接口程序就会弹出一个文件操作窗口，执行文件拷贝、移动等操作。
　　编写context   menu   handler必须实现ishellextinit、icontextmenu和tcomobjectfactory三个接口。ishellextinit实现接口的初始化，icontextmenu接口对象实现上下文相关菜单，icomobjectfactory接口实现对象的创建。
　　下面来介绍具体的程序实现。首先在delphi中点击菜单的   file|new   项，在new   item窗口中选择dll建立一个dll工程文件。
然后点击菜单的   file|new   项，在new   item窗口中选择unit建立一个unit文件，点击点击菜单的   file|new   项，在new   item窗口中选择form建立一个新的窗口。将将工程文件保存为contextmenu.dpr   ，将unit1保存为contextmenuhandle.pas，将form保存为   opwindow.pas。
contextmenu.dpr的程序清单如下：

  library   contextmenu;   
          uses   
      comserv,   
      contextmenuhandle   in   'contextmenuhandle.pas',   
      opwindow   in   'opwindow.pas'   {form2};   
    
  exports   
        dllgetclassobject,   
        dllcanunloadnow,   
        dllregisterserver,   
        dllunregisterserver;   
    
  {$r   *.tlb}   
    
  {$r   *.res}   
    
  begin   
    
  end.   
    
          contextmenuhandle的程序清单如下：   
  unit   contextmenuhandle;   
    
  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-0020af3e97a0}';   
    
  {全局唯一标识符(guid)是一个16字节（128为）的值，它唯一地标识一个接口(interface)}   
  var   
        filelist:tstringlist;   
    
    
  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   
        file://如果lpdobj等于nil，则本调用失败    
        if   (lpdobj   =   nil)   then   begin   
              result   :=   e_invalidarg;   
              exit;   
        end;   
    
        file://首先初始化并清空filelist以添加文件    
        filelist:=tstringlist.create;   
        filelist.clear;   
        file://初始化剪贴版格式文件    
        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;   
    
        file://首先查询用户选中的文件的个数    
        filenumber   :=   dragqueryfile(stgmedium.hglobal,$ffffffff,nil,0);   
        file://循环读取，将所有用户选中的文件保存到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;   
    
  function   tcontextmenu.invokecommand(var   lpici:   tcminvokecommandinfo):   hresult;   
  var   
      frmop:tform1;   
  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;   
    
        file://建立文件操作窗口    
      frmop:=tform1.create(nil);   
      file://将所有的文件列表添加到文件操作窗口的列表中    
      frmop.listbox1.items   :=   filelist;   
      result   :=   noerror;   
  end;   
    
    
  function   tcontextmenu.getcommandstring(idcmd,   utype:   uint;   pwreserved:   puint;   
                    pszname:   lpstr;   cchmax:   uint):   hresult;   
  begin   
        if   (idcmd   =   0)   then   begin   
        if   (utype   =   gcs_helptext)   then   
              {返回该菜单项的帮助信息，此帮助信息将在用户把鼠标   
              移动到该菜单项时出现在状态条上。}   
              strcopy(pszname,   pchar('点击该菜单项将执行文件操作'));   
              result   :=   noerror;   
        end   
        else   
              result   :=   e_invalidarg;   
  end;   
    
  type   
        tcontextmenufactory   =   class(tcomobjectfactory)   
        public   
        procedure   updateregistry(register:   boolean);   override;   
  end;   
    
  procedure   tcontextmenufactory.updateregistry(register:   boolean);   
  var   
        classid:   string;   
  begin   
        if   register   then   begin   
              inherited   updateregistry(register);   
              classid   :=   guidtostring(class_contextmenu);   
              file://当注册扩展库文件时，添加库到注册表中    
              createregkey('*/shellex',   '',   '');   
              createregkey('*/shellex/contextmenuhandlers',   '',   '');   
              createregkey('*/shellex/contextmenuhandlers/fileopreation',   '',   classid);   
    
          file://如果操作系统为windows   nt的话    
              if   (win32platform   =   ver_platform_win32_nt)   then   
              with   tregistry.create   do   
              try   
                    rootkey   :=   hkey_local_machine;   
                    openkey('software/microsoft/windows/currentversion/shell   extensions',   true);   
                    openkey('approved',   true);   
                    writestring(classid,   'context   menu   shell   extension');   
              finally   
                    free;   
              end;   
        end   
        else   begin   
              deleteregkey('*/shellex/contextmenuhandlers/fileopreation');   
              inherited   updateregistry(register);   
        end;   
  end;   
    
      
    
  initialization   
    tcontextmenufactory.create(comserver,   tcontextmenu,   class_contextmenu,   
        '',   'context   menu   shell   extension',   cimultiinstance,tmapartment);   
    
  end.   
    
    
          在opwindow窗口中加入一个tlistbox控件和两个tbutton控件，opwindows.pas的程序清单如下：   
  unit   opwindow;   
    
  interface   
    
  uses   
      windows,   messages,   sysutils,   classes,   graphics,   controls,   forms,   dialogs,   
      extctrls,   stdctrls,shlobj,shellapi,activex;   
    
  type   
      tform1   =   class(tform)   
          listbox1:   tlistbox;   
          button1:   tbutton;   
          button2:   tbutton;   
          procedure   formcreate(sender:   tobject);   
          procedure   formclose(sender:   tobject;   var   action:   tcloseaction);   
          procedure   button1click(sender:   tobject);   
          procedure   button2click(sender:   tobject);   
      private   
          {   private   declarations   }   
      public   
          filelist:tstringlist;   
          {   public   declarations   }   
      end;   
    
  var   
        form1:   tform1;   
    
  implementation   
    
  {$r   *.dfm}   
    
  procedure   tform1.formcreate(sender:   tobject);   
  begin   
      filelist:=tstringlist.create;   
      button1.caption   :='复制文件';   
      button2.caption   :='移动文件';   
      self.show;   
  end;   
    
  procedure   tform1.formclose(sender:   tobject;   var   action:   tcloseaction);   
  begin   
      filelist.free;   
  end;   
    
  procedure   tform1.button1click(sender:   tobject);   
  var   
      spath:string;   
      fstemp:shfileopstruct;   
      i:integer;   
  begin   
      spath:=inputbox('文件操作','输入复制路径','c:/windows');   
      if   spath<>''then   begin   
          fstemp.wnd   :=   self.handle;   
          file://设置文件操作类型    
          fstemp.wfunc   :=fo_copy;   
          file://允许执行撤消操作    
          fstemp.fflags   :=fof_allowundo;   
          for   i:=0   to   listbox1.items.count-1   do   begin   
              file://源文件全路径名    
              fstemp.pfrom   :=   pchar(listbox1.items.strings[i]);   
              file://要复制到的路径    
              fstemp.pto   :=   pchar(spath);   
              fstemp.lpszprogresstitle:='拷贝文件';   
              if   shfileoperation(fstemp)<>0   then   
                  showmessage('文件复制失败');   
          end;   
      end;   
  end;   
    
  procedure   tform1.button2click(sender:   tobject);   
  var   
      spath:string;   
      fstemp:shfileopstruct;   
      i:integer;   
  begin   
      spath:=inputbox('文件操作','输入移动路径','c:/windows');   
      if   spath<>''then   begin   
          fstemp.wnd   :=   self.handle;   
          fstemp.wfunc   :=fo_move;   
          fstemp.fflags   :=fof_allowundo;   
          for   i:=0   to   listbox1.items.count-1   do   begin   
              fstemp.pfrom   :=   pchar(listbox1.items.strings[i]);   
              fstemp.pto   :=   pchar(spath);   
              fstemp.lpszprogresstitle:='移动文件';   
              if   shfileoperation(fstemp)<>0   then   
                  showmessage('文件复制失败');   
          end;   
      end;   
  end;   
    
  end. 

点击菜单的 project | build contextmenu 项，delphi就会建立contextmenu.dll文件，这个就是上下文相关菜单程序了。
使用，regsvr32.exe 注册程序，然后在windows的explore 中在任意的一个或者几个文件中点击鼠标右键，在上下文菜单中就会多一个文件操作的菜单项，点击该项，在弹出窗口的列表中会列出你所选择的所有文件的文件名，你可以选择拷贝文件按钮或者移动文件按钮执行文件操作。

posted on 2008-10-17 12:18 五维思考阅读(369) 评论(0) 编辑收藏举报

刷新页面返回顶部

五维思考

公告