麻豆小视频在线观看_中文黄色一级片_久久久成人精品_成片免费观看视频大全_午夜精品久久久久久久99热浪潮_成人一区二区三区四区

首頁 > 編程 > Delphi > 正文

利用Delphi編寫Windows外殼擴展

2019-11-18 18:58:55
字體:
來源:轉載
供稿:網友

利用Delphi編寫Windows外殼擴展
    對于操作系統原理比較了解的朋友都會知道,一個完備的操作系統都會提供了一個外殼(Shell),以方便普通的用戶
使用操作系統提供的各種功能。Windows(在這里指的是Windows 95Windows 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_ROOTCLSID鍵
之下進行注冊。在該鍵下面可以找到許多名字像{0000002F-0000-0000-C000-000000000046}的鍵,這類鍵就是全局唯一類標識
符(Guid)。每一個外殼擴展都必須有一個全局唯一類標識符,Windows正是通過此唯一類標識符來找到外殼擴展處理程序的。
在類標識符之下的InProcServer32子鍵下記錄著外殼擴展動態鏈接庫在系統中的位置。與某種文件類型關聯的外殼擴展注冊在
相應類型的shellex主鍵下。如果所處的Windows操作系統為Windows NT,則外殼擴展還必須在注冊表中的
HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionShellExtensionsApproved主鍵下登記。
    編譯完外殼擴展的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('*shellexContextMenuHandlers', ', ');
      CreateRegKey('*shellexContextMenuHandlersFileOpreation', ', ClassID);

    file://如果操作系統為Windows NT的話
      if (Win32Platform = 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;
    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 中在任意的一個或者幾個文件中點擊鼠標右鍵,在上下文菜單中就會
多一個文件操作的菜單項,點擊該項,在彈出窗口的列表中會列出你所選擇的所有文件的文件名,你可以選擇拷貝文件按鈕或者
移動文件按鈕執行文件操作。


上一篇:在Delphi中如何控制其它應用程序窗口

下一篇:利用Delphi消息處理建立類似Windows開始菜單

發表評論 共有條評論
用戶名: 密碼:
驗證碼: 匿名發表
學習交流
熱門圖片

新聞熱點

疑難解答

圖片精選

網友關注

主站蜘蛛池模板: 日本精品免费观看 | 亚洲自拍第一 | 免费在线观看国产精品 | 久久福利小视频 | 欧美成人性生活片 | 国产精品久久久久久影院8一贰佰 | 欧美在线一级 | 久久精品中文字幕一区二区 | 国产日韩中文字幕 | 国产免费一区二区三区在线能观看 | 久久久麻豆 | 免费在线观看成人av | 国产美女爽到喷白浆的 | 久久艹一区 | 91久久久久久久久久久久久久 | 欧美爱爱视频免费看 | 99精品视频一区二区三区 | 一级在线| 欧美日韩亚洲在线观看 | 黄色影院在线观看视频 | 久久久久久久久久久国产精品 | 最近日本电影hd免费观看 | 日韩视频在线一区二区三区 | av亚洲在线观看 | 中文字幕亚洲视频 | 七首小情歌泰剧在线播放 | 综合激情网 | 色屁屁xxxxⅹ在线视频 | 国产精品野外av久久久 | lutube成人福利在线观看 | avav在线播放| 斗罗破苍穹在线观看免费完整观看 | 黄色片视频免费观看 | 一级在线免费观看视频 | 一区二区三区欧美日韩 | 2021国产精品视频 | 亚洲一区二区三区日本久久九 | 欧美特黄a | 蜜桃网在线 | 中国洗澡偷拍在线播放 | 久久久一区二区精品 |