Windows 外壳扩展编程入门实例
Windows 外殼擴展編程入門實例
—— Delphi 篇
?
作者的話
關于Windows 外殼擴展方面的文章私心以為最好的應當算是Michael Dunn 的TheComplete Idiot’s Guide to Writing Shell Extensions 我也曾想過所謂眼前有景道不得崔顥題詩在上頭既然已經有了這么好的文章我還來饒舌算什么不過轉念再想文章雖好畢竟是為Visual C++的用戶看的對Delphi 的使用者來說似乎有點不公平我最初編寫Shell Extension 的時候用的也是Visual C++ 不過現在已經轉而使用Delphi 覺得兩者畢竟還是有所不同因此就有了這篇文章算是將我的一些心得體會和大家分享我最初的打算是將Michael Dunn 文章中涉及的全部內容全部轉成Delphi 程序再加上我自己的一些發現做成一個完整的系列不過后來發現這個工程量實在相當的大而且似乎沒有必要因為Windows Shell Extension 的許多內容是相通的完全可以舉一反三我再重復MSDN或者Michael Dunn 文章中的那些東西似乎是在浪費時間最終我決定只用一個例子說明Shell Extension 編程的基本原理就好至于后面的東西那就修行在各人了我是第一次寫這樣長的文章而且從文字程序到圖片樣樣俱全加上Acrobat 又不熟悉用法所以做的比較辛苦如果有什么意見或是發現問題的話歡迎來信告訴我(Hao.Yu@yeah.net) 不過我無法保證一定能夠回信如果想要轉載的話也無妨不過希望能夠尊重我的勞動不要擅自修改文章內容也不要改頭換面署上自己的名字再次感謝您費心
(2002 年5 月3 日)
第一篇概述
盡管Windows 資源管理器的功能在每個新版本中都得到了不少增強還是有許多人對它感到不滿意有沒有辦法讓資源管理器變得更好用更符合自己的需要呢一個辦法就是自己重新打造一個全新的Explorer 目前已經有了一些這方面的軟件比如PowerDesk Utilities 和Turbo Browser 就堪稱個中翹楚不過要完全實現資源管理器方方面面的功能其工作量可能超乎想象而且牽涉的知識面頗廣對個人來說難度高了一些而另一個辦法就是利用Microsoft 開放給我們的外殼擴展接口了雖然這種途徑限制更多一些但是門檻比較低而且也能夠滿足絕大部分需要這方面一個最好的例子就是WinZip 這個軟件幾乎把外殼擴展的功能發揮到了極致相信你已經很熟悉它了在本文中我就利用自己完成的一個實際的例子來說明如何編程擴展Windows 外殼為了完成這個例子我參考了一些資料主要是Michael Dunn的The Complete Idiot'sGuide to Writing Shell Extensions 可以從http://www.codeproject.com/shell/ 得到這個系列的文檔這是我看到的最好的介紹外殼擴展編程的文章感謝Michael Dunn 不過他的例子是用Visual C++編寫的我在閱讀的時候就感到用Visual C++來編寫這些東西顯得太過繁瑣而且將MFC/ATL/STL 混合在一起的風格也讓我覺得非常不爽因此后來我改用Delphi 重寫了程序這樣確實為我節省了不少工作量如果你常用的工具是Visual C++ 那
么建議你還是應該去閱讀Michael Dunn 的文檔這些文檔內容更完整得多我的這篇文章主要是面對Delphi 的用戶提供一個入門級的Windows 外殼擴展編程指導我用來編寫這個程序的平臺是Microsoft Windows 2000 Professional 編程工具是BorlandDelphi 6.0+Update Pack 2 在編寫外殼擴展程序的時候我推薦盡可能使用最新的開發平臺因為Windows Shell 的接口總是在持續的更新而比較老的開發平臺例如Delphi 5.0和更早的Visual C++ 6.0 將無法識別許多新的結構接口和函數等等雖然我聽到不少抱怨說Delphi 6.0 不如早期版本來的穩定不過至少在開發這個程序的過程中它并沒有給我造成什么麻煩至于操作系統無論如何要用Windows 2000 因為在Windows 9X 下調試外殼擴展是一件非常麻煩的事情
在編寫外殼擴展之前應該先做一些準備工作首先必須在注冊表中作一些改動因為任何外殼擴展都是作為DLL 而加載到Explorer 的進程空間內的所以如果不做些手腳那么只要Explorer還存在你編寫的外殼擴展就無法順利編譯如果你愿意手動修改注冊表的話可以參考Michael
Dunn 的文章不過我建議你利用Windows 優化大師這個軟件幫你做掉這項工作只要選中啟動系統時為桌面和Explorer 創建獨立的進程即可這個選項會增加一些系統開銷不過從理論上來講倒是可以讓操作系統更穩定一些如下圖所示另外一個問題就是在調試外殼擴展的時候你不能太依賴于集成調試器就拿ContextMenu 擴展來說你怎么能一方面激活集成調試器另一方面又讓資源管理器中的上下文菜單保持可見呢所以你首先應該養成在運行程序之前把程序先好好檢查一遍的習慣不要急著按F9 其次如果你需要一個脫離IDE 又能夠顯示調試信息的工具那么有一個很好的工具DebugView 可以滿足你這個軟件可以從www.sysinternals.com 取得我發現這個工具至少能夠解決90%以上的調試需求它已經成為我的編程工具箱中最重要的工具之一最后再羅索兩句編寫外殼擴展的時候一定要特別小心盡量處理任何可能發生的錯誤因為外殼擴展是被Explorer加載到進程空間內的所以外殼擴展中的任何錯誤都可能讓Explorer崩潰掉特別是你的程序中如果用到任何VCL 類或者RTL 函數的話一定要處理掉可能發生的異常因為操作系統并不知道如何處理VCL/RTL 異常其后果如何是可想而知的考慮到Explorer在系統中的地位你應該有一種如臨深淵如履薄冰的感覺了另外為了用戶考慮外殼擴展所執行的任何任務都應該盡可能快的完成決不要用外殼擴展執行那些需要很長時間的動作否則的話如果用戶在資源管理器中點擊鼠標后要好幾秒鐘才會看到菜單出現那么很快他們她們就會感到不耐煩進而對你的軟件失去信心準備好了嗎我們出發吧
第二篇建立程序框架
外殼擴展有好幾種類型在這里我要實現的是一個Context Menu 擴展因為這是最常見最有用的擴展類型而且所有的外殼擴展都有許多相通的地方學會一種以后其他的也就非常容易掌握了我計劃讓這個擴展完成如下的一些功能
1 對任何文件都能夠實現Copy(Move) to Anywhere Windows 資源管理器并不直接支持這項功能不論是Cut/Copy&Paste 或者是開兩個文件夾窗口來Drag/Drop 都要經歷多個步驟才行畢竟麻煩我是在工具軟件Nuts & Bolt中第一次看到這個功能的當時就覺得它非常有用不過一直不知道是如何實現的現在好了我們也來DIY 一回
2 對于COM 組件庫能夠實現Register/Unregister 的功能凡是編程的人都應該知道這個內容從而不必動用不討人喜歡的regsvr32
3 對于圖片文件能夠在Context Menu 中預覽用過PicaView 嗎對了就是它如果只是想知道圖片的概貌又何必非ACDSee 不可Windows 2000 的
縮略圖模式處理圖像太慢而且占用太多資源我也不喜歡上述三種情況幾乎涵蓋了Context Menu 擴展所能遇到的所有情況如何處理單一文件
如何處理多個文件如何管理自繪式Owner-Draw 菜單可以說只要能妥善處理這三種情況那么在Context Menu 擴展中再沒有什么困難的問題了
因為任何外殼擴展首先必須是一個COM 組件所以我們就從這里開始1 用Delphi 新建一個ActiveX Library 并保存我用的名稱是YHShellExt 你當然可以猜到YH是我的名字的縮寫你可以把它換成自己的名字
2 再次用Delphi 新建一個COM Object 在COM Object Wizard 中將對象命名為YHContextMenu Options 中的兩個檢查框都可以不必選中其他的保持默認即可
現在這個程序的框架已經建立起來了Delphi 為我們自動產生了TYHContextMenu 類的骨架代碼并且在單元的initialization 部分自動產生了一個TComObjectFactory 對象這個對象可以完成COM組件的注冊工作不過對于外殼擴展來說除了注冊COM組件之外還必須完成一些額外的工作這個組件才具備了外殼擴展的身份所以我們還需要從TComObjectFactory 派生一個類才行對代碼稍作修改完成后應該類似下面這樣
unit YHCMImpl;
interface
uses
Windows, Messages, ActiveX, Classes, SysUtils, ComObj, ShellAPI, ShlObj,
Graphics, JPEG, Registry;
type
{
TYHContextMenu - Context Menu Extension 的實現類
}
TYHContextMenu = class(TComObject)
private
protected
public
end;
{
TYHContextMenuFactory - Context Menu Extension 的類工廠
}
TYHContextMenuFactory = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;
const
Class_YHContextMenu: TGUID = '{461BCDC0-5E20-11D6-9A8D-
00E04C393F6F}';
implementation
uses ComServ;
//===============================================
// TYHContextMenu
//===============================================
//===============================================
// TYHContextMenuFactory
//===============================================
procedure TYHContextMenuFactory.UpdateRegistry(Register: Boolean);
begin
inherited;
end;
initialization
TYHContextMenuFactory.Create(ComServer, TYHContextMenu,
Class_YHContextMenu, 'YHContextMenu', '', ciMultiInstance, tmApartment);
end.
建立程序框架的工作到此完成從下一部分開始我們將陸續向程序中加入功能性的代碼
第三篇支持I S h e l l E x t I n i t 接口
絕大多數外殼擴展都需要支持IShellExtInit 接口除此之外每一種擴展分別還需要支持一至二個額外的接口對于Context Menu 擴展來說必須支持的兩個基本接口就是IShellExtInit 和IContextMenu 另外如果要處理自繪式菜單還需要支持IContextMenu2或者IContextMenu3 由于IShellExtInit 接口對每一個外殼擴展來說都是必需的而且相對簡單我們首先來實現它IShellExtInit 接口只有一個方法Initialize 在Context Menu 彈出之前系統會調用這個方法而我們所要做的工作就是在這個時候決定用戶究竟選定了哪些文件再根據這些文件的類型做進一步的處理不過這里有一個小小的麻煩在Delphi 中一切COM 對象都是從TComObject 派生而來的而TComObject 類中已經有了一個虛擬的Initialize 方法這個方法會在COM組件建立的時候被調用如果我們的程序還要實現IShellExt::Initialize 的話那么命名沖突的問題就不可避免了怎么辦Object Pascal 中有一種特殊的語法可以避開這個問題
TYHContextMenu = class(TComObject, IShellExtInit)
private
{ 數據成員}
FFileList : TStringList;
FGraphic : TGraphic;
protected
{ IShellExtInit 接口}
function IShellExtInit.Initialize = SEInitialize;
function SEInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult; stdcall;
public
procedure Initialize; override;
destructor Destroy; override;
end;
基本上Object Pascal 語言采用的是單根繼承的方法所以命名沖突的問題很少會出現不過一旦某個類需要實現多個接口那么還是無法確保這些接口不會有同名的方法不過你也看到了只要像上述那樣為其中某個接口的方法另外起一個名字就不會有問題了為了正確處理外殼擴展的構造/析構動作我重載了TComObject 的Initialize 和Destroy兩個方法你或許會奇怪為什么不重載Create 而用了Initialize 這是因為TComObject 有好幾種形式的構造函數但是不論如何構造TComObject Initialize 方法是一定會被調用的所以這里是執行初始化動作的最好地方另外注意我添加了兩個數據成員其中FFileList 用于保存用戶選中的文件列表FGraphic 用于執行圖片預覽的動作在后面我們會用到Initialize 和Destroy 方法的代碼非常簡單無非是數據的初始化和釋放而已
procedure TYHContextMenu.Initialize;
begin
OutputDebugString('YHContextMenu::Initialize'#13#10);
inherited;
FFileList := TStringList.Create;
FGraphic := nil;
end;
destructor TYHContextMenu.Destroy;
begin
OutputDebugString('YHContextMenu::Destroy'#13#10);
FreeAndNil(FFileList);
FreeAndNil(FGraphic);
inherited;
end;
上面兩個OutputDebugString 的作用是觀察Context Menu 擴展的生存周期用DebugView 可以看到Context Menu 擴展在資源管理器中點擊右鍵彈出上下文菜單的時候才會建立而菜單消失的時候生命也就結束了如下圖當然現在還無法看到這個結果因為這個擴展還沒有實現IContextMenu 所以根本還不是一個合法的Context MenuExtension 但是從中你可以看到DebugView 在調試過程中的作用下一步是實現IShellExtInit::Initialize 這個方法包括三個參數不過目前來說有用的只有一個就是系統傳遞給我們的IDataObject 對象我們可以從中獲得用戶選擇的文件列表因為對于所有的外殼擴展來說對此一方法的處理都相當一致所以我設計了另外一個方法這個方法可以被任何實現IShellExtInit 的類所調用
//===============================================
// IShellExtInit::Initialize
//===============================================
function TYHContextMenu.SEInitialize(pidlFolder: PItemIDList;
lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
begin
Result := GetFileListFromDataObject(lpdobj, FFileList);
end;
function GetFileListFromDataObject(lpdobj: IDataObject; sl: TStringList) : HResult;
var
fe : FormatEtc;
sm : StgMedium;
i, iFileCount : integer;
FileName : array[0..MAX_PATH-1] of char;
begin
assert(lpdobj<>nil);
assert(sl<>nil);
sl.Clear;
with fe do begin
cfFormat := CF_HDROP;
ptd := nil;
dwAspect := DVASPECT_CONTENT;
lindex := -1;
tymed := TYMED_HGLOBAL;
end;
with sm do begin
tymed := TYMED_HGLOBAL;
end;
Result := lpdobj.GetData(fe, sm);
if Failed(Result) then Exit;
iFileCount := DragQueryFile(sm.hGlobal, $ffffffff, nil, 0);
if iFileCount<=0 then begin
ReleaseStgMedium(sm);
Result := E_INVALIDARG;
Exit;
end;
for i:=0 to iFileCount-1 do begin
DragQueryFile(sm.hGlobal, i, FileName, sizeof(FileName));
sl.Add(FileName);
end;
ReleaseStgMedium(sm);
Result := S_OK;
end;
對IDataObject 的處理涉及COM 中特別是OLE 拖放編程的一些高級概念所以上面的代碼可能會讓缺乏這方面知識的人看起來有點糊涂不過沒關系你只需要知道調用這個方法以后用戶選擇的文件列表就會保存到StringList 中就行了在這一部分我們除了處理外殼擴展本身的初始化和清除之外還實現了IShellExtInit 接口在下一部分我們將進入Context Menu 擴展的另外一個也是最核心的接口IContextMenu
第四篇支持I C o n t e x t M e n u 接口
比起我們在上面討論的IShellExtInit 接口來說IContextMenu 是一個相對復雜的接口它有三個方法而且每個方法都是參數眾多雖然InvokeCommand 方法只有一個參數不過這個參數可是一個相當龐大的結構我們按順序來首先是菜單彈出之前系統要調用的方法
QueryContextMenu
QueryContextMenu 方法聲明如下
function QueryContextMenu(Menu: HMENU;
indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall;
其中Menu 就是系統開放給你的上下文菜單的句柄你可以用InsertMenu 或者InsertMenuItem之類的函數向里面增加菜單indexMenu 是系統預留給你的菜單項的位置你應該從這個位置開始加入菜單但是加入的菜單項個數不要超過idCmdLast-idCmdFirst 這個范圍uFlags 則是一些標志位函數的返回值則應該是你加入的菜單個數和其他一些標志的組合例如我們要加入一個CopyAnywhere 的菜單項
const
// 菜單類型
mfString = MF_STRING or MF_BYPOSITION;
mfOwnerDraw = MF_OWNERDRAW or MF_BYPOSITION;
mfSeparator = MF_SEPARATOR or MF_BYPOSITION;
// 菜單項ID
idCopyAnywhere = 0; // 復制移動
idRegister = 5; // 注冊ActiveX
idUnregister = 6; // 取消注冊ActiveX
idImagePreview = 10; // 預覽圖片文件
idMenuRange = 90;
function Make_HResult(sev, fac, code: Word): DWord;
begin
Result := (sev shl 31) or (fac shl 16) or code;
end;
function TYHContextMenu.QueryContextMenu(Menu: HMENU; indexMenu,
idCmdFirst, idCmdLast, uFlags: UINT): HResult;
var
Added : UINT;
begin
if (uFlags and CMF_DEFAULTONLY)=CMF_DEFAULTONLY then begin
Result := Make_HResult(SEVERITY_SUCCESS, FACILITY_NULL, 0);
Exit;
end;
Added := 0;
// 加入CopyAnywhere 蔡單項
InsertMenu(Menu, indexMenu, mfSeparator, 0, nil);
InsertMenu(Menu, indexMenu, mfString, idCmdFirst+idCopyAnywhere,
PChar(sCopyAnywhere));
InsertMenu(Menu, indexMenu, mfSeparator, 0, nil);
Inc(Added, 3);
Result := Make_HResult(SEVERITY_SUCCESS, FACILITY_NULL,
idMenuRange);
end;
你也許會感到吃驚我分明只加入了一個有效的菜單項即使算上另外兩個Separator 也不過3 個而已為什么返回值卻指定了90 個之多這是因為我計劃編寫的是一個通用的Context Menu 擴展它對所有的文件都適用當然為某一種文件編寫Context Menu 擴展也是完全可以的不過這樣做靈活性太差比如.DLL 或者.OCX 甚至還包括.EXE 都可能是COM組件都可以執行Register/Unre gister的操作難道為了實現同一個功能還要寫2~3個基本上沒有差別的擴展通用擴展就沒有這樣的問題不過編程的復雜性就大大增加因為就必須處理這樣麻煩的情況如果是.TXT 文件的話需要加入這些菜單如果是.BMP 的話加入另外一些… 為了避免總是要動態計算菜單ID 的麻煩保證擴展的擴充性多保留幾個ID 沒有壞處在MSDN 中聲明返回值應該是加入的菜單項個數+1 嚴格來說這是不正確的我測試的結果證明返回的結果應該是系統為你的擴展保留的菜單ID 范圍也就是說如果idCmdFirst=20000 而你返回了90 那么系統會保證20000~20000+ 90-1 這個范圍內的菜單ID 都是可用的如果系統中還有其他擴展的話那么它們會使用20090 后面的菜單ID 所以我總是傾向于保留盡可能多的ID 留給以后使用只要不超過idCmdLast-idCmdFirst 這個限度即可從上面的常量定義你大概也可以發現我使用的規則那就是為每一種文件類型至少保留5 個菜單ID你還會注意到Make_HResult 函數這在SDK 中是作為MAKE_HRESULT 宏來實現的但是Delphi 中并沒有宏的概念為了讓熟悉SDK 的人更容易理解這個程序我把它拿出來做
成了一個獨立的函數
下面一個方法是IContextMenu::InvokeCommand 這個函數會在用戶點擊菜單項的時
候被調用也是執行真正動作的地方
function TYHContextMenu.InvokeCommand(var lpici:
TCMInvokeCommandInfo): HResult;
begin
Result := E_INVALIDARG;
if HiWord(Integer(lpici.lpVerb))<>0 then Exit;
case LoWord(Integer(lpici.lpVerb)) of
idCopyAnywhere:
DoCopyAnywhere(lpici.hwnd, FFileList);
Result := NOERROR;
end;
procedure DoCopyAnywhere(Wnd: HWND; sl: TStringList);
var
frm : TfrmCopyAnywhere;
begin
frm := TfrmCopyAnywhere.Create(Application);
try
frm.AddFiles(sl);
frm.ShowModal;
finally
frm.Free;
end;
end;
frmCopyAnywhere 是額外設計來實現Copy(Move) to Anywhere 功能的用戶界面因為有了SHFileOperation 這樣好用的函數所以我們要做的工作其實相當的少這個窗體的詳細代碼我也就不再列出了相信有點經驗的朋友都應該可以輕松完成才對下圖是這個窗體的顯示界面我的界面設計實在算不上高明希望大家可以設計的比我更好OK 我們已經勝利在望了最后一個需要編寫的方法是GetCommandString 當用戶選擇菜單項的時候在資源管理器的狀態欄上會顯示相關的提示信息這個方法也沒有什么好說的唯一需要注意的就是Unicode/Ansi的區別讓事情變得有點復雜不過比起C++來說不管是煩人的MultiByteToWideChar/WideCharToMultiByte 還是我總也搞不清楚的ATLConversions Delphi 的處理過程還是相當簡單而直觀的
//===============================================
// IContextMenu::GetCommandString
//===============================================
function TYHContextMenu.GetCommandString(idCmd, uType: UINT;
pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;
var
strTip : string;
wstrTip : WideString;
begin
strTip := '';
Result := E_INVALIDARG;
if (uType and GCS_HELPTEXT)<>GCS_HELPTEXT then Exit;
case idCmd of
idCopyanywhere: strTip := sCopyAnywhereTip;
end;
if strTip<>'' then begin
if (uType and GCS_UNICODE)=0 then begin // Ansi
lstrcpynA(pszName, PChar(strTip), cchMax);
end
else begin // Unicode
wstrTip := strTip;
lstrcpynW(PWideChar(pszName), PWideChar(wstrTip), cchMax);
end;
Result := S_OK;
end;
end;
大功告成不過我們似乎還高興的早了一點別忘了還有一個TYHContextMenuFactory呢如果忘了它那么期待已久的Context Menu Extension 還是無法出現好在Delphi 有幾個非常好用的函數可以省掉處理注冊表的許多麻煩
procedure TYHContextMenuFactory.UpdateRegistry(Register: Boolean);
procedure DeleteRegValue(const Path, ValueName: string; Root:
DWord=HKEY_CLASSES_ROOT);
var
reg : TRegistry;
begin
reg := TRegistry.Create;
with reg do
try
RootKey := Root;
if OpenKey(Path, False) then begin
if ValueExists(ValueName) then
DeleteValue(ValueName);
CloseKey;
end;
finally
Free;
end;
end;
const
RegPath = '*\shellex\ContextMenuHandlers\YHShellExt ';
ApprovedPath = 'Software\Microsoft\Windows\CurrentVersion\Shell
Extensions\Approved';
var
strGUID : string;
begin
inherited;
strGUID := GUIDToString(Class_YHContextMenu);
if Register then begin
CreateRegKey(RegPath, '', strGUID);
CreateRegKey(ApprovedPath, strGUID, 'YH 的外殼擴展',
HKEY_LOCAL_MACHINE);
end
else begin
DeleteRegKey(RegPath);
DeleteRegValue(ApprovedPath, strGUID, HKEY_LOCAL_MACHINE);
end;
end;
現在我們面對的就是一個真真正正的可以執行的Context Menu 外殼擴展了只要在IDE 中執行一下Run- >Register ActiveX Server 命令你就能夠到資源管理器中檢閱自己的勞動成果了
第五篇加入注冊/ 反注冊A c t i v e X L i b r a r y 的功能
上面的內容都明白了嗎如果你回答是那么這一部分的內容對你來說也應該是輕而易舉的了為了簡化起見我決定只支持單一文件的注冊和反注冊功能注冊和反注冊的原理也是非常簡單的用LoadLibrary 載入ActiveX 連接庫并且查找是否存在DllRegisterServer或者DllUnregisterServer 這兩個函數如果有則執行之所以代碼沒有什么好解釋的唯一不同之處在于我為這兩個菜單項加入了圖像利用SetMenuItemBitmaps 函數這兩個圖像是作為資源連接到最終的DLL 中的如果你還不明白怎樣在Delphi 程序中加入資源那么我就簡要說明一下
1 準備好兩個14*14 的小圖像如果不嫌麻煩的話也不妨用GetMenuCheckMarkDimensions 函數確認一下是否為這個大小
2 建立一個文本文件修改它的內容如下
101 BITMAP "reg.bmp"
102 BITMAP "unreg.bmp"
然后把它保存為ExtraRes.rc 使用其他名稱亦可但不要和項目重名
3 從IDE 菜單中選擇Project->Add to Project 將文件類型改為Resource
File(*.rc) 選擇剛才保存的.RC 文件即可
resourcestring
// 菜單標題和提示字符串資源
sCopyAnywhere = '復制到...';
sCopyAnywhereTip = '將選定的文件復制到任何路徑下';
sRegister = '注冊...';
sRegisterTip = '注冊ActiveX 庫';
sUnregister = '取消注冊...';
sUnregisterTip = '取消注冊ActiveX 庫';
sImagePreview = '預覽圖片文件';
sImagePreviewTip = '預覽圖片文件';
function TYHContextMenu.QueryContext Menu(Menu: HMENU; indexMenu,
idCmdFirst, idCmdLast, uFlags: UINT): HResult;
var
Added : UINT;
hbmReg, hbmUnreg : HBITMAP;
begin
if (uFlags and CMF_DEFAULTONLY)=CMF_DEFAULTONLY then begin
Result := Make_HResult(SEVERITY_SUCCESS, FACILITY_NULL, 0);
Exit;
end;
Added := 0;
// 加入CopyAnywhere 菜單項的代碼略
…
if FFileList.Count=1 then begin // 單一文件
if IsActiveLib(FFileList[0]) then begin // AcitveX Library
InsertMenu(Menu, indexMenu+Added, mfSeparator, 0, nil);
InsertMenu(Menu, indexMenu+Added, mfString, idCmdFirst+idUnregister,
PChar(sUnregister));
InsertMenu(Menu, indexMenu+Added, mfString, idCmdFirst+idRegister,
PChar(sRegister));
InsertMenu(Menu, indexMenu+Added, mfSeparator, 0, nil);
Inc(Added, 4);
hbmReg := LoadImage(HInstance, MakeIntResource(101), IMAGE_BITMAP,
0, 0, LR_LOADMAP3DCOLORS);
hbmUnreg := LoadImage(HInstance, MakeIntResource(102),
IMAGE_BITMAP, 0, 0, LR_LOADMAP3DCOLORS);
SetMenuItemBitmaps(Menu, idCmdFirst+idRegister, MF_BYCOMMAND,
hbmReg, hbmReg);
SetMenuItemBitmaps(Menu, idCmdFirst+idUnregister, MF_BYCOMMAND,
hbmUnreg, hbmUnreg);
end;
end
else begin // 多個文件
end;
Result := Make_HResult(SEVERITY_SUCCESS, FACILITY_NULL, idMenuRange);
end;
//=================================================
// IContextMenu::InvokeCommand
//=================================================
function TYHContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo):
HResult;
begin
Result := E_INVALIDARG;
if HiWord(Integer(lpici.lpVerb))<>0 then Exit;
case LoWord(Integer(lpici.lpVerb)) of
idCopyAnywhere:
DoCopyAnywhere(lpici.hwnd, FFileList);
idRegister:
RegisterActiveLib(lpici.hwnd, FFileList[0]);
idUnregister:
UnregisterActiveLib(lpici.hwnd, FFileList[0]);
end;
Result := NOERROR;
end;
//=================================================
// IContextMenu::GetCommandString
//=================================================
function TYHContextMenu.GetCommandString(idCmd, uType: UINT;
pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;
var
strTip : string;
wstrTip : WideString;
begin
strTip := '';
Result := E_INVALIDARG;
if (uType and GCS_HELPTEXT)<>GCS_HELPTEXT then Exit;
case idCmd of
idCopyanywhere: strTip := sCopyAnywhereTip;
idRegister: strTip := sRegisterTip;
idUnregister: strTip := sUnregisterTip;
end;
if strTip<>'' then begin
if (uType and GCS_UNICODE)=0 then begin // Ansi
lstrcpynA(pszName, PChar(strTip), cchMax);
end
else begin // Unicode
wstrTip := strTip;
lstrcpynW(PWideChar(pszName), PWideChar(wstrTip), cchMax);
end;
Result := S_OK;
end;
end;
其中用到了三個輔助函數IsActiveLib RegisterActiveLib 和UnregisterActiveLib 它們
的實現代碼如下
function IsActiveLib(const FileName: string): Boolean;
var
Ext : string;
hLib : THandle;
begin
Result := False;
Ext := UpperCase(ExtractFileExt(FileName));
if (Ext<>'.EXE') and (Ext<>'.DLL') and (Ext<>'.OCX') then Exit;
hLib := LoadLibrary(PChar(FileName));
if hLib=0 then Exit;
if GetProcAddress(hLib, 'DllRegisterServer')<>nil then
Result := True;
FreeLibrary(hLib);
end;
procedure RegisterActiveLib(Wnd: HWND; const FileName: string);
var
hLib : THandle;
fn : TDllRegisterServer;
hr : HResult;
begin
hLib := LoadLibrary(PChar(FileName));
if hLib=0 then begin
ReportWin32Error(Wnd, '裝載文件失敗', GetLastError);
Exit;
end;
fn := TDllRegisterServer(GetProcAddress(hLib, 'DllRegisterServer'));
if not Assigned(fn) then begin
MessageBox(Wnd, ' 定位函數入口點DllRegisterServer 失敗', ' 錯誤',
MB_ICONEXCLAMATION);
FreeLibrary(hLib);
Exit;
end;
hr := fn();
if Failed(hr) then begin
ReportWin32Error(Wnd, '注冊動態庫失敗', hr);
FreeLibrary(hLib);
Exit;
end;
MessageBox(Wnd, '注冊成功!', '成功', MB_ICONINFORMATION);
FreeLibrary(hLib);
end;
procedure UnregisterActiveLib(Wnd: HWND; const FileName: string);
var
hLib : THandle;
fn : TDllUnregisterServer;
hr : HResult;
begin
hLib := LoadLibrary(PChar(FileName));
if hLib=0 then begin
ReportWin32Error(Wnd, '裝載文件失敗', GetLastError);
Exit;
end;
fn := TDllUnregisterServer(GetProcAddress(hLib, 'DllUnregisterServer'));
if not Assigned(fn) then begin
MessageBox(Wnd, ' 定位函數入口點DllUnregisterServer 失敗', ' 錯誤',
MB_ICONEXCLAMATION);
FreeLibrary(hLib);
Exit;
end;
hr := fn();
if Failed(hr) then begin
ReportWin32Error(Wnd, '取消注冊動態庫失敗', hr);
FreeLibrary(hLib);
Exit;
end;
MessageBox(Wnd, '取消注冊成功!', '成功', MB_ICONINFORMATION);
FreeLibrary(hLib);
end;
procedure ReportWin32Error(Wnd: HWND; const Prefix: string; dwError: DWord);
var
szError : array[0..399] of char;
str : string;
begin
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
nil, dwError,
Make_LangID(LANG_NEUTRAL, SUBLANG_DEFAULT),
szError, sizeof(szError), nil);
str := Format('%s: %s', [Prefix, StrPas(szError)]);
MessageBox(Wnd, PChar(str), '錯誤', MB_ICONEXCLAMATION);
end;
想看看帶位圖的菜單是什么樣子嗎下圖就是彈出菜單的效果
第六篇加入圖像預覽功能
能夠在Context Menu 中預覽圖像初看起來頗為神奇— — 這也是為什么許多人記住了軟件PicaView 的原因IContextMenu 接口雖然能夠加入普通的菜單項卻無法處理Owner- Draw的菜單即使用MF_OWNERDRAW 參數調用InsertMenu 也不行因為自繪菜單的處理最終要依靠Explorer 窗口來進行而IContextMenu 并沒有開放給你這樣一條途徑可以截獲窗口過程對菜單的處理在我看來這實在是IContextMenu 設計上的一個疏漏因為Owner- Draw菜單行之早已有年IContextMenu 的設計者本不應該忘了這一點系統中后來加入的IContextMenu2 和IContextMenu3 也頗為古怪它們都只有一個方法而且除了一個用于返回值的參數之外更無二致令人不禁懷疑Windows Shell Extension 的設計者是否都是丟三
拉四的人否則何以對這樣一個小功能的支持都要到3 代猜測歸猜測我們還是來看點實際的東西微軟的程序員雖然設計了IContextMenu2 但是它似乎從來沒有起過作用不論怎樣支持IContextMenu2 自繪菜單都無法生效看來這就是IContextMenu3 出現的理由了所以我們跳過IContextMenu2 但還是要編寫IContextMenu2 的方法即使是一個占位符在TYHContextMenu 的繼承表中加入IContextMenu3 這里需要注意的一點是盡管IContextMenu3 是從IContextMenu 繼承而來但并不意味著加入IContextMenu3 就可以去掉IContextMenu 否則的話
TYHContextMenu 就只支持IContextMenu3 而不支持IContextMenu 了從純OOP 的角度來看似乎有點奇怪但必須記住這就是類繼承和接口繼承不同的地方因此在TYHContextMenu 的聲明列表中必須同時有IContextMenu 和IContextMenu3
type
TYHContextMenu = class(TComObject, IShellExtInit, IContextMenu,
IContextMenu3)
protected
…
{ IContextMenu2 接口}
function HandleMenuMsg(uMsg: UINT; WParam, LParam: Integer): HResult;
stdcall;
{ IContextMenu3 接口}
function HandleMenuMsg2(uMsg: UINT; wParam, lParam: Integer;
var lpResult: Integer): HResult; stdcall;
end;
在IContextMenu::QueryContextMenu 方法的處理中如果選中的文件是圖片文件的話
則要加入Owner-Draw 菜單
if IsImageFile(FFileList[0]) then begin // 圖片文件
FGraphic := ImageFromFile(FFileList[0]);
if Assigned(FGraphic) then begin
InsertMenu(Menu, indexMenu+Added, mfSeparator, 0, nil);
InsertMenu(Menu, indexMenu+Added, mfOwnerDraw,
idCmdFirst+idImagePreview, nil);
InsertMenu(Menu, indexMenu+Added, mfSeparator, 0, nil);
// Inc(Added, 3);
end;
end;
其中用到兩個輔助函數代碼如下
function IsImageFile(const FileName: string): Boolean;
var
Ext : string;
begin
Ext := UpperCase(ExtractFileExt(FileName));
if (Ext='.ICO') or (Ext='.BMP') or (Ext='.EMF') or (Ext='.WMF') or (Ext='.JPG') or
(Ext='.JPEG') then
Result := True
else
Result := False;
end;
function ImageFromFile(const FileName: string): TGraphic;
var
Ext : string;
begin
Ext := UpperCase(ExtractFileExt(FileName));
Result := nil;
if (Ext<>'.ICO') and (Ext<>'.BMP') and (Ext<>'.BMP') and
(Ext<>'.WMF') and (Ext<>'.EMF') and (Ext<>'.JPG') and
(Ext<>'.JPEG') then begin
Result := nil;
Exit;
end;
try
if (Ext='.ICO') then
Result := TIcon.Create
else if (Ext='.BMP') then
Result := TBitmap.Create
else if (Ext='.EMF') or (Ext='.WMF') then
Result := TMetaFile.Create
else
Result := TJPEGImage.Create;
Result.LoadFromFile(FileName);
except
FreeAndNil(Result);
end;
end;
需要說明的是上述代碼其實是比較笨拙的將圖片文件的擴展名硬編碼在程序中并不是一個很好的編程習慣我相信VCL 中應該有更靈活更具彈性的方法來實現類似的功能不過暫時我還沒有找到更好的辦法如果你有的話歡迎來信告訴我IContextMenu::InvokeCommand 的實現只要在Case 語句中增加一個分支即可
case LoWord(Integer(lpici.lpVerb)) of
…
idImagePreview:
ExecuteFile(lpici.hwnd, FFileList[0]);
end;
function ExecuteFile(Wnd: HWND; const FileName: string): THandle;
var
Path : string;
begin
Path := ExtractFilePath(FileName);
Result := ShellExecute(Wnd, 'open', PChar(FileName), nil, PChar(Path),
SW_SHOW);
end;
IContextMenu::GetCommandString 方法我就不在這里列出相信大家早就知道如何修改了接下來是IContextMenu2::HandleMenuMsg 我說過它只是個占位符
//=================================================
// IContextMenu2::HandleMenuMsg
//=================================================
function TYHContextMenu.HandleMenuMsg(uMsg: UINT; WParam,
LParam: Integer): HResult;
var
Ret : Integer;
begin
Ret := 0;
Result := HandleMenuMsg2(uMsg, wParam, lParam, Ret);
end;
IContextMenu2::HandleMenuMsg2 才是這里的重頭戲對于Owner-Draw 菜單來說它需要處理兩條消息WM_MEASUREITEM 和WM_DRAWITEM 由于這里只有一個Owner-Draw 菜單為了簡便起見我也沒有判斷菜單的ID是否為idImagePreview
//=================================================
// IContextMenu::HandleMenuMsg2
//=================================================
function TYHContextMenu.HandleMenuMsg2(uMsg: UINT; wParam, lParam: Integer;
var lpResult: Integer): HResult;
var
pmis : PMeasureItemStruct;
pdis : PDrawItemStruct;
begin
Result := S_OK;
case uMsg of
WM_MEASUREITEM:
begin
pmis := PMeasureItemStruct(lParam);
if not Assigned(FGraphic) then begin
pmis.itemWidth := 120;
pmis.itemHeight := 120;
Exit;
end;
// 如果圖片小于120*120 則按實際顯示否則縮放到120*120
if (FGraphic.Width<=120) and (FGraphic.Height<=120) then begin
pmis.itemWidth := 140;
pmis.itemHeight := FGraphic.Height + 40;
end
else begin
pmis.itemWidth := 140;
pmis.itemHeight := 160;
end;
end;
WM_DRAWITEM:
begin
pdis := PDrawItemStruct(lParam);
DrawGraphic(pdis.hDC, pdis.rcItem, pdis.itemState, FGraphic);
end;
end;
end;
這里用到另外一個輔助函數DrawGraphic 它根據圖形的大小決定調用TCanvas::Draw 還是TCanvas::StretchDraw 需要說明的是為了顯示一個TGraphic 對象我們需要TCanvas作為它的繪制表面而系統傳給我們的卻是一個HDC 這里就需要一點技巧了把HDC 賦給TCanvas.Handle 是可行的不過千萬要注意保存和恢復原始DC 的狀態SaveDC/RestoreDC 否則后面的菜單很可能顯示不正常這一段代碼雖然比較長但是原理很簡單前面的都是一些邊界計算真正繪圖的只有Draw/StretchDraw 一句
procedure DrawGraphic(adc: HDC; rc: TRect; State:Integer; Graphic: TGraphic);
var
rcImage, rcText, rcStretch : TRect;
Canvas : TCanvas;
nSaveDC : integer;
x, y : integer;
xScale, yScale, Scale : Double;
xStretch, yStretch : integer;
begin
with rcImage do begin
Left := rc.Left + 10;
Right := rc.Right - 10;
Top := rc.Top + 10;
Bottom := rc.Bottom - 30;
end;
with rcText do begin
Left := rc.Left + 10;
Right := rc.Right - 10;
Top := rc.Bottom - 20;
Bottom := rc.Bottom;
end;
Canvas := TCanvas.Create;
nSaveDC := 0;
try
nSaveDC := SaveDC(adc);
Canvas.Handle := adc;
with Canvas do begin
if not Assigned(Graphic) then begin
Rectangle(rcImage);
MoveTo(rcImage.Left, rcImage.Top);
LineTo(rcImage.Right, rcImage.Bottom);
MoveTo(rcImage.Right, rcImage.Top);
LineTo(rcImage.Left, rcImage.Bottom);
DrawText(Canvas.Handle, '未知圖像', -1, rcImage,
DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end
else begin
if (Graphic.Width<rcImage.Right-rcImage.Left) and
(Graphic.Height<rcImage.Bottom-rcImage.Top) then begin
x := rcImage.Left + (rcImage.Right - rcImage.Left - Graphic.Width) div
2;
y := rcImage.Top + (rcImage.Bottom - rcImage.Top - Graphic.Height)
div 2;
Canvas.Draw(x, y, Graphic);
end
else begin
xScale := Graphic.Width / (rcImage.Right-rcImage.Left);
yScale := Graphic.Height / (rcImage.Bottom-rcImage.Top);
Scale := Max(xScale, yScale);
xStretch := Trunc(Graphic.Width / Scale);
yStretch := Trunc(Graphic.Height / Scale);
x := rcImage.Left + (rcImage.Right-rcImage.Left - xStretch) div 2;
y := rcImage.Top + (rcImage.Bottom-rcImage.Top - yStretch) div 2;
rcStretch := Rect(x, y, x+xStretch, y+yStretch);
Canvas.StretchDraw(rcStretch, Graphic);
end;
Windows.FillRect(Canvas.Handle, rcText,
GetSysColorBrush(COLOR_MENU));
SetTextColor(Canvas.Handle, GetSysColor(COLOR_MENUTEXT));
SetBkColor(Canvas.Handle, GetSysColor(COLOR_MENU));
DrawText(Canvas.Handle, PChar(ImageInfoToStr(Graphic)), -1, rcText,
DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;
end;
finally
Canvas.Handle := 0;
Canvas.Free;
RestoreDC(adc, nSaveDC);
end;
end;
function ImageInfoToStr(Graphic: TGraphic): string;
begin
Result := Format('%d * %d', [Graphic.Width, Graphic.Height]);
if Graphic is TIcon then
Result := Result + ' 圖標';
if Graphic is TBitmap then begin
case TBitmap(Graphic).PixelFormat of
pfDevice: Result := Result + ' DDB';
pf1bit: Result := Result + ' 2 色';
pf4bit: Result := Result + ' 16 色';
pf8bit: Result := Result + ' 256 色';
pf15bit, pf16bit: Result := Result + '16 位色';
pf24bit: Result := Result + '24 位色';
pf32bit: Result := Result + '32 位色';
pfCustom: Result := Result + '自定義';
end;
Result := Result + '位圖';
end;
if Graphic is TMetaFile then
Result := Result + Format('(%d*%d) 元文件',
[TMetaFile(Graphic).MMWidth div 100, TMetaFile(Graphic).MMHeight div
100]);
if Graphic is TJPEGImage then begin
case TJPEGImage(Graphic).PixelFormat of
jf24Bit: Result := Result + ' 24 位色JPEG';
jf8Bit: Result := Result + ' 8 位色JPEG';
end;
end;
end;
總結
以上是生活随笔為你收集整理的Windows 外壳扩展编程入门实例的全部內容，希望文章能夠幫你解決所遇到的問題。
- 上一篇： 飞鸽传书完全不知道这是什么
- 下一篇： 今年第一个项目来说NET的中间语言