Delphi外壳拖放控制扩展

2024-05-01 03:32•移动端•阅读 4084

当你的系统安装了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;

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;

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注册扩展。然后，拖放程序试验一下，就会发现生成了我们预想中的文件。

上一篇 »HTML5 拖放
下一篇 »Javascript拖拽&拖放系列文章1之offsetParent属性

Delphi外壳拖放控制扩展

相关推荐

javascript 拖放效果

拖放浮动效果——javascript

DELPHI中拖放的操作

Delphi项目中TWebBrowser与JS交互，window.external的一种简便实现方法

Delphi实现文件的拖放功能

VB控件间的拖放

asp.net中实现Gridview的多行拖放， 以及跨控件拖放

拖放文件到delphi中的事件处理

asp.net中实现Gridview的多行拖放，以及跨控件拖放