利用Delphi編寫Windows外殼擴充

利用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 中在任意的一個或者幾個檔案中點擊滑鼠右鍵，在操作功能表中就會
多一個檔案操作的功能表項目，點擊該項，在快顯視窗的列表中會列出你所選擇的所有檔案的檔案名稱，你可以選擇拷貝檔案按鈕或者
移動檔案按鈕執行檔案操作。