进入旧版 | 服务项目 | 成功案例 | 联系方式 | 过客留言 | 友情链接
   
设为首页
加入收藏
联系我们
网站首页 | 新闻资讯 | 操作系统 | 办公软件 | 网络软件 | 工具软件 | 媒体动画 | 网页制作 | 网站开发 | 程序开发 | 平面设计
Photoshop视频教程 | Word入门 | Flash入门 | JScript | VBScript | ASP | PHP | ADO | 网页特效 | 3DS MAX6.0命令 | 系统进程
您当前的位置:GOODSGY电脑学习网 -> 程序开发 -> DLEPHI -> 文章内容  
利用Delphi编写Windows外壳扩展

利用Delphi编写Windows外壳扩展
    对于操作系统原理比较了解的朋友都会知道,一个完备的操作系统都会提供了一个外壳(Shell),以方便普通的用户
使用操作系统提供的各种功能。Windows(在这里指的是Windows 95Windows NT4.0以上版本的操作系统)的外壳不但提供
了方便美观的GUI图形界面,而且还提供了强大的外壳扩展功能,大家可能在很多软件中看到这些外壳扩展了。例如在你的
系统中安装了Winzip的话,当你在Windows Explore中鼠标右键点击文件夹或者文件后,在弹出菜单中就会出现Winzip的压
缩菜单。又或者Bullet FTP中在Windows资源管理器中出现的FTP站点文件夹。
    Windows支持七种类型的外壳扩展(称为Handler),它们相应的作用简述如下: www.goodsgy.com

  (1)Context menu handlers:向特定类型的文件对象增添上下文相关菜单; www.goodsgy.com

  (2)Drag-and-drop handlers用来支持当用户对某种类型的文件对象进行拖放操作时的OLE数据传输; www.goodsgy.com

  (3)Icon handlers用来向某个文件对象提供一个特有的图标,也可以给某一类文件对象指定图标; www.goodsgy.com

  (4)Property sheet handlers给文件对象增添属性页(就是右键点击文件对象或文件夹对象后,在弹出菜单中选属性
    项后出现的对话框),属性页可以为同一类文件对象所共有,也可以给一个文件对象指定特有的属性页; www.goodsgy.com

  (5)Copy-hook handlers在文件夹对象或者打印机对象被拷贝、移动、删除和重命名时,就会被系统调用,通过为Windows
    增加Copy-hook handlers,可以允许或者禁止其中的某些操作; www.goodsgy.com

  (6)Drop target handlers在一个对象被拖放到另一个对象上时,就会被系统被调用; www.goodsgy.com

  (7)Data object handlers在文件被拖放、拷贝或者粘贴时,就会被系统被调用。 www.goodsgy.com

  Windows的所有外壳扩展都是基于COM(Component Object Model) 组件模型的,外壳是通过接口(Interface)来访问对象的。
外壳扩展被设计成32位的进程中服务器程序,并且都是以动态链接库的形式为操作系统提供服务的。因此,如果要对Windows
的用户界面进行扩充的话,则具备写COM对象的一些知识是十分必要的。 由于篇幅所限,在这里就不介绍COM,读者可以参考
微软的MSDN库或者相关的帮助文档,一个接口可以看做是一个特殊的类,它包含一组函数合过程可以用来操作一个对象。
    写好外壳扩展程序后,必须将它们注册才能生效。所有的外壳扩展都必须在Windows注册表的HKEY_CLASSES_ROOTCLSID键
之下进行注册。在该键下面可以找到许多名字像{0000002F-0000-0000-C000-000000000046}的键,这类键就是全局唯一类标识
符(Guid)。每一个外壳扩展都必须有一个全局唯一类标识符,Windows正是通过此唯一类标识符来找到外壳扩展处理程序的。
在类标识符之下的InProcServer32子键下记录着外壳扩展动态链接库在系统中的位置。与某种文件类型关联的外壳扩展注册在
相应类型的shellex主键下。如果所处的Windows操作系统为Windows NT,则外壳扩展还必须在注册表中的
HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionShellExtensionsApproved主键下登记。
    编译完外壳扩展的DLL程序后就可以用Windows本身提供的regsvr32.exe来注册该DLL服务器程序了。如果使用Delphi,也可
以在Run菜单中选择Register ActiveX Server来注册。 www.goodsgy.com

    下面首先介绍一个比较常用的外壳扩展应用:上下文相关菜单,在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};www.goodsgy.com

exports
   DllGetClassObject,
   DllCanUnloadNow,
   DllRegisterServer,
   DllUnregisterServer;www.goodsgy.com

{$R *.TLB}www.goodsgy.com

{$R *.RES}www.goodsgy.com

beginwww.goodsgy.com

end.www.goodsgy.com

    Contextmenuhandle的程序清单如下:
unit ContextMenuHandle;www.goodsgy.com

interface
   uses Windows,ActiveX,ComObj,ShlObj,Classes;www.goodsgy.com

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;www.goodsgy.com

constwww.goodsgy.com

   Class_ContextMenu: TGUID = '{19741013-C829-11D1-8233-0020AF3E97A0}';www.goodsgy.com

{全局唯一标识符(GUID)是一个16字节(128为)的值,它唯一地标识一个接口(interface)}
var
   FileList:TStringList;www.goodsgy.com


implementationwww.goodsgy.com

uses ComServ, SysUtils, ShellApi, Registry,UnitForm;www.goodsgy.com

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;www.goodsgy.com

   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);www.goodsgy.com

   if Failed(Result) then Exit;www.goodsgy.com

   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;www.goodsgy.com

   ReleaseStgMedium(StgMedium);
end;www.goodsgy.com

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;www.goodsgy.com

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;www.goodsgy.com

   file://建立文件操作窗口
  frmOP:=TForm1.Create(nil);
  file://将所有的文件列表添加到文件操作窗口的列表中
  frmOP.ListBox1.Items := FileList;
  Result := NOERROR;
end;www.goodsgy.com


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;www.goodsgy.com

type
   TContextMenuFactory = class(TComObjectFactory)
   public
   procedure UpdateRegistry(Register: Boolean); override;
end;www.goodsgy.com

procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var
   ClassID: string;
begin
   if Register then begin
      inherited UpdateRegistry(Register);
      ClassID := GUIDToString(Class_ContextMenu);
      file://当注册扩展库文件时,添加库到注册表中
      CreateRegKey('*shellex', ', ');
      CreateRegKey('*shellexContextMenuHandlers', ', ');
      CreateRegKey('*shellexContextMenuHandlersFileOpreation', ', ClassID);www.goodsgy.com

    file://如果操作系统为Windows NT的话
      if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      with TRegistry.Create do
      try
         RootKey := HKEY_LOCAL_MACHINE;
         OpenKey('SOFTWAREMicrosoftWindowsCurrentVersionShell Extensions', True);
         OpenKey('Approved', True);
         WriteString(ClassID, 'Context Menu Shell Extension');
      finally
         Free;
      end;
   end
   else begin
      DeleteRegKey('*shellexContextMenuHandlersFileOpreation');
      inherited UpdateRegistry(Register);
   end;
end;www.goodsgy.com

 www.goodsgy.com

initialization
 TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
   ', 'Context Menu Shell Extension', ciMultiInstance,tmApartment);www.goodsgy.com

end.www.goodsgy.com


    在OpWindow窗口中加入一个TListBox控件和两个TButton控件,OpWindows.pas的程序清单如下:
unit opwindow;www.goodsgy.com

interfacewww.goodsgy.com

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls,shlobj,shellapi,ActiveX;www.goodsgy.com

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;www.goodsgy.com

var
   Form1: TForm1;www.goodsgy.com

implementationwww.goodsgy.com

{$R *.DFM}www.goodsgy.com

procedure TForm1.FormCreate(Sender: TObject);
begin
  FileList:=TStringList.Create;
  Button1.Caption :='复制文件';
  Button2.Caption :='移动文件';
  Self.Show;
end;www.goodsgy.com

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FileList.Free;
end;www.goodsgy.com

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;www.goodsgy.com

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;www.goodsgy.com

end.www.goodsgy.com

    点击菜单的 Project | Build ContextMenu 项,Delphi就会建立Contextmenu.dll文件,这个就是上下文相关菜单程序了。
使用,Regsvr32.exe 注册程序,然后在Windows的Explore 中在任意的一个或者几个文件中点击鼠标右键,在上下文菜单中就会
多一个文件操作的菜单项,点击该项,在弹出窗口的列表中会列出你所选择的所有文件的文件名,你可以选择拷贝文件按钮或者
移动文件按钮执行文件操作。www.goodsgy.com

在百度中搜索:利用Delphi编写Windows外壳扩展
在Google中搜索:利用Delphi编写Windows外壳扩展
在Yahoo中搜索:利用Delphi编写Windows外壳扩展

收藏到网摘:新浪VIVI 365key 我摘 POCO网摘 博采中心 YouNote 和讯网摘 天天收藏
[] [返回上一页] [打 印] [收 藏]

 相关文章    最新文章
· 利用注册表清除Word文档杀手病毒
· [组图] 利用Photoshop巧妙将人物改成“水人..
· [组图] 利用阴影的错觉,用Photoshop制作边..
· 在Excel中利用VBA创建多级选单
· [图文] 利用Win XP实现网络远程统一关机
· 巧妙利用QQ截图功能截取右键菜单图像
· 在Java中利用JCOM实现仿Excel编程详解
· [图文] 利用C#远程存取Access数据库
· 利用系统自带命令搞定:手动杀毒面面观
· 高手利用“灰鸽子”木马病毒盗窃被判刑
 
· 小技巧:如何用Delphi创建快捷方式
· Delphi版模仿熊猫烧香病毒核心源码
· Delphi“判断服务器路径”与“清空日志文..
· 应用程序敏感键的实现
· 用Delphi实现远程屏幕抓取
· 用DEPHI为应用软件建立注册机制
· 利用Hook技术实现键盘监控
· Delphi编程实现Ping操作
· 通用Delphi数据库输入控件DBPanel的实现
· 用Delphi开发屏幕保护预览程序

∷相关文章评论∷    (评论内容只代表网友观点,与本站立场无关!) [更多评论…]
站内搜索

精彩图文
  网站导航  
操作系统 办公软件 网络软件
Vista Windows2003 WindowsXP Windows2000/NT Windows9X/ME Linux 其他 Word Excel Powerpoint Outlook 金山系列 其他 网页浏览 上传下载 联络聊天 邮件工具 服务器软件 网络辅助
工具软件 媒体动画 网页制作
系统工具 媒体工具 压缩工具 图文处理 文件管理 其他 3DMAX Authorware Director Maya 视频处理 其他 Flash Dreamweaver FireWorks FrontPage LiveMotion Golive HTML/CSS 其它
网站开发 平面设计 程序设计
ASP JSP PHP CGI JavaScript VBScript XML/SOAP Web服务器 Photoshop PhotoImpact CorelDraw Illustrator Freehand 设计欣赏 其他 VB VC .NET C/C++ DELPHI JAVA

冀ICP备05019428号
Copyright © 2004-2008 电脑学习网 Inc.All rights reserved.
TEL:13832340607
QQ:39873155
E_Mail:good_sgy@tom.com  
MSN:goodsgy@hotmail.com