利用Delphi編寫Windows外殼擴充套件 (轉)

利用Delphi編寫Windows外殼擴充套件 (轉)[@more@]

利用編寫外殼擴充套件
  對於操作原理比較瞭解的朋友都會知道，一個完備的都會提供了一個外殼（），以方便普通的
使用作業系統提供的各種功能。Windows（在這裡指的是Windows 954.0以上版本的作業系統）的外殼不但提供
了方便美觀的GUI圖形介面，而且還提供了強大的外殼擴充套件功能，大家可能在很多中看到這些外殼擴充套件了。例如在你的
系統中了的話，當你在Windows Explore中滑鼠右鍵點選夾或者檔案後，在彈出選單中就會出現Winzip的壓
縮選單。又或者Bullet 中在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 handlers在檔案被拖放、複製或者貼上時，就會被系統被呼叫。

　　Windows的所有外殼擴充套件都是基於COM(Component Object Model) 模型的，外殼是透過介面(Interface)來訪問物件的。
外殼擴充套件被設計成32位的程式中，並且都是以動態連結庫的形式為作業系統提供服務的。因此，如果要對Windows
的使用者介面進行擴充的話，則具備寫COM物件的一些知識是十分必要的。 由於篇幅所限，在這裡就不介紹COM，讀者可以參考
的MSDN庫或者相關的幫助文件，一個介面可以看做是一個特殊的類，它包含一組合過程可以用來操作一個物件。
  寫好外殼擴充套件程式後，必須將它們註冊才能生效。所有的外殼擴充套件都必須在Windows登錄檔的HKEY_CLASSES_CLSID鍵
之下進行註冊。在該鍵下面可以找到許多名字像{0000002F-0000-0000-C000-000000000046}的鍵，這類鍵就是全域性唯一類標識
符(Guid)。每一個外殼擴充套件都必須有一個全域性唯一類識別符號，Windows正是透過此唯一類識別符號來找到外殼擴充套件處理程式的。
在類識別符號之下的InProcServer32子鍵下記錄著外殼擴充套件動態連結庫在系統中的位置。與某種檔案型別關聯的外殼擴充套件註冊在
相應型別的shellex主鍵下。如果所處的Windows作業系統為Windows NT，則外殼擴充套件還必須在登錄檔中的
HKEY_LOCAL_MACHINESoftwareWindowsCurrentVersionShellExtensionsApproved主鍵下登記。
  編譯完外殼擴充套件的DLL程式後就可以用Windows本身提供的regsvr32.exe來註冊該DLL伺服器程式了。如果使用Delphi，也可
以在Run選單中選擇Register 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, Shell, Registry,UnitForm;

function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  hKeyProgID: HKEY): HResult;
var
  StgMedium: TStgMedium;
  FormatEtc: TFormatEtc;
  FileNumber,i:Integer;
begin
  果lpdobj等於Nil，則本呼叫失敗
  if (lpdobj = nil) then begin
  Result := E_INVALIDARG;
  Exit;
  end;

  先初始化並清空FileList以新增檔案
  FileList:=TStringList.Create;
  FileList.Clear;
  始化剪貼版格式檔案
  with FormatEtc do begin
  cfFormat := CF_HDROP;
  ptd := nil;
  dwect := DVASPECT_CONTENT;
  lindex := -1;
  tymed := TYMED_HGLOBAL;
  end;
  Result := lpdobj.GetData(FormatEtc, StgMedium);

  if Failed(Result) then Exit;

  先查詢使用者選中的檔案的個數
  FileNumber := DragQueryFile(StgMedium.hGlobal,$FFFFFFFF,nil,0);
  環讀取，將所有使用者選中的檔案儲存到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 (Hi(Integer(lpici.lpVerb)) <> 0) then
  begin
  Result := E_FAIL;
  Exit;
  end;
  // 確定傳遞的引數的有效性
  if (LoWord(lpici.lpVerb) <> 0) then begin
  Result := E_INVALIDARG;
  Exit;
  end;

  立檔案操作視窗
  frmOP:=TForm1.Create(nil);
  所有的檔案列表新增到檔案操作視窗的列表中
  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); overr;
end;

procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
var
  ClassID: string;
begin
  if Register then begin
  inherited UpdateRegistry(Register);
  ClassID := GUIDToString(Class_ContextMenu);
  註冊擴充套件庫檔案時，新增庫到登錄檔中
  CreateRegKey('*shellex', '', '');
  CreateRegKey('*shellexContextMenuHandlers', '', '');
  CreateRegKey('*shellexContextMenuHandlersFileOpreation', '', ClassID);

  果作業系統為Windows NT的話
  if (Platfo= 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;
  置檔案操作型別
  fsTemp.wFunc :=FO_COPY;
  許執行撤消操作
  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;

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 中在任意的一個或者幾個檔案中點選滑鼠右鍵，在上下文選單中就會
多一個檔案操作的選單項，點選該項，在彈出視窗的列表中會列出你所選擇的所有檔案的檔名，你可以選擇複製檔案按鈕或者
移動檔案按鈕執行檔案操作。