网站导航免费论文 原创论文 论文搜索 原创论文 网学软件 学术大家 资料中心 会员中心 问题解答 原创论文 论文素材 设计下载 最新论文 下载排行 论文上传 在线投稿 联系我们
返回网学首页
网学联系
最新论文 推荐专题 热门论文 素材专题
当前位置: 网学 > 编程文档 > DELPHI > 正文
利用delphi编写windows外壳扩展
来源:Http://myeducs.cn 联系QQ:点击这里给我发消息 作者: 用户投稿 来源: 网络 发布时间: 12/10/12
下载{$ArticleTitle}原创论文样式
filename));
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:

网学推荐

免费论文

原创论文

浏览:
设为首页 | 加入收藏 | 论文首页 | 论文专题 | 设计下载 | 网学软件 | 论文模板 | 论文资源 | 程序设计 | 关于网学 | 站内搜索 | 网学留言 | 友情链接 | 资料中心
版权所有 QQ:3710167 邮箱:3710167@qq.com 网学网 [Myeducs.cn] 您电脑的分辨率是 像素
Copyright 2008-2015 myeducs.Cn www.myeducs.Cn All Rights Reserved
湘ICP备09003080号