利用delphi編寫windows外殼擴展

對於操作系統原理比較了解的朋友都會知道，一個完備的操作系統都會提供了一個外殼（shell），以方便普通的用戶使用操作系統提供的各種功能。windows（在這裡指的是windows 95\windows 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_root\clsid鍵之下進行注冊。在該鍵下面可以找到許多名字像{0000002f-0000-0000-c000-000000000046}的鍵，這類鍵就是全局唯一類標識符(guid)。每一個外殼擴展都必須有一個全局唯一類標識符，windows正是通過此唯一類標識符來找到外殼擴展處理程序的。

在類標識符之下的inprocserver32子鍵下記錄著外殼擴展動態鏈接庫在系統中的位置。與某種文件類型關聯的外殼擴展注冊在相應類型的shellex主鍵下。如果所處的windows操作系統為windows nt，則外殼擴展還必須在注冊表中的HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\ShellExtensions\Approved主鍵下登記。編譯完外殼擴展的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('*\shellex\ContextMenuHandlers', '', '');
      CreateRegKey('*\shellex\ContextMenuHandlers\FileOpreation', '', ClassID);
    file://如果操作系統為Windows NT的話
      if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      with TRegistry.Create do
      try
         RootKey := HKEY_LOCAL_MACHINE;
         OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
         OpenKey('Approved', True);
         WriteString(ClassID, 'Context Menu Shell Extension');
      finally
         Free;
      end;
   end
   else begin
      DeleteRegKey('*\shellex\ContextMenuHandlers\FileOpreation');
      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 中在任意的一個或者幾個文件中點擊鼠標右鍵，在上下文菜單中就會多一個文件操作的菜單項，點擊該項，在彈出窗口的列表中會列出你所選擇的所有文件的文件名，你可以選擇拷貝文件按鈕或者移動文件按鈕執行文件操作。