怎么样具体实现添加属性页

lkcs 2010-01-16 11:50:35
怎么利用Property sheet handlers实现添加自定义的属性页
常规下.exe的文件会有"常规,兼容性,安全,摘要"等信息,比如我想在上面添加一个自己的属性页:文件名.
请问怎么样实现,最好给出代码,谢谢
...全文
166 5 打赏 收藏 转发到动态 举报
写回复
用AI写文章
5 条回复
切换为时间正序
请发表友善的回复…
发表回复
cs920 2010-01-18
  • 打赏
  • 举报
回复
文件信息是你可以取的呀~
cs920 2010-01-16
  • 打赏
  • 举报
回复
unit unit Unit1;

interface

uses
Windows, Sysutils, Messages, Registry, Shellapi, ActiveX, Classes, ComObj, Shlobj, ComServ, MMSystem,Dialogs, Commctrl;

type
TPropSheetExt = class(TComObject, IShellExtInit, IShellPropSheetExt)
private
TempFile:string;//定义一个文件名传递变量。
protected
{Declare IShellExtInit methods here}
function IShellExtInit.Initialize=MyInitialize;
//进行初始化代码的转移,使系统执行初始化操作时调用自己的代码//
function MyInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult; stdcall;
//Initialize的方法定义在shlobj.pas文件中//
{Declare IShellPropSheetExt methods here}
function AddPages(lpfnAddPage: TFNAddPropSheetPage; lParam: LPARAM): HResult; stdcall;
function ReplacePage(uPageID: UINT; lpfnReplaceWith: TFNAddPropSheetPage;
lParam: LPARAM): HResult; stdcall;
//IShellPropSheetExt的方法定义在shlobj.pas文件中//
end;
type//每一个COM对象必须有一个类工厂,用于在服务器端实现COM对象//
TPropSheetExtFactory=class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;
const
Class_PropSheetExt: TGUID = '{2356E2F2-419F-11D4-9376-5254AB159E5E}';
//GUID值系统唯一产生//
var
Error, dwFlags: Longint;
DeviceID : Word;

implementation
//---------------------------------------------------------------------------------//
function PropCallback(hWndDlg: HWnd; Msg: Integer;
var PPSP: TPropSheetPage): Integer; stdcall;
begin
case Msg of
PSPCB_RELEASE: if ppsp.lparam<> 0 then TPropSheetExt(ppsp.lparam)._release;
end;//使用完接口后通过调用_release来减少对接口的引用。//
result:=1;
end;
//-------------------------------------------------------------------------------//
function DialogProc(hwndDlg: HWnd; Msg: UINT; wParam: wParam;
lParam: LPARAM): Bool; stdcall;//该回调函数用于处理属性页的消息//
var
MyPropsheetExt: TPropSheetExt;
filename: string;
// displayName : string;
// buffer: array[0..255]of char;
//SheetHWnd: HWnd;
begin
result:=false;
try
if Msg=WM_INITDIALOG then//该消息用于初始化页面显示信息//
begin
MyPropSheetExt:=TPropSheetExt(PPropSheetPage(lParam)^.lParam);
SetWindowLong(hwndDlg, DWL_USER, integer(MyPropSheetExt));
SetDlgItemText(hwndDlg, 100, PChar(ExtractFileName(MyPropSheetExt.TempFile)));
SetWindowLong(hwndDlg, DWL_MSGRESULT, 0);
Result:=TRUE;
end;
if(Msg=WM_COMMAND)then//该消息用于响应用户在属性页上的按扭事件//
begin
if Lo(wParam)=101 then//101为资源文件上IDC_PUSHBUTTON1的标示符//
showmessage('谢谢你使用');
end ;
except//在处理属性页面失效时显示出错信息//
on e: exception do
begin
e.message:='PropExtDlgProc '+e.message;
messagebox(0, pchar(e.message), 'error', mb_ok);
end;
end;
end;
//------------------------------------------------------------------------------------//


procedure TPropSheetExtFactory.UpdateRegistry(Register: Boolean);
var//注册属性页以便同指定的文件关联//
MyClassID: string;
begin
inherited UpdateRegistry(Register);
if Register then
begin
MyClassID:=GUIDToString(Class_PropSheetExt);
with TRegistry.Create do
try
RootKey:=HKEY_CLASSES_ROOT;
createregkey('.bbs','','sunhangdong');
createregkey('sunhangdong\shellex\PropertySheetHandlers\'+classname,'',MyClassID);
finally
Free;
end;
end
else
begin
deleteregkey('sunhangdong\shellex\PropertySheetHandlers\'+classname);
end;
end;

//----------------------------------------------------------------------------------------//
{ TPropSheetExt }

function TPropSheetExt.AddPages(lpfnAddPage: TFNADDPROPSHEETPAGE;
lParam: LPARAM): HResult;
var//初始化快捷菜单//
TProp: TPropSheetPage;
HProP: HPropSheetPage;
begin
result:=E_FAIL;
try
TProp.dwSize:=SizeOf(TProp);
TProp.dwFlags:=PSP_USEREFPARENT or PSP_USETITLE or PSP_USECALLBACK;
TProp.hInstance:=hInstance;
TProp.pszTemplate:=MakeIntResource(1);//属性页的标示符//
TProp.pszTitle:='特别消息';//属性页标题
Tprop.pfnDlgProc:=@DialogProc;
TProp.pfnCallBack:=@PropCallback;
//设立回调函数//
TProp.pcRefParent:=@comserver.objectcount;
//把扩展对象引用计数赋予pcRefParent对象,以防止属性页在显示时就被删除//
TProp.lParam:=integer(self);//传递对象指针//
HProP:=CreatePropertySheetPage(TProp);
if HPSP<>nil then begin
if not lpfnAddPage(HProP, lParam)then begin
DestroyPropertySheetPage(HProP);
end else begin
_addref;//增加引用计数,以防止方法不在作用范围时,被系统释放//
result:=S_OK;
end
end
except
on e: exception do begin
e.message:='AddPages '+e.message;
messagebox(0, pchar(e.message), 'error', mb_ok);
end;
end;
end;
//------------------------------------------------------------------------------------------//
function TPropSheetExt.ReplacePage(uPageID: UINT;
lpfnReplaceWith: TFNADDPROPSHEETPAGE; lParam: LPARAM): HResult;
begin//当属性页和控制面版相关时,系统会调用该方法来替换属性页,在本程序中无用,但必须定义//
Result:=E_NOTIMPL;
end;
//-----------------------------------------------------------------------------------------//
function TPropSheetExt.MyInitialize(pidlFolder: PItemIDList;
lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
var//实现初始化快捷菜单处理器//
MyStgMedium: TStgMedium;
MyFormatEtc: TFormatEtc;
Filelength: array[0..MAX_PATH+1]of Char;
count: integer;
begin
Result:=E_FAIL;
if(lpdobj=nil)then begin
Result:=E_INVALIDARG;//如果COM服务器没有对象提供//
messagebox(0, '1', 'error', mb_ok);
Exit;
end;

with MyFormatEtc do begin//在用户进行数据接口的呈现时必须用此接口//
cfFormat:=CF_HDROP;
ptd:=nil;
dwAspect:=DVASPECT_CONTENT;
lindex:=-1;
tymed:=TYMED_HGLOBAL;
end;
Result:=lpdobj.GetData(MyFormatEtc, MyStgMedium);
if Failed(Result)then
Exit;//如果从数据接口无法得到数据//
count:=DragQueryFile(Mystgmedium.hGlobal, $FFFFFFFF, nil, 0);//count返回的是用户选择的文件数//
if count=1 then//用于确保用户只选择了一个文件//
begin
Result:=NOERROR;
DragQueryFile(Mystgmedium.hGlobal, 0, FileLength, MAX_PATH);
TempFile:=strpas(FileLength);
end;
ReleaseStgMedium(MyStgMedium);
end;
//--------------------------------------------------------------------------------------------//
initialization
TPropSheetExtFactory.Create(ComServer, TPropSheetExt, Class_PropSheetExt,
'PropSheetExt', '', ciMultiInstance, tmApartment);
end.
参自:http://www.it222.cn/softedu/g/10546.html
金卯刀 2010-01-16
  • 打赏
  • 举报
回复
shell 扩展

详情
lkcs 2010-01-16
  • 打赏
  • 举报
回复
2楼提供的代码对检索资源得到的信息是固定的,我如何动态取得比如:文件名等信息呢?
ra.rc代码如下

#define DIALOG_1 1 //资源文件标示符
#define IDC_PUSHBUTTON1 101 //按扭标示符

DIALOG_1 DIALOG 6, 15, 161, 127
STYLE WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU | WS_THICKFRAME | WS_MINIMIZEBOX | WS_MAXIMIZEBOX
CAPTION "DIALOG_1"
FONT 8, "MS Sans Serif"
{
LTEXT "作者", -1, 9, 15, 47, 18 //比如我这要换成文件名.........
LTEXT "时间", -1, 8, 38, 44, 17
LTEXT "孙航东", -1, 79, 17, 64, 20
LTEXT "2002.04.26", -1, 80, 41, 60, 18
PUSHBUTTON "Button", IDC_PUSHBUTTON1, 79, 88, 53, 17
}

kfcoffe 2010-01-16
  • 打赏
  • 举报
回复
mark

5,386

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧