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);
//overidden to include categories registration
function DllRegisterServer: HResult; stdcall;
begin
//调用缺省例程
Result := ComServ.DllRegisterServer;
//注册为浏览插件
RegisterAsExplorableClass (Class_FileSystemExplorable, True); //True即注册
end;
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;
function DoMenuAction(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;
//根据给定的路径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;
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;
const ACTION_RENAME = 1;
function TFileSystemExplorable.GetMenuActions(const Path: WideString;
out Actions: OleVariant): HResult;
var
ActionCount : integer;
begin
Result := S_OK;