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;
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