利用Delphi编写Windows外壳扩展 (转)

利用Delphi编写Windows外壳扩展 (转)[@more@]

利用Delphi编写windows外壳扩展
  对于操作系统原理比较了解的朋友都会知道，一个完备的操作系统都会提供了一个外壳（shell），以方便普通的用户
使用操作系统提供的各种功能。Windows（在这里指的是Windows 95windows 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_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来注册。

  下面首先介绍一个比较常用的外壳扩展应用：上下文相关菜单，在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('*shellexContextMenuHandlers', '', '');
  CreateRegKey('*shellexContextMenuHandlersFileOpreation', '', ClassID);

  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;

 

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 中在任意的一个或者几个文件中点击鼠标右键，在上下文菜单中就会
多一个文件操作的菜单项，点击该项，在弹出窗口的列表中会列出你所选择的所有文件的文件名，你可以选择拷贝文件按钮或者
移动文件按钮执行文件操作。

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/10752043/viewspace-988053/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/10752043/viewspace-988053/