此為轉貼資料 利用DELPHI編寫WINDOWS外殼 對於作業系統原理比較瞭解的朋友都會知道，一個完備的作業系統都會提供一個外殼（Shell），以方便普通用戶使用作業系統提供的各種功能。Windows（在這裏指的是Windows 95\Windows NT4.0以上版本的作業系統）的外殼不但提供了方便美觀的GUI圖形介面，而且還提供了強大的外殼擴展功能，大家可能在很多軟體中看到這些外殼擴展了。例如:如果你的系統中安裝了Winzip的話，當你在Windows Explore中滑鼠右鍵點擊文件夾或者文件時，彈出功能表中就會出現Winzip的壓縮功能表。 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物件的一些知識是十分必要的。 寫好外殼擴展程式後，必須將它們註冊才能生效。所有的外殼擴展都必須在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來動態地向功能表中增添功能表項的。本文要實現的Context Menu Handler將在任意類型文件物件的上下文相關功能表中添加一個文件操作功能表項，當點擊該項後，介面程式就會彈出一個文件操作視窗，執行文件拷貝、移動等操作。 編寫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 //如果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; dwAspect := 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 (HiWord(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 TContext Menu Factory =class(TCom Object Factory) 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); //當註冊擴展庫文件時，添加庫到註冊表中 CreateRegKey('＊\shellex', '', ''); CreateRegKey('＊\shellex\ContextMenuHandlers', '', ''); CreateRegKey('＊\shellex\ContextMenuHandlers\FileOpreation', '', ClassID); //如果作業系統?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 TContext Menu Factory.Create(Com Server, 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中在任意的一個或者幾個文件中點擊滑鼠右鍵，在上下文功能表中就會多一個文件操作的功能表項，點擊該項，在彈出窗口的列表中會列出你所選擇的所有文件的檔案名，你可以選擇拷貝文件按鈕或者移動文件按鈕執行文件操作。 以上程式在Windows98、Windows2000，Delphi5下運行通過。

------
**********************************************************
哈哈&兵燹
最會的2大絕招 這個不會與那個也不會 哈哈哈 粉好

Delphi K.Top的K.Top分兩個字解釋Top代表尖端的意思,希望本討論區能提供Delphi的尖端新知
K.表Knowlege 知識,就是本站的標語:Open our mind