利用Delphi編寫Windows外殼擴展
對于操作系統原理比較了解的朋友都會知道,一個完備的操作系統都會提供了一個外殼(Shell),以方便普通的用戶
使用操作系統提供的各種功能。Windows(在這里指的是Windows 95Windows NT4.0以上版本的操作系統)的外殼不但提供
了方便美觀的GUI圖形界面,而且還提供了強大的外殼擴展功能,大家可能在很多軟件中看到這些外殼擴展了。例如在你的
系統中安裝了Winzip的話,當你在Windows Explore中鼠標右鍵點擊文件夾或者文件后,在彈出菜單中就會出現Winzip的壓
縮菜單。又或者Bullet FTP中在Windows資源管理器中出現的FTP站點文件夾。
Windows支持七種類型的外殼擴展(稱為Handler),它們相應的作用簡述如下:
(1)Context menu handlers:向特定類型的文件對象增添上下文相關菜單;
(2)Drag-and-drop handlers用來支持當用戶對某種類型的文件對象進行拖放操作時的OLE數據傳輸;
(3)Icon handlers用來向某個文件對象提供一個特有的圖標,也可以給某一類文件對象指定圖標;
(4)PRoperty sheet handlers給文件對象增添屬性頁(就是右鍵點擊文件對象或文件夾對象后,在彈出菜單中選屬性
項后出現的對話框),屬性頁可以為同一類文件對象所共有,也可以給一個文件對象指定特有的屬性頁;
(5)Copy-hook handlers在文件夾對象或者打印機對象被拷貝、移動、刪除和重命名時,就會被系統調用,通過為Windows
增加Copy-hook handlers,可以允許或者禁止其中的某些操作;
(6)Drop target handlers在一個對象被拖放到另一個對象上時,就會被系統被調用;
(7)Data object handlers在文件被拖放、拷貝或者粘貼時,就會被系統被調用。
Windows的所有外殼擴展都是基于COM(Component Object Model) 組件模型的,外殼是通過接口(Interface)來訪問對象的。
外殼擴展被設計成32位的進程中服務器程序,并且都是以動態鏈接庫的形式為操作系統提供服務的。因此,如果要對Windows
的用戶界面進行擴充的話,則具備寫COM對象的一些知識是十分必要的。 由于篇幅所限,在這里就不介紹COM,讀者可以參考
微軟的MSDN庫或者相關的幫助文檔,一個接口可以看做是一個特殊的類,它包含一組函數合過程可以用來操作一個對象。
寫好外殼擴展程序后,必須將它們注冊才能生效。所有的外殼擴展都必須在Windows注冊表的HKEY_CLASSES_ROOTCLSID鍵
之下進行注冊。在該鍵下面可以找到許多名字像{0000002F-0000-0000-C000-000000000046}的鍵,這類鍵就是全局唯一類標識
符(Guid)。每一個外殼擴展都必須有一個全局唯一類標識符,Windows正是通過此唯一類標識符來找到外殼擴展處理程序的。
在類標識符之下的InProcServer32子鍵下記錄著外殼擴展動態鏈接庫在系統中的位置。與某種文件類型關聯的外殼擴展注冊在
相應類型的shellex主鍵下。如果所處的Windows操作系統為Windows NT,則外殼擴展還必須在注冊表中的
HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionShellExtensionsApproved主鍵下登記。
編譯完外殼擴展的DLL程序后就可以用Windows本身提供的regsvr32.exe來注冊該DLL服務器程序了。如果使用Delphi,也可
以在Run菜單中選擇Register ActiveX Server來注冊。
下面首先介紹一個比較常用的外殼擴展應用:上下文相關菜單,在Windows中,用鼠標右鍵單擊文件或者文件夾時彈出的那
個菜單便稱為上下文相關菜單。要動態地在上下文相關菜單中增添菜單項,可以通過寫Context Menu Handler來實現。比如大家
所熟悉的WinZip和UltraEdit等軟件都是通過編寫Context Menu Handler來動態地向菜單中增添菜單項的。如果系統中安裝了
WinZip,那么當用右鍵單擊一個名為Windows的文件(夾)時,其上下文相關菜單就會有一個名為Add to Windows.zip的菜單項。
本文要實現的Context Menu Handler與WinZip提供的上下文菜單相似。它將在任意類型的文件對象的上下文相關菜單中添加一個
文件操作菜單項,當點擊該項后,接口程序就會彈出一個文件操作窗口,執行文件拷貝、移動等操作。
編寫Context Menu Handler必須實現IShellExtInit、IContextMenu和TComObjectFactory三個接口。IShellExtInit實現
接口的初始化,IContextMenu接口對象實現上下文相關菜單,IComObjectFactory接口實現對象的創建。
下面來介紹具體的程序實現。首先在Delphi中點擊菜單的 File|New 項,在New Item窗口中選擇DLL建立一個DLL工程文件。
然后點擊菜單的 File|New 項,在New Item窗口中選擇Unit建立一個Unit文件,點擊點擊菜單的 File|New 項,在New Item窗口
中選擇Form建立一個新的窗口。將將工程文件保存為Contextmenu.dpr ,將Unit1保存為Contextmenuhandle.pas,將Form保存為
OpWindow.pas。
Contextmenu.dpr的程序清單如下:
library contextmenu;
uses
ComServ,
contextmenuhandle in 'contextmenuhandle.pas',
opwindow in 'opwindow.pas' {Form2};
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
{$R *.TLB}
{$R *.RES}
begin
end.
Contextmenuhandle的程序清單如下:
unit ContextMenuHandle;
interface
uses Windows,ActiveX,ComObj,ShlObj,Classes;
type
TContextMenu = class(TComObject,IShellExtInit,IContextMenu)
private
FFileName: array[0..MAX_PATH] of Char;
protected
function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning
function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult; stdcall;
function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
uFlags: UINT): HResult; stdcall;
function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult; stdcall;
end;
const
Class_ContextMenu: TGUID = '{19741013-C829-11D1-8233-0020AF3E97A0}';
{全局唯一標識符(GUID)是一個16字節(128為)的值,它唯一地標識一個接口(interface)}
var
FileList:TStringList;
implementation
uses ComServ, SysUtils, ShellApi, Registry,UnitForm;
function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult;
var
StgMedium: TStgMedium;
FormatEtc: TFormatEtc;
FileNumber,i:Integer;
begin
file://如果lpdobj等于Nil,則本調用失敗
if (lpdobj = nil) then begin
Result := E_INVALIDARG;
Exit;
end;
file://首先初始化并清空FileList以添加文件
FileList:=TStringList.Create;
FileList.Clear;
file://初始化剪貼版格式文件
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;
file://首先查詢用戶選中的文件的個數
FileNumber := DragQueryFile(StgMedium.hGlobal,$FFFFFFFF,nil,0);
file://循環讀取,將所有用戶選中的文件保存到FileList中
for i:=0 to FileNumber-1 do begin
DragQueryFile(StgMedium.hGlobal, i, FFileName, SizeOf(FFileName));
FileList.Add(FFileName);
Result := NOERROR;
end;
ReleaseStgMedium(StgMedium);
end;
function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
idCmdLast, uFlags: UINT): HResult;
begin
Result := 0;
if ((uFlags and $0000000F) = CMF_NORMAL) or
((uFlags and CMF_EXPLORE) <> 0) then begin
// 往Context Menu中加入一個菜單項 ,菜單項的標題為察看位圖文件
InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
PChar('文件操作'));
// 返回增加菜單項的個數
Result := 1;
end;
end;
function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
frmOP:TForm1;
begin
// 首先確定該過程是被系統而不是被一個程序所調用
if (HiWord(Integer(lpici.lpVerb)) <> 0) then
begin
Result := E_FAIL;
Exit;
end;
// 確定傳遞的參數的有效性
if (LoWord(lpici.lpVerb) <> 0) then begin
Result := E_INVALIDARG;
Exit;
end;
file://建立文件操作窗口
frmOP:=TForm1.Create(nil);
file://將所有的文件列表添加到文件操作窗口的列表中
frmOP.ListBox1.Items := FileList;
Result := NOERROR;
end;
function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HRESULT;
begin
if (idCmd = 0) then begin
if (uType = GCS_HELPTEXT) then
{返回該菜單項的幫助信息,此幫助信息將在用戶把鼠標
移動到該菜單項時出現在狀態條上。}
StrCopy(pszName, PChar('點擊該菜單項將執行文件操作'));
Result := NOERROR;
end
else
Result := E_INVALIDARG;
end;
type
TContextMenuFactory = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;
procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var
ClassID: string;
begin
if Register then begin
inherited UpdateRegistry(Register);
ClassID := GUIDToString(Class_ContextMenu);
file://當注冊擴展庫文件時,添加庫到注冊表中
CreateRegKey('*shellex', ', ');
CreateRegKey('*shellexContextMenuHandlers', ', ');
CreateRegKey('*shellexContextMenuHandlersFileOpreation', ', ClassID);
file://如果操作系統為Windows NT的話
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('SOFTWAREMicrosoftWindowsCurrentVersionShell Extensions', True);
OpenKey('Approved', True);
WriteString(ClassID, 'Context Menu Shell Extension');
finally
Free;
end;
end
else begin
DeleteRegKey('*shellexContextMenuHandlersFileOpreation');
inherited UpdateRegistry(Register);
end;
end;
initialization
TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
', 'Context Menu Shell Extension', ciMultiInstance,tmApartment);
end.
在OpWindow窗口中加入一個TListBox控件和兩個TButton控件,OpWindows.pas的程序清單如下:
unit opwindow;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls,shlobj,shellapi,ActiveX;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
FileList:TStringList;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
FileList:=TStringList.Create;
Button1.Caption :='復制文件';
Button2.Caption :='移動文件';
Self.Show;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FileList.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
sPath:string;
fsTemp:SHFILEOPSTRUCT;
i:integer;
begin
sPath:=InputBox('文件操作','輸入復制路徑','c:windows');
if sPath<>'then begin
fsTemp.Wnd := Self.Handle;
file://設置文件操作類型
fsTemp.wFunc :=FO_COPY;
file://允許執行撤消操作
fsTemp.fFlags :=FOF_ALLOWUNDO;
for i:=0 to ListBox1.Items.Count-1 do begin
file://源文件全路徑名
fsTemp.pFrom := PChar(ListBox1.Items.Strings[i]);
file://要復制到的路徑
fsTemp.pTo := PChar(sPath);
fsTemp.lpszProgressTitle:='拷貝文件';
if SHFileOperation(fsTemp)<>0 then
ShowMessage('文件復制失敗');
end;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
sPath:string;
fsTemp:SHFILEOPSTRUCT;
i:integer;
begin
sPath:=InputBox('文件操作','輸入移動路徑','c:windows');
if sPath<>'then begin
fsTemp.Wnd := Self.Handle;
fsTemp.wFunc :=FO_MOVE;
fsTemp.fFlags :=FOF_ALLOWUNDO;
for i:=0 to ListBox1.Items.Count-1 do begin
fsTemp.pFrom := PChar(ListBox1.Items.Strings[i]);
fsTemp.pTo := PChar(sPath);
fsTemp.lpszProgressTitle:='移動文件';
if SHFileOperation(fsTemp)<>0 then
ShowMessage('文件復制失敗');
end;
end;
end;
end.
點擊菜單的 Project | Build ContextMenu 項,Delphi就會建立Contextmenu.dll文件,這個就是上下文相關菜單程序了。
使用,Regsvr32.exe 注冊程序,然后在Windows的Explore 中在任意的一個或者幾個文件中點擊鼠標右鍵,在上下文菜單中就會
多一個文件操作的菜單項,點擊該項,在彈出窗口的列表中會列出你所選擇的所有文件的文件名,你可以選擇拷貝文件按鈕或者
移動文件按鈕執行文件操作。
新聞熱點
疑難解答
圖片精選