如何像Pc-cillin那樣給文件的屬性加上一葉：比方說Virus Scan,300分，要範例(300分)

請給範例，謝謝

改注册表吧？

up

shell

2001年《程序员》合订本上有范例！

说实话，这个还真没有试验过，这也是属于Shell扩展的范畴，下面转贴一篇文章吧，这个
问题Hubdog绝对知道，你可以指明到OLE Automation版叫他来回答。

-------------------------------------------------------------------------------
利用COM技术实现外壳扩展的属性页

当用户在资源管理器中调用右键菜单时，会显示一个"属性"菜单
项，点击属性菜单项会显示一个属性页，用户可以获得甚至修改文
件信息。我们可以定制属性页通过实现属性页扩展。如下图所示，
本文实现了一个显示wave（波形）文件的信息如声道数等信息的属
性页扩展。

属性页扩展通常是同某类文件相关联的来实现同之相关的操作和信
息显示，另外可以同驱动器相关联，我们还可以用属性页扩展来替
换控制面板程序的属性页。象其他外壳扩展程序一样，属性页扩展
也是以动态连接库形式实现的进程内COM对象。它除了IUnknown接口
外还要实现IShellExtInit和IShellPropSheetExt接口。

建立同文件关联的属性页扩展

首先，我们用命令File|New...，创建一个ActiveX Library，然后
新建一个COM Object，实现的接口为IShellExtInit和
IShellPropSheetExt。

同文件建立关联需要注册属性页，要在注册表中同相应文件对应的
表项下添加Shellex/PropertySheetHandlers子键 ，每增加一个页
面就需要注册一个表项，最大可以添加的页面数是24，我们可以用
一个扩展实现多个页面。这里我们通过从TComObjectFactory继承类
实现的UpdateRegistry实现了注册。


type
TCXPropSheetFactory=class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;

procedure TCXPropSheetFactory.UpdateRegistry(Register:
Boolean);
var
ClassID: string;
Str,KeyName : string;
begin
inherited UpdateRegistry(Register);
if Register then
begin
ClassID:=GUIDToString(Class_CXPropSheet);
with TRegistry.Create do
try
RootKey:=HKEY_CLASSES_ROOT;
OpenKey('/.wav',TRUE);
KeyName := ReadString('');
if Keyname = '' then
begin
WriteString('','WaveFile');
OpenKey('/.wav',TRUE);
KeyName := ReadString('');
end;
OpenKey('/'+KeyName+'/shellex/PropertySheetHandlers/Wav',TR
UE);
WriteString('',Classid);
finally
Free;
end;

if(Win32Platform=VER_PLATFORM_WIN32_NT)then
begin
with TRegistry.Create do
try
RootKey:=HKEY_LOCAL_MACHINE;
OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Shell
Extensions', True);
OpenKey('Approved', True);
WriteString(ClassID, 'Wave File Property Sheet');
finally
Free;
end;
end;
end
else
删除注册表项.......................
end;
初始化扩展是通过IShellExtInit实现的，当外壳调用
IShellExtInit.Initialize时，它传递一个数据对象包含来文件对
应的目录的PIDL标识符。Initialize方法需要从数据对象中提取文
件名，并把文件名和PIDL标识符保存起来为了以后使用。


function TCXPropSheet.SEIInitialize(pidlFolder:
PItemIDList;
lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
var
StgMedium: TStgMedium;
FormatEtc: TFormatEtc;
szFile: array[0..MAX_PATH+1]of Char;
filecount: integer;
begin

Result:=E_FAIL;

if(lpdobj=nil)then begin
Result:=E_INVALIDARG;
messagebox(0, '1', '错误', mb_ok);
Exit;
end;

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;

// 如果只有一个文件被选中，获得文件名并保存。
filecount:=DragQueryFile(stgmedium.hGlobal, $FFFFFFFF, nil,
0);
if filecount=1 then begin
Result:=NOERROR;
DragQueryFile(stgmedium.hGlobal, 0, szFile,
SizeOf(szFile));
FFilename:=strpas(szFile);
end;
ReleaseStgMedium(StgMedium);
end;
添加页面的操作是通过IShellPropSheetExt接口来实现的。如果属
性页是和文件相关联，外壳会调用 IShellPropSheetExt.AddPages
给属性页添加一个页面。如果属性页同控制面板程序相关联，外壳
调用 IShellPropSheetExt.ReplacePage来替换页面。

IShellPropSheetExt.AddPages方法有两个参数，lpfnAddPage是一
个指向AddPropSheetPageProc 回调函数的指针，回调函数用来提供
要添加的页面信息给外壳。lParam是一个用户自定义的值，这里我
们用它来返回给回调函数对象。

一般的IShellPropSheetExt.AddPages方法实现步骤是：

给PROPSHEETPAGE结构设定正确的值，特别是：
把扩展的对象引用记数变量付值给pcRefParent成员，这可以防止页
面还在显示时，扩展对象被卸载。
实现 PropSheetPageProc 回调函数来处理页面创建和销毁的情况。
调用CreatePropertySheetPage函数来创建页面。
调用lpfnAddPage指向的函数来来添加创建好的页面。

function TCXPropSheet.AddPages(lpfnAddPage:
TFNADDPROPSHEETPAGE;
lParam: LPARAM): HResult;
var
PSP: TPropSheetPage;
HPSP: HPropSheetPage;
begin
result:=E_FAIL;
try
psp.dwSize:=SizeOf(psp);

psp.dwFlags:=PSP_USEREFPARENT or PSP_USETITLE or
PSP_USECALLBACK;
psp.hInstance:=hInstance;
//这里我们使用了事先储存在wave.res中的对话框模板,模板是用
delphi5自带的
//resource workshop编辑的，使用delphi5/bin/brcc32.exe编译
的。
psp.pszTemplate:=MakeIntResource(100);
//标题名
psp.pszTitle:='波文件信息';
//设定回调函数
psp.pfnDlgProc:=@DialogProc;
psp.pfnCallBack:=@PropCallback;
//设定对象引用记数变量
psp.pcRefParent:=@comserver.objectcount;

//用lParam向回调函数传递对象
psp.lParam:=integer(self);

HPSP:=CreatePropertySheetPage(psp);
if HPSP＜＞nil then begin
if not lpfnAddPage(HPSP, lParam)then begin
DestroyPropertySheetPage(HPSP);
end else begin
_addref;//增加引用记数，否则一脱离这个方法的作用域，delphi
自动释放对象。
result:=S_OK;
end
end
except
on e: exception do begin
e.message:='添加页面 '+e.message;
messagebox(0, pchar(e.message), '错误', mb_ok);
end;
end;
end;

function TCXPropSheet.ReplacePage(uPageID: UINT;
lpfnReplaceWith: TFNADDPROPSHEETPAGE; lParam: LPARAM):
HResult;
begin
Result:=E_NOTIMPL;//同文件关联时，外壳不调用ReplacePage,所
以不用实现
end;
回调函数处理属性页的消息，主要要响应WM_INITDIALOG消息来初始
化页面显示信息，响应WM_COMMAND消息来处理用户交互，响应
WM_NOTIFY消息来处理页面切换或关闭后处理操作结果。


function DialogProc(hwndDlg: HWnd; Msg: UINT; wParam:
wParam;
lParam: LPARAM): Bool; stdcall;
var
PageObj: TCXPropSheet;
filename: string;
displayName : string;
buffer: array[0..255]of char;
SheetHWnd: HWnd;
begin
result:=false;
try
if Msg=WM_INITDIALOG then begin//初始化界面

//获得lparam传递过来的对象
pageObj:=TCXPropSheet(PPropSheetPage(lParam)^.lParam);
//保存对象信息
SetWindowLong(hwndDlg, DWL_USER, integer(pageObj));
//设置界面显示波文件信息
SetDlgItemText(hwndDlg, 100, PChar(ExtractFileName(PageObj.
FFileName)));
OpenMedia(PageObj.FFileName);
SetDlgItemText(hwndDlg, 101,
PChar(IntToStr(GetWavStatus(MCI_WAVE_STATUS_AVGBYTESPERSEC)
)));
SetDlgItemText(hwndDlg, 102,
PChar(IntToStr(GetWavStatus(MCI_WAVE_STATUS_BITSPERSAMPLE))
));
SetDlgItemText(hwndDlg, 103,
PChar(IntToStr(GetWavStatus(MCI_WAVE_STATUS_CHANNELS))));
CloseMedia;
SetWindowLong(hwndDlg, DWL_MSGRESULT, 0);
Result:=TRUE;
end
else if(Msg=WM_COMMAND)then begin
if Lo(wParam)=110 then//用户点击了关于按钮(id=110)
MessageBox(0,'作者:hubdog'+#13#10+'email:hubdog@263.net','
关于...',MB_OK);
end else if(msg=WM_NOTIFY)then begin
sheetHwnd:=getparent(hwndDlg);//获得属性页的窗口句柄
case PNMHdr(lparam)^.code of
//页面失去焦点
PSN_KILLACTIVE:begin
SetWindowLong(hwndDlg, DWL_MSGRESULT, 0);
Result:=TRUE;
end;
end;
end;
except
on e: exception do begin
e.message:='回调处理'+e.message;
messagebox(0, pchar(e.message), '错误', mb_ok);
end;
end;
end;

謝謝DragonPc,我下線看看再説

有范例包吗，DragonPC?
请发一份，谢谢
Laban.Zhang@263.net

《Delphi Com深入程序》一书中有详细介绍和例程，去年《程序员》的某一期也有VC的例子，
《程序员》有上年的电子版的，要不要？

Writer, 能发给我吗？谢谢

To dragonpc:
; 我做的contextmenu依然没有图标，为什么？
我在资源里编译了ICON1 ICON 1.ICO 700多字节
在Insertmenu后面SetMenuItemBitmap时loadbitmap
依然没有图标
是不是Loadbitmap只能装bitmap,不能装Icon
那透部分怎么办？
啊，不要说一定要接管OwnerDraw啊，死啦

给contextmenu加上图标？
好，看在你给了那么多分的份上，给我一点时间，我试试先