利用delphi编写windows外壳扩展_Delphi

  • 内容
  • 评论
  • 相关

对于操作系统原理比较了解的朋友都会知道,一个完备的操作系统都会提供了一个外壳(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数据传输;  

http://www.gaodaima.com/65623.html利用Delphi编写windows外壳扩展_Delphi

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

欢迎大家阅读《利用delphi编写windows外壳扩展_Delphi》,跪求各位点评,若觉得好的话请收藏本文,by 搞代码

原创文章,转载请注明: 转载自搞代码

本文链接地址: 利用delphi编写windows外壳扩展_Delphi

微信支付二维码

微信 赏一包辣条吧~

支付宝支付二维码

支付宝 赏一听可乐吧~

评论

0条评论

发表评论

电子邮件地址不会被公开。 必填项已用*标注