分享
 
 
 

利用Delphi编写Windows外壳扩展

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

利用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 中在任意的一个或者几个文件中点击鼠标右键,在上下文菜单中就会

多一个文件操作的菜单项,点击该项,在弹出窗口的列表中会列出你所选择的所有文件的文件名,你可以选择拷贝文件按钮或者

移动文件按钮执行文件操作。

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有