Delphi外壳拖放控制扩展

当你的系统安装了Winzip之后，当把任意一个文件拖放到ZIP文件上后，你会发现鼠标的光标变成了一个+字符号样，你一松开鼠标，就会调用Winzip询问你是否要把拖放的文件加入当前的Zip文件里去，可是我们试了一下别的文件却没有这种功能，这表明缺省情况下，文件不是拖放目标，那么Winzip是如何做到的?

    实际上只要实现一个被拖放的文件类的拖放扩展就可以很简单地做到了。当一个文件类型注册了一个拖放扩展后，任何时候一个外壳对象被拖放到文件类型的一个成员上时，外壳管理器都会自动调用扩展的IDropTarget的相应方法。

注册扩展

    拖放扩展注册只需要在子键HKEY_CLASSES_ROOT\ProgID\Shellex\ DropHandler 下创建一个 DropHandler子键，然后设定键值为扩展的类标示符（CLSID GUID）的字符串形式即可。示例如下：

    ...

    MyProgram.1=MyProgram Application

      Shellex

        DropHandler

          MyCommand={00000000-1111-2222-3333-444444444444}

实现扩展

    同前面讲的类似，我们需要实现一个支持IPersistFile 和 IDropTarget接口的COM对象。

    正如在前面讲的，外壳通过IPersistFile接口传递给扩展被拖放的文件名。在扩展初始化后，外壳会调用拖放扩展的IDropTarget的合适方法。接下来的IPersistFile接口的实现同前面飞跃提示的相同接口的实现几乎完全一样，都是通过这个接口获得要操作的文件名，并将其保存。而IDropTarget接口的实现在前面的基于COM的拖放技术部分已经进行了详细的介绍，这里就不再赘述了，需要说明的一点是，在Winzip拖放过程中，拖放的目标（Target）是ZIP文件。

    下面是一个拖放扩展的例子，它唯一的功能就是把所有拖放的文件名写到一个文本文件中，下面是它实现的全部源代码，重要的部分都添加了注释：

    unit ContextM;

    interface

    uses

      Windows, ActiveX, ComObj, ShlObj;

    type

      TDropHandler = class(TComObject, IShellExtInit, IUnknown, IPersistFile, IDropTarget)

      private

      FFileName: array[0..MAX_PATH] of Char;

        Nfiles: integer;

        FFiles: array[0..max_PATH] of PChar;

        dest: string;

      protected

        { IShellExtInit }

        function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning

        function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;

        hKeyProgID: HKEY): HResult; stdcall;

        { IPersistFile }

        function IsDirty: HResult; stdcall;

        function Load(pszFileName: POleStr; dwMode: Longint): HResult; stdcall;

        function Save(pszFileName: POleStr; fRemember: BOOL): HResult; stdcall;

        function SaveCompleted(pszFileName: POleStr): HResult; stdcall;

        function GetCurFile(out pszFileName: POleStr): HResult; stdcall;

        function GetClassID(out classID: TCLSID): HResult; stdcall;

        { IDropTarget }

        function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;  pt: TPoint; var dwEffect: Longint): HResult; stdcall;

        function DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;

        function DragLeave: HResult; stdcall;

        function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;

      end;

    const

      Class_DropHandler: TGUID = '{574AF620-AC3D-11D4-86B6-92AD195EF923}';

    implementation

    uses ComServ, SysUtils, ShellApi, Registry;

    function TDropHandler.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;

      hKeyProgID: HKEY): HResult;

    var

      StgMedium: TStgMedium;

      FormatEtc: TFormatEtc;

    begin

    if (lpdobj = nil) then

      begin

        Result := E_INVALIDARG;

        Exit;

      end;

      with FormatEtc do

      begin

        cfFormat := CF_HDROP;

        ptd := nil;

        dwAspect := DVASPECT_CONTENT;

        lindex := -1;

        tymed := TYMED_HGLOBAL;

      end;

      // Render the data referenced by the IDataObject pointer to an HGLOBAL

      // storage medium in CF_HDROP format.

      Result := lpdobj.GetData(FormatEtc, StgMedium);

      if Failed(Result) then Exit;

        Result := NOERROR;

        ReleaseStgMedium(StgMedium);

    end;

    function TDropHandler.IsDirty: HResult;

    begin

      Result := E_NOTIMPL;

    end;

    function TDropHandler.Load(pszFileName: POleStr; dwMode: Integer): HResult;

    begin

      // 获得被拖放的文件的完全路径名，并将其保存在变量中

      DestFile:=WideCharToString(pszFileName);

      Result := S_OK;

    end;

    function TDropHandler.Save(pszFileName: POleStr; fRemember: BOOL): HResult;

    begin

      Result := E_NOTIMPL;

    end;

    function TDropHandler.SaveCompleted(pszFileName: POleStr): HResult;

    begin

      Result := E_NOTIMPL;

    end;

    function TDropHandler.DragEnter(const dataObj: IDataObject; grfKeyState: Longint;  pt: TPoint; var dwEffect: Longint): HResult; stdcall;

    var

      StgMedium: TStgMedium;

      FormatEtc: TFormatEtc;

      hr: HRESULT;

    begin

      with FormatEtc do

      begin

        cfFormat := CF_HDROP;

        ptd := nil;

        dwAspect := DVASPECT_CONTENT;

        lindex := -1;

        tymed := TYMED_HGLOBAL;

      end;

      hr := dataobj.QueryGetData(formatetc);

      if Failed(hr) then

      begin

        // 如果无法获得数据，就返回一个无效的拖放效果

        dwEffect:=DROPEFFECT_NONE;

        Result := E_FAIL;

        Exit;

      end

      else

      begin

        // 如果一切OK，就需要返回一个复制操作效果

        dwEffect:=DROPEFFECT_COPY;

        Result := NOERROR;

      end;

    end;

    function TDropHandler.DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;

    begin

      dwEffect:=DROPEFFECT_COPY;

      Result := S_OK;

    end;

    function TDropHandler.DragLeave: HResult; stdcall;

    begin

      Result := S_OK;

    end;

    function TDropHandler.Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;

    var

      StgMedium: TStgMedium;

      FormatEtc: TFormatEtc;

      hr: HRESULT;

      F: TextFile;

    begin

      // 这是整个单元中最重要的部分，文件被释放到拖放目标上

      // 在这里我们的扩展将把所有被拖放的文件名写到一个文本文件中

      if (dataobj = nil) then

      begin

        Result := E_INVALIDARG;

        Exit;

      end;

      with FormatEtc do

      begin

        cfFormat := CF_HDROP;

        ptd := nil;

        dwAspect := DVASPECT_CONTENT;

        lindex := -1;

        tymed := TYMED_HGLOBAL;

      end;

      //利用IDataObject获得数据

      hr := dataobj.GetData(FormatEtc, StgMedium);

      if Failed(hr) then Exit;

        // 将所有被拖放的文件写到指定文件中

        NFiles:=DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0);

        // 有多少文件被拖放？

        AssignFile(F,'C:\Windows\Desktop\DroppedFiles.txt');

        Rewrite(f);

        for i:=0 to nfiles-1 do

        begin

          // 读取拖放文件列表，并将文件名记录下来

          DragQueryFile(StgMedium.hGlobal, i, FFileName , SizeOf(FFilename));

          writeln(F, FFilename);

          // 如果拖放对象是一个目录，就记录目录名

          if GetFileAttributes(FFilename)=faDirectory then writeln (f,'Folder -> '+ffilename);

        end;

        //记录下拖放的目标文件名

        writeln(f,'Drop Target -> '+DestFile);

        CloseFile(f);

        Result := NOERROR;

        ReleaseStgMedium(StgMedium);

    end;

    function TDropHandler.GetClassID(out classID: TCLSID): HResult;

    begin

      Result := E_NOTIMPL;

    end;

    function TDropHandler.GetCurFile(out pszFileName: POleStr): HResult;

    begin

      Result := E_NOTIMPL;

    end;

    type

      TDropHandlerFactory = class(TComObjectFactory)

      public

      procedure UpdateRegistry(Register: Boolean); override;

    end;

    procedure TDropHandlerFactory.UpdateRegistry(Register: Boolean);

    var

      ClassID: string;

    begin

      if Register then begin

        inherited UpdateRegistry(Register);

        ClassID := GUIDToString(Class_DropHandler);

        // 这里我们设定.Dpr文件为我们要处理的文件类

        CreateRegKey('DelphiProject\shellex', '', '');

        CreateRegKey('DelphiProject\shellex\DropHandler', '', ClassID);

        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, 'Delphi 4.0 Drop Handler Shell Extension Example');

          finally

            Free;

          end;

      end

      else begin

        DeleteRegKey('DelphiPorject\shellex\DropHandler');

        DeleteRegKey('DelphiProject\shellex');

        inherited UpdateRegistry(Register);

      end;

    end;

    initialization

      TDropHandlerFactory.Create(ComServer, TDropHandler, Class_DropHandler,

      '', 'Delphi 4.0 Drop Handler Shell Extension Example', ciMultiInstance,

      tmApartment);

    end.

    最后，编译好DLL后，用命令行 regsvr32 c:\windows\desktop\ drophandle.dll注册扩展。然后，拖放程序试验一下，就会发现生成了我们预想中的文件。