吴
吴下阿蒙
Unregistered / Unconfirmed
GUEST, unregistred user!
http://www.ccidnet.com/html/tech/guide/2001/09/29/58_3373.html
(文:Binh Ly 安富国编译 2001年09月29日 15:29)
经过前文所述的注册过程后,下面让我们以Delphi为例,开始具体的编程工作。
文件系统插件的实现
在Delphi里,为了创建一个in-process (DLL) COM服务器工程,我们从菜单File|New的对话框的ActiveX页选择ActiveX Library,取名“FileSystemPlugin”,Delphi将会生成一个FileSystemPlugin.dll文件做为我们的插件服务器。
然后要建立我们的插件coclass。选择File|New ,从对话框ActiveX页上选COM Object,在新对话框里,为它取名“FileSystemExplorable”,新的模块以FileSystemExplorable.pas的名字保存。
用Delphi 4/5生成,要确保取消“Include Type Library复选框的选中状态。这是因为我们只是简单地建立一个轻量级的COM对象,而不需要任何其它东西进入类型库。
经过前面的步骤,Delphi产生了一个轻量级的COM对象:
type
TFileSystemExplorable = class (TComObject)
end;
const
Class_FileSystemExplorable: TGUID = '{8B9A0689-7434-11D3-A802-0000B4552A26}';
因为我们正在建立一个插件,我们希望FileSystemExplorable实现IExplorable插件接口。为此,我们为TFileSystemExplorable 手工加上IExplorable:
type
TFileSystemExplorable = class(TComObject, IExplorable)
protected
//IExplorable 方法
function SetExplorer(const Explorer: IExplorer): HResult;
stdcall;
function GetDescription(out Description: WideString): HResult;
stdcall;
function GetSubItems(const Path: WideString;
out SubItems: ISubItems): HResult;
stdcall;
function GetMenuActions(const Path: WideString;
out Actions: OleVariant): HResult;
stdcall;
functiondo
MenuAction(const Path: WideString;
ActionId: Integer): HResult;
stdcall;
function GetProperties(const Path: WideString;
out Properties: OleVariant): HResult;
stdcall;
protected
FExplorer : IExplorer;
end;
接下来是实现它们。以SetExplorer and GetDescription为例:
function TFileSystemExplorable.SetExplorer (const Explorer: IExplorer): HResult;
begin
FExplorer := Explorer;
//FExplorer是TFileSystemExplorable的成员
Result := S_OK;
end;
function TFileSystemExplorable.GetDescription (out Description: WideString): HResult;
begin
Description := 'File System (Delphi version)';
Result := S_OK;
end;
一点也不复杂,是不是?下面看看GetSubItems。
记住,GetSubItems将由万能浏览器调用以取得任意结点的子项(由ISubItems接口枚举)。这意味着我们要用函数FindFirst和FindNext扫描文件夹(由node/path指定)。我们把这些操作封装进TSubItems类:
type
TSubItems = class (TInterfacedObject)
protected
FSubItems : TStringList;
procedure LoadSubItems (const Path : string);
procedure LoadDrives;
procedure LoadFiles (Path : string);
public
constructor Create (const Path : string);
end;
constructor TSubItems.Create(const Path: string);
begin
inherited Create;
FSubItems := TStringList.Create;
LoadSubItems (Path);
// 把所有Path下的文件和文件夹放入FSubItems
end;
... 以下部分略 ...
//根据给定的路径Path装入文件系统的一个分枝
procedure TSubItems.LoadSubItems(const Path: string);
begin
//reset list
FSubItems.Clear;
//如果Path是根,那么装入所有驱动器否则把Path做为文件夹装入
if (Path = '') then
LoadDrives
else
LoadFiles (Path);
end;
//把系统驱动器装入FSubItems列表
procedure TSubItems.LoadDrives;
begin
//以下是伪码实现
Find all drives;
For each drive found
Add drive name into FSubItems list;
end;
//把文件夹中的文件及子文件夹装入FSubItems列表
procedure TSubItems.LoadFiles(Path: string);
begin
//伪码实现
Find all files (and folders) under Path (using FindFirst/FindNext)
For each file (and folder) found
Add file name into FSubItems list;
end;
这里最重要的方法是LoadSubItems,如果Path为空,那么我们装入您系统中的所有驱动器,否则只需使用FindFirst与FindNext找齐指定路径下的所有文件。
由于FileSystemExplorable必须把ISubItems 交给万能浏览器,我们简单地TSubItems里实现ISubItems:
type
TSubItems = class (TInterfacedObject, ISubItems)
protected
//ISubItems方法
function GetCount(out Count: Integer): HResult;
stdcall;
function GetItem(Index: Integer;
out Item: WideString): HResult;
stdcall;
protected
FSubItems : TStringList;
...
end;
//返回子项个数
function TSubItems.GetCount(out Count: Integer): HResult;
begin
Count := FSubItems.Count;
Result := S_OK;
end;
//返回对应Index的一个子项
function TSubItems.GetItem(Index: Integer;
out Item: WideString): HResult;
begin
Item := FSubItems [Index];
Result := S_OK;
end;
最后,我们回到TFileSystemExplorable并实现GetSubItems:
function TFileSystemExplorable.GetSubItems(const Path: WideString;
out SubItems: ISubItems): HResult;
begin
//要求TSubItems返回一个指定path的子项列表
SubItems := TSubItems.Create (Path);
Result := S_OK;
end;
下面实现GetProperties。如果您还记得,万能浏览器调用GetProperties来得到任意结点的以名/值对表达的结点信息。在COM中,我们只需使用可变数组即可实现:
function TFileSystemExplorable.GetProperties(const Path: WideString;
out Properties: OleVariant): HResult;
begin
Result := S_OK;
//Properties 是一个二维数组:
//
// | Property Name 1 | Property Value 1 |
// | Property Name 2 | Property Value 2 |
//
Properties := VarArrayCreate ([
0, 4, //行范围
0, 1 //列范围
],
varOleStr //数组成员是字符串
);
//类型(Type): 文件还是文件夹?
Properties [0, 0] := 'Type';
if IsFolder (Path) then
Properties [0, 1] := 'Folder' // 文件夹
else
Properties [0, 1] := 'File';
// 文件
//文件名
Properties [1, 0] := 'Name';
Properties [1, 1] := NameOfFile (Path);
//文件大小
Properties [2, 0] := 'Size';
Properties [2, 1] := IntToStr (SizeOfFile (Path));
//文件日期
Properties [3, 0] := 'Date/Time';
Properties [3, 1] := DateTimeToStr (DateTimeOfFile (Path));
//文件属性
Properties [4, 0] := 'Attributes';
Properties [4, 1] := AttributesOfFile (Path);
end;
我们做的只是简单地返回一个二维可变数组(从0到4共有5行)包含下面的文件属性:文件类型、文件名、文件大小、文件日期及文件属性。具体细节请见源代码。
最后还应实现的是GetMenuActions和DoMenuAction。(由于篇幅所限,这里不再介绍,详见源码。)
这两个方法可以在您的层次结构中的任意结点上实现上下文相关的自定义的操作。GetMenuActions返回给万能浏览器一个包含“动作-ID”值的数组,DoMenuAction执行用户选定的动作(Action)。
我们这里仅仅实现一个动作-文件改名,为安全起见当文件除“存档位”之外的其它属性位有值时不允许文件改名操作:
const ACTION_RENAME = 1;
function TFileSystemExplorable.GetMenuActions(const Path: WideString;
out Actions: OleVariant): HResult;
var
ActionCount : integer;
begin
Result := S_OK;
//ActionCount展示了怎样根据上下文动态生成菜单项
ActionCount := 0;
//菜单动作(Actions)是一个二维数组
//
// | 动作名1 | 动作ID1 |
// | 动作名2 | 动作ID2 |
//
Actions := VarArrayCreate ([
0, 0, //行范围
0, 1 //列范围
],
varVariant //可变的元素
);
//改名
//文件只有存档位被置位时才允许改名
if (FileOnlyHasArchiveAttributeSet (Path)) then
begin
//增加改名动作(Rename Action)
Actions [ActionCount, 0] := 'Rename';
Actions [ActionCount, 1] := ACTION_RENAME;
//这是一个整型常量,值为1
//one action in!
inc (ActionCount);
end;
//这里您可以自行定义更多内容...
//如果Actions中没有内容,清除它
if (ActionCount <= 0) then
Actions := Unassigned;
end;
我们简单地建立了一个二维数组保存“动作-ID”值。由于我们只实现了一个改名动作,所以数组中只包含了一行内容(行范围是0到0)。
每当万能浏览器得到它的动作列表,它会产生相应的上下文相关的弹出菜单。随后,如果用户选择了“改名”动作,万能浏览器会通过给插件传递一个ACTION_RENAME常量来调用插件中的DoMenuAction动作。下面即是插件中实现DoMenuAction动作完成改名的部分:
function TFileSystemExplorable.DoMenuAction(const Path: WideString;
ActionId: Integer): HResult;
var
NewName : string;
begin
Result := S_OK;
case ActionID of
ACTION_RENAME :
//文件改名
if (TfrmRename.Rename (Path, NewName)) then
//如果改名成功,给万能浏览器主程序发送一个通知
FExplorer.RenamePath (Path, NewName);
//如果还有其它动作,在这里实现...
end;
end;
这里,我们首先检查ActionID参数并对ACTION——RENAME动作进行响应。对于ACTION_RENAME,我们只是简单地打开一个窗体(TfrmRename),允许用户为文件输入新名字。 如果改名成功的话,就调用FExplorer.RenamePath告诉万能浏览器主程序有一个结点已经改名,主程序会及时地更新它的用户界面以反映这种改变。
这是一个插件如何和它的主程序进行回调的示例。通常,这么做是必需的,因为主程序和插件需要同步更新它们共同拥有的数据。
最后一件事就是以某种方式为我们的插件服务器注册及注销组件目录。最容易的办法是每当注册了我们的插件时,我们也一同注册目录信息,注销插件的同时注销目录信息。对于DLL服务器来说,相应的注册和注销入口是下面的两个公布的函数:DLLRegisterServer(注册)与DLLUnregisterServer(注销)。
先看一下注册过程:
In FileSystemPlugin.dpr
library FileSystemPlugin;
//overidden to include categories registration
function DllRegisterServer: HResult;
stdcall;
begin
//调用缺省例程
Result := ComServ.DllRegisterServer;
//注册为浏览插件
RegisterAsExplorableClass (Class_FileSystemExplorable, True);
//True即注册
end;
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
...
我们对DLLRegisterServer使用了“overriding”技术保证了同时执行目录注册过程RegisterAsExplorableClass。(RegisterAsExplorableClass的具体实现略)
//注册一个指定的类作为一个explorable服务器
procedure RegisterAsExplorableClass (const CLSID : TCLSID;
Register : boolean);
var
CatReg : ICatRegister;
begin
CatReg := StdComponentCategoryMgr as ICatRegister;
if (Register) then
begin
//先注册CATID_Explorable目录
//ExplorableCategoryInfo中放的内容在前面已经讨论过
OleCheck (CatReg.RegisterCategories (1, @ExplorableCategoryInfo));
//然后注册支持这个目录的CLSID
OleCheck (CatReg.RegisterClassImplCategories (CLSID, 1, @ExplorableCategoryInfo));
end
else
begin
//这里是注销部分
end;
end;
//返回标准组件目录管理器
function StdComponentCategoryMgr : IUnknown;
begin
Result := CreateComObject (CLSID_StdComponentCategoryMgr);
end;
我们在这里做的只不过是注册“Explorable Plugins”目录,及注册实现这一目录的FileSystemExplorable的coclass。该讨论的前面已经讲过了。
注册过程同样照此办理:
In FileSystemPlugin.dpr
library FileSystemPlugin;
//重载以实现目录的注销
function DllUnregisterServer: HResult;
stdcall;
begin
//注销万能浏览器的插件
RegisterAsExplorableClass (Class_FileSystemExplorable, False);
//False表示注销
//返回缺省的注销句柄
Result := ComServ.DllUnregisterServer;
end;
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
...
相应的,RegisterAsExplorableClass的注销部分定义如下:
//注册一个指定的类作为一个explorable服务器
procedure RegisterAsExplorableClass (const CLSID : TCLSID;
Register : boolean);
var
CatReg : ICatRegister;
begin
CatReg := StdComponentCategoryMgr as ICatRegister;
if (Register) then
begin
//这里是注册部分
end
else
begin
//注意:我们不能注销CATID_Explorable,因为其它服务器可能仍在用它!
//注销支持这个目录的CLSID
OleCheck (CatReg.UnregisterClassImplCategories (CLSID, 1, @ExplorableCategoryInfo));
DeleteRegKey ('CLSID/' + GuidToString (CLSID) + '/' + 'Implemented Categories');
end;
end;
//返回标准组件目录管理器
function StdComponentCategoryMgr : IUnknown;
begin
Result := CreateComObject (CLSID_StdComponentCategoryMgr);
end;
注意我们额外地调用了DeleteRegKey删除“Implemented Categories”子键,从而完全地从注册表中删除我们的coclass。
另一个注册目录信息的方法是建立自己的定制的类代理(class factory),它继承自TComObjectFactory 。TComObjectFactory有一个虚拟方法UpdateRegistry,可以通过重载实现自定义的注册和注销动作。
万能浏览器主程序的实现
随着插件的完工(一定不要忘记注册您的插件),现在到了主程序部分。如前所述,我们的万能浏览器主程序是一个MDI程序,每个MDI子窗口掌管着一个浏览插件。作为实现,当万能浏览器加载时,它寻找所有注册过的浏览插件并把它们放到一个菜单列表里。用户从菜单中选择任何一个插件项目,我们将打开一个MDI子窗体(TfrmExplorerHost)并把选中的插件纳入窗体。
图:“Explorable Plugins”菜单包括了已注册的插件的列表
我们简单地使用前面提到的COM组件目录设备来取得可用的插件,具体说来,是用到了ICatInformation。实现方法略。
procedure TfrmMain.LoadExplorableClasses;
var
Count, i : integer;
Explorable : IExplorable;
Description : widestring;
MenuItem : TMenuItem;
begin
//取得explorable服务器列表
//FExplorableClasses是一个CLSID数组
Count := GetExplorableClasses (FExplorableClasses);
if (Count > 0) then
begin
//取得每一个公布的插件描述并放入子菜单
for i := 1 to Countdo
begin
//创建Explorable插件
Explorable := CreateComObject (FExplorableClasses ) as IExplorable;
//取得插件描述
OleCheck (Explorable.GetDescription (Description));
//创建一个新菜单项
MenuItem := TMenuItem.Create (Self);
MenuItem.Caption := Description;
//把FExplorableClasses数组的索引放入Tag属性
MenuItem.Tag := i;
//放入菜单中
miExplore.Add (MenuItem);
end;
end;
end;
这段代码取得所有可用coclass的CLSID放入FExplorableClasses数组,然后取得数组中每个插件的描述放入一个菜单列表。
以下是一个真正的GetExplorableClasses:
type
TExplorableClasses = array [1..50] of TCLSID;
//50足够大了
//返回Explorable 服务器的CLSIDs
function GetExplorableClasses (var ExplorableClasses : TExplorableClasses) : integer;
var
CatInfo : ICatInformation;
Enum : IEnumGuid;
Fetched : UINT;
begin
Result := 0;
//得到标准目录信息管理器
CatInfo := StdComponentCategoryMgr as ICatInformation;
//取得所有已注册的Explorable类
//ExplorableCategoryInfo中的内容前面已经讨论过
OleCheck (CatInfo.EnumClassesOfCategories (1, @ExplorableCategoryInfo, 0, NIL, Enum));
//把Explorable类放入ExplorableClasses数组
if (Enum <> NIL) then
begin
OleCheck (Enum.Reset);
//填充ExplorableClasses数组
//注意如果Fetched >= High (ExplorableClasses),那么可能还有!
//但对于我们的目的来说,这么简单的代码就够了
OleCheck (Enum.Next (High (ExplorableClasses), ExplorableClasses [1], Fetched));
Result := Fetched;
end;
end;
前面讲过,ICatInformation.EnumClassesOfCategories用来取得所有实现一个指定目录的coclass,然后重复产生与所有匹配CLSID相应的数组。
到此为止,我们已经取得了所有可用的插件并把它们放进菜单。当用户选择了其中的一个时,我们取得选中的插件的coclass,然后把插件装入万能浏览器的主窗体。实现部分略。
//用户从主菜单中选择了一个插件时调用
procedure TfrmMain.miExplorableItemClick(Sender: TObject);
var
ExplorableClass : TCLSID;
Explorable : IExplorable;
begin
//取得选中的Explorable类
//Tag属性包含着FExplorableClasses数组的序号
ExplorableClass := FExplorableClasses [(Sender as TMenuItem).Tag];
//创建Explorable插件
Explorable := CreateComObject (ExplorableClass) as IExplorable;
//往一个新的explorer主窗体中调入Explorable服务器
TfrmExplorerHost.Load (Explorable);
end;
这段程序取得选取的菜单项对应的插件coclass。然后我们把新插件加载到万能浏览器的主窗体。
万能浏览器的主窗体分为两个部分:左边是TreeView目录树(tvwExplorer),右边是ListView列表项(lvwProperties)。目录树显示插件的层次结构,当选中一个树结点时列表项显示它的属性。对FileSystemPlugin来说,目录树显示了您的文件系统的结构图而列表项显示文件属性(文件名、文件大小等)。如图:
(文:Binh Ly 安富国编译 2001年09月29日 15:29)
经过前文所述的注册过程后,下面让我们以Delphi为例,开始具体的编程工作。
文件系统插件的实现
在Delphi里,为了创建一个in-process (DLL) COM服务器工程,我们从菜单File|New的对话框的ActiveX页选择ActiveX Library,取名“FileSystemPlugin”,Delphi将会生成一个FileSystemPlugin.dll文件做为我们的插件服务器。
然后要建立我们的插件coclass。选择File|New ,从对话框ActiveX页上选COM Object,在新对话框里,为它取名“FileSystemExplorable”,新的模块以FileSystemExplorable.pas的名字保存。
用Delphi 4/5生成,要确保取消“Include Type Library复选框的选中状态。这是因为我们只是简单地建立一个轻量级的COM对象,而不需要任何其它东西进入类型库。
经过前面的步骤,Delphi产生了一个轻量级的COM对象:
type
TFileSystemExplorable = class (TComObject)
end;
const
Class_FileSystemExplorable: TGUID = '{8B9A0689-7434-11D3-A802-0000B4552A26}';
因为我们正在建立一个插件,我们希望FileSystemExplorable实现IExplorable插件接口。为此,我们为TFileSystemExplorable 手工加上IExplorable:
type
TFileSystemExplorable = class(TComObject, IExplorable)
protected
//IExplorable 方法
function SetExplorer(const Explorer: IExplorer): HResult;
stdcall;
function GetDescription(out Description: WideString): HResult;
stdcall;
function GetSubItems(const Path: WideString;
out SubItems: ISubItems): HResult;
stdcall;
function GetMenuActions(const Path: WideString;
out Actions: OleVariant): HResult;
stdcall;
functiondo
MenuAction(const Path: WideString;
ActionId: Integer): HResult;
stdcall;
function GetProperties(const Path: WideString;
out Properties: OleVariant): HResult;
stdcall;
protected
FExplorer : IExplorer;
end;
接下来是实现它们。以SetExplorer and GetDescription为例:
function TFileSystemExplorable.SetExplorer (const Explorer: IExplorer): HResult;
begin
FExplorer := Explorer;
//FExplorer是TFileSystemExplorable的成员
Result := S_OK;
end;
function TFileSystemExplorable.GetDescription (out Description: WideString): HResult;
begin
Description := 'File System (Delphi version)';
Result := S_OK;
end;
一点也不复杂,是不是?下面看看GetSubItems。
记住,GetSubItems将由万能浏览器调用以取得任意结点的子项(由ISubItems接口枚举)。这意味着我们要用函数FindFirst和FindNext扫描文件夹(由node/path指定)。我们把这些操作封装进TSubItems类:
type
TSubItems = class (TInterfacedObject)
protected
FSubItems : TStringList;
procedure LoadSubItems (const Path : string);
procedure LoadDrives;
procedure LoadFiles (Path : string);
public
constructor Create (const Path : string);
end;
constructor TSubItems.Create(const Path: string);
begin
inherited Create;
FSubItems := TStringList.Create;
LoadSubItems (Path);
// 把所有Path下的文件和文件夹放入FSubItems
end;
... 以下部分略 ...
//根据给定的路径Path装入文件系统的一个分枝
procedure TSubItems.LoadSubItems(const Path: string);
begin
//reset list
FSubItems.Clear;
//如果Path是根,那么装入所有驱动器否则把Path做为文件夹装入
if (Path = '') then
LoadDrives
else
LoadFiles (Path);
end;
//把系统驱动器装入FSubItems列表
procedure TSubItems.LoadDrives;
begin
//以下是伪码实现
Find all drives;
For each drive found
Add drive name into FSubItems list;
end;
//把文件夹中的文件及子文件夹装入FSubItems列表
procedure TSubItems.LoadFiles(Path: string);
begin
//伪码实现
Find all files (and folders) under Path (using FindFirst/FindNext)
For each file (and folder) found
Add file name into FSubItems list;
end;
这里最重要的方法是LoadSubItems,如果Path为空,那么我们装入您系统中的所有驱动器,否则只需使用FindFirst与FindNext找齐指定路径下的所有文件。
由于FileSystemExplorable必须把ISubItems 交给万能浏览器,我们简单地TSubItems里实现ISubItems:
type
TSubItems = class (TInterfacedObject, ISubItems)
protected
//ISubItems方法
function GetCount(out Count: Integer): HResult;
stdcall;
function GetItem(Index: Integer;
out Item: WideString): HResult;
stdcall;
protected
FSubItems : TStringList;
...
end;
//返回子项个数
function TSubItems.GetCount(out Count: Integer): HResult;
begin
Count := FSubItems.Count;
Result := S_OK;
end;
//返回对应Index的一个子项
function TSubItems.GetItem(Index: Integer;
out Item: WideString): HResult;
begin
Item := FSubItems [Index];
Result := S_OK;
end;
最后,我们回到TFileSystemExplorable并实现GetSubItems:
function TFileSystemExplorable.GetSubItems(const Path: WideString;
out SubItems: ISubItems): HResult;
begin
//要求TSubItems返回一个指定path的子项列表
SubItems := TSubItems.Create (Path);
Result := S_OK;
end;
下面实现GetProperties。如果您还记得,万能浏览器调用GetProperties来得到任意结点的以名/值对表达的结点信息。在COM中,我们只需使用可变数组即可实现:
function TFileSystemExplorable.GetProperties(const Path: WideString;
out Properties: OleVariant): HResult;
begin
Result := S_OK;
//Properties 是一个二维数组:
//
// | Property Name 1 | Property Value 1 |
// | Property Name 2 | Property Value 2 |
//
Properties := VarArrayCreate ([
0, 4, //行范围
0, 1 //列范围
],
varOleStr //数组成员是字符串
);
//类型(Type): 文件还是文件夹?
Properties [0, 0] := 'Type';
if IsFolder (Path) then
Properties [0, 1] := 'Folder' // 文件夹
else
Properties [0, 1] := 'File';
// 文件
//文件名
Properties [1, 0] := 'Name';
Properties [1, 1] := NameOfFile (Path);
//文件大小
Properties [2, 0] := 'Size';
Properties [2, 1] := IntToStr (SizeOfFile (Path));
//文件日期
Properties [3, 0] := 'Date/Time';
Properties [3, 1] := DateTimeToStr (DateTimeOfFile (Path));
//文件属性
Properties [4, 0] := 'Attributes';
Properties [4, 1] := AttributesOfFile (Path);
end;
我们做的只是简单地返回一个二维可变数组(从0到4共有5行)包含下面的文件属性:文件类型、文件名、文件大小、文件日期及文件属性。具体细节请见源代码。
最后还应实现的是GetMenuActions和DoMenuAction。(由于篇幅所限,这里不再介绍,详见源码。)
这两个方法可以在您的层次结构中的任意结点上实现上下文相关的自定义的操作。GetMenuActions返回给万能浏览器一个包含“动作-ID”值的数组,DoMenuAction执行用户选定的动作(Action)。
我们这里仅仅实现一个动作-文件改名,为安全起见当文件除“存档位”之外的其它属性位有值时不允许文件改名操作:
const ACTION_RENAME = 1;
function TFileSystemExplorable.GetMenuActions(const Path: WideString;
out Actions: OleVariant): HResult;
var
ActionCount : integer;
begin
Result := S_OK;
//ActionCount展示了怎样根据上下文动态生成菜单项
ActionCount := 0;
//菜单动作(Actions)是一个二维数组
//
// | 动作名1 | 动作ID1 |
// | 动作名2 | 动作ID2 |
//
Actions := VarArrayCreate ([
0, 0, //行范围
0, 1 //列范围
],
varVariant //可变的元素
);
//改名
//文件只有存档位被置位时才允许改名
if (FileOnlyHasArchiveAttributeSet (Path)) then
begin
//增加改名动作(Rename Action)
Actions [ActionCount, 0] := 'Rename';
Actions [ActionCount, 1] := ACTION_RENAME;
//这是一个整型常量,值为1
//one action in!
inc (ActionCount);
end;
//这里您可以自行定义更多内容...
//如果Actions中没有内容,清除它
if (ActionCount <= 0) then
Actions := Unassigned;
end;
我们简单地建立了一个二维数组保存“动作-ID”值。由于我们只实现了一个改名动作,所以数组中只包含了一行内容(行范围是0到0)。
每当万能浏览器得到它的动作列表,它会产生相应的上下文相关的弹出菜单。随后,如果用户选择了“改名”动作,万能浏览器会通过给插件传递一个ACTION_RENAME常量来调用插件中的DoMenuAction动作。下面即是插件中实现DoMenuAction动作完成改名的部分:
function TFileSystemExplorable.DoMenuAction(const Path: WideString;
ActionId: Integer): HResult;
var
NewName : string;
begin
Result := S_OK;
case ActionID of
ACTION_RENAME :
//文件改名
if (TfrmRename.Rename (Path, NewName)) then
//如果改名成功,给万能浏览器主程序发送一个通知
FExplorer.RenamePath (Path, NewName);
//如果还有其它动作,在这里实现...
end;
end;
这里,我们首先检查ActionID参数并对ACTION——RENAME动作进行响应。对于ACTION_RENAME,我们只是简单地打开一个窗体(TfrmRename),允许用户为文件输入新名字。 如果改名成功的话,就调用FExplorer.RenamePath告诉万能浏览器主程序有一个结点已经改名,主程序会及时地更新它的用户界面以反映这种改变。
这是一个插件如何和它的主程序进行回调的示例。通常,这么做是必需的,因为主程序和插件需要同步更新它们共同拥有的数据。
最后一件事就是以某种方式为我们的插件服务器注册及注销组件目录。最容易的办法是每当注册了我们的插件时,我们也一同注册目录信息,注销插件的同时注销目录信息。对于DLL服务器来说,相应的注册和注销入口是下面的两个公布的函数:DLLRegisterServer(注册)与DLLUnregisterServer(注销)。
先看一下注册过程:
In FileSystemPlugin.dpr
library FileSystemPlugin;
//overidden to include categories registration
function DllRegisterServer: HResult;
stdcall;
begin
//调用缺省例程
Result := ComServ.DllRegisterServer;
//注册为浏览插件
RegisterAsExplorableClass (Class_FileSystemExplorable, True);
//True即注册
end;
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
...
我们对DLLRegisterServer使用了“overriding”技术保证了同时执行目录注册过程RegisterAsExplorableClass。(RegisterAsExplorableClass的具体实现略)
//注册一个指定的类作为一个explorable服务器
procedure RegisterAsExplorableClass (const CLSID : TCLSID;
Register : boolean);
var
CatReg : ICatRegister;
begin
CatReg := StdComponentCategoryMgr as ICatRegister;
if (Register) then
begin
//先注册CATID_Explorable目录
//ExplorableCategoryInfo中放的内容在前面已经讨论过
OleCheck (CatReg.RegisterCategories (1, @ExplorableCategoryInfo));
//然后注册支持这个目录的CLSID
OleCheck (CatReg.RegisterClassImplCategories (CLSID, 1, @ExplorableCategoryInfo));
end
else
begin
//这里是注销部分
end;
end;
//返回标准组件目录管理器
function StdComponentCategoryMgr : IUnknown;
begin
Result := CreateComObject (CLSID_StdComponentCategoryMgr);
end;
我们在这里做的只不过是注册“Explorable Plugins”目录,及注册实现这一目录的FileSystemExplorable的coclass。该讨论的前面已经讲过了。
注册过程同样照此办理:
In FileSystemPlugin.dpr
library FileSystemPlugin;
//重载以实现目录的注销
function DllUnregisterServer: HResult;
stdcall;
begin
//注销万能浏览器的插件
RegisterAsExplorableClass (Class_FileSystemExplorable, False);
//False表示注销
//返回缺省的注销句柄
Result := ComServ.DllUnregisterServer;
end;
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
...
相应的,RegisterAsExplorableClass的注销部分定义如下:
//注册一个指定的类作为一个explorable服务器
procedure RegisterAsExplorableClass (const CLSID : TCLSID;
Register : boolean);
var
CatReg : ICatRegister;
begin
CatReg := StdComponentCategoryMgr as ICatRegister;
if (Register) then
begin
//这里是注册部分
end
else
begin
//注意:我们不能注销CATID_Explorable,因为其它服务器可能仍在用它!
//注销支持这个目录的CLSID
OleCheck (CatReg.UnregisterClassImplCategories (CLSID, 1, @ExplorableCategoryInfo));
DeleteRegKey ('CLSID/' + GuidToString (CLSID) + '/' + 'Implemented Categories');
end;
end;
//返回标准组件目录管理器
function StdComponentCategoryMgr : IUnknown;
begin
Result := CreateComObject (CLSID_StdComponentCategoryMgr);
end;
注意我们额外地调用了DeleteRegKey删除“Implemented Categories”子键,从而完全地从注册表中删除我们的coclass。
另一个注册目录信息的方法是建立自己的定制的类代理(class factory),它继承自TComObjectFactory 。TComObjectFactory有一个虚拟方法UpdateRegistry,可以通过重载实现自定义的注册和注销动作。
万能浏览器主程序的实现
随着插件的完工(一定不要忘记注册您的插件),现在到了主程序部分。如前所述,我们的万能浏览器主程序是一个MDI程序,每个MDI子窗口掌管着一个浏览插件。作为实现,当万能浏览器加载时,它寻找所有注册过的浏览插件并把它们放到一个菜单列表里。用户从菜单中选择任何一个插件项目,我们将打开一个MDI子窗体(TfrmExplorerHost)并把选中的插件纳入窗体。
图:“Explorable Plugins”菜单包括了已注册的插件的列表
我们简单地使用前面提到的COM组件目录设备来取得可用的插件,具体说来,是用到了ICatInformation。实现方法略。
procedure TfrmMain.LoadExplorableClasses;
var
Count, i : integer;
Explorable : IExplorable;
Description : widestring;
MenuItem : TMenuItem;
begin
//取得explorable服务器列表
//FExplorableClasses是一个CLSID数组
Count := GetExplorableClasses (FExplorableClasses);
if (Count > 0) then
begin
//取得每一个公布的插件描述并放入子菜单
for i := 1 to Countdo
begin
//创建Explorable插件
Explorable := CreateComObject (FExplorableClasses ) as IExplorable;
//取得插件描述
OleCheck (Explorable.GetDescription (Description));
//创建一个新菜单项
MenuItem := TMenuItem.Create (Self);
MenuItem.Caption := Description;
//把FExplorableClasses数组的索引放入Tag属性
MenuItem.Tag := i;
//放入菜单中
miExplore.Add (MenuItem);
end;
end;
end;
这段代码取得所有可用coclass的CLSID放入FExplorableClasses数组,然后取得数组中每个插件的描述放入一个菜单列表。
以下是一个真正的GetExplorableClasses:
type
TExplorableClasses = array [1..50] of TCLSID;
//50足够大了
//返回Explorable 服务器的CLSIDs
function GetExplorableClasses (var ExplorableClasses : TExplorableClasses) : integer;
var
CatInfo : ICatInformation;
Enum : IEnumGuid;
Fetched : UINT;
begin
Result := 0;
//得到标准目录信息管理器
CatInfo := StdComponentCategoryMgr as ICatInformation;
//取得所有已注册的Explorable类
//ExplorableCategoryInfo中的内容前面已经讨论过
OleCheck (CatInfo.EnumClassesOfCategories (1, @ExplorableCategoryInfo, 0, NIL, Enum));
//把Explorable类放入ExplorableClasses数组
if (Enum <> NIL) then
begin
OleCheck (Enum.Reset);
//填充ExplorableClasses数组
//注意如果Fetched >= High (ExplorableClasses),那么可能还有!
//但对于我们的目的来说,这么简单的代码就够了
OleCheck (Enum.Next (High (ExplorableClasses), ExplorableClasses [1], Fetched));
Result := Fetched;
end;
end;
前面讲过,ICatInformation.EnumClassesOfCategories用来取得所有实现一个指定目录的coclass,然后重复产生与所有匹配CLSID相应的数组。
到此为止,我们已经取得了所有可用的插件并把它们放进菜单。当用户选择了其中的一个时,我们取得选中的插件的coclass,然后把插件装入万能浏览器的主窗体。实现部分略。
//用户从主菜单中选择了一个插件时调用
procedure TfrmMain.miExplorableItemClick(Sender: TObject);
var
ExplorableClass : TCLSID;
Explorable : IExplorable;
begin
//取得选中的Explorable类
//Tag属性包含着FExplorableClasses数组的序号
ExplorableClass := FExplorableClasses [(Sender as TMenuItem).Tag];
//创建Explorable插件
Explorable := CreateComObject (ExplorableClass) as IExplorable;
//往一个新的explorer主窗体中调入Explorable服务器
TfrmExplorerHost.Load (Explorable);
end;
这段程序取得选取的菜单项对应的插件coclass。然后我们把新插件加载到万能浏览器的主窗体。
万能浏览器的主窗体分为两个部分:左边是TreeView目录树(tvwExplorer),右边是ListView列表项(lvwProperties)。目录树显示插件的层次结构,当选中一个树结点时列表项显示它的属性。对FileSystemPlugin来说,目录树显示了您的文件系统的结构图而列表项显示文件属性(文件名、文件大小等)。如图: