本文介绍了如何在windows 2000
profession中，用delphi实现对特定程序文件的属性页扩展.同时也介绍了在delphi环境下，对操作系统的通用对象模型(COM)实现应用的一般方法。
人们一般都有这样的经历:当用户在资源管理器中用右键菜单时，会显示一个“属性”菜单，点击属性菜单项会显示一个属性页，系统对不同的文件会有不同的属性页扩展。如：在windows98中对文本文件系统有“常规”属性页，对于word文档系统就有：“常规”、“载要”、“统计”三个属性页。而对于DLL文件系统只有“常规”、“版本”两个属性页。
那么，作为一个程序员如何也在自己开发的程序中实现类似系统上述的功能呢？其实，属性页扩展程序主要是一个以动态链接库DLL实现的in-process服务器，他除了实现基本的COM的iunknown接口外，还实现它的IShellExtInit和IShellpropsheetext接口。其中IShellExtInit的Initialize方法用于实现初始化快捷菜单处理器，IShellpropsheetext接口用于向属性页添加页面，如果属性页和特定的文件相关则系统会调用IShellpropsheetext的addpages方法给属性页添加一个页面。
现以编写一个指定文件扩展名为".bbs"为例把方法介绍如下：
1、首先用文本编辑器编写一个资源文件ra.rc，并用delphi自带的brcc32.exe编译成ra.res。
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
}
|
2、然后在Delphi中选择菜单File中的New命令，在ActiveX页中选择active
Library 以实现一个标准的in-process COM server。然后选择菜单File中的New命令，在ActiveX选择COM
object对象。
如图1，以实现IShellExtInit和IShellpropsheetext接口。并把单元文件文件保存unit1.pas，把项目文件保存为project1.dpr。
3、向prject1.dpr文件添加自己编译的资源文件，把{$R
*.RES}修改成{$R as.RES}。
3、编辑unit1.pas代码如下(我在要加入的代码旁都加以注释)：
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.
|
结果见图2和图3。
以上代码在Delphi
5.0+Windows 2000 Profession 中运行通过。
|
|
