如何在我自己的程序中支持拖放URL(用Delphi或VC写的都可)(150分)

如何在我自己的程序中支持拖放URL
我也不知道该怎么正确描述这个问题，反正是我想在我的程序中
做到从拖放浏览器中的URL到自己的程序来取得URL的信息，就象
NetVampire或网络蚂蚁那样直接从浏览器中取得URL。

(用Delphi或VC写的都可)

我也想知道

什么意思?

呵呵，这个问题我刚刚遇到过（我写的FreeIP就支持拖放URL)。就是让自己的程序
可以接受OLE拖放。这需要申明一个COM对象，并支持IDropTarget接口。
下面DragDrop.pas不是我写的:
unit DragDrop;

interface

uses
Windows, ActiveX, ComObj,Dialogs,Sysutils;

type
TDropEvent = procedure(Sender:TObject;Msgchar)of object;
TTMyDrop = class(TComObject, IDropTarget)
private
FOnDroped: TDropEvent;
procedure SetOnDroped(const Value: TDropEvent);
protected
{Declare IDropTarget methods here}
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;
public
property OnDroped:TDropEvent read FOnDroped write SetOnDroped;
end;

const
Class_TMyDrop: TGUID = '{846C94F8-7649-11D2-9836-0000E82EA1B1}';

implementation

uses ComServ,unit1;

{ TTMyDrop }

function TTMyDrop.DragEnter(const dataObj: IDataObject;
grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
enumFormatEtc: IEnumFormatEtc;
f:TFORMATETC;
count:Integer;
Found:boolean;
begin
dataObj.EnumFormatEtc(DATADIR_GET,enumFormatEtc);
Found:=false;
while (enumFormatEtc.Next(1,f,@count)=S_OK)and (count>0) do
begin
if (f.cfFormat=CF_TEXT) then
begin
Found:=true;
Break;
end;
end;
if Found then
Result:=S_OK
else
begin
result:=E_INVALIDARG;
dwEffect:=DROPEFFECT_NONE;
end;
end;

function TTMyDrop.DragLeave: HResult;
begin
result := S_OK;
end;

function TTMyDrop.DragOver(grfKeyState: Integer; pt: TPoint;
var dwEffect: Integer): HResult;
begin
result := S_OK;
end;

function TTMyDrop.Drop(const dataObj: IDataObject; grfKeyState: Integer;
pt: TPoint; var dwEffect: Integer): HResult;
var
enumFormatEtc: IEnumFormatEtc;
f:TFORMATETC;
count:Integer;
Found:boolean;
medium: TStgMedium;
begin
dataObj.EnumFormatEtc(DATADIR_GET,enumFormatEtc);
Found:=false;
while (enumFormatEtc.Next(1,f,@count)=S_OK)and (count>0) do
begin
if (f.cfFormat=CF_TEXT) then
begin
Found:=true;
Break;
end;
end;
if not Found then
begin
result:=E_INVALIDARG;
dwEffect:=DROPEFFECT_NONE;
Exit;
end;
dataObj.GetData(f,medium);
if medium.tymed =1 then
begin
if Assigned(fOnDroped) then
begin
fOnDroped(Self,PChar(GlobalLock(medium.hglobal)));
GlobalUnLock(medium.hglobal);
end;
result := S_OK;
end;

end;

procedure TTMyDrop.SetOnDroped(const Value: TDropEvent);
begin
FOnDroped := Value;
end;

initialization
TComObjectFactory.Create(ComServer, TTMyDrop, Class_TMyDrop,
'TMyDrop', '', ciMultiInstance{, tmApartment});
end.

在自己的程序中，在FormCreate的时候,加入：

OleInitialize(NIL);
dd := TTMyDrop.Create;
dd.OnDroped:=DoDroped;
res1 := CoLockObjectExternal(dd, true, false);
res := RegisterDragDrop(Handle, IDropTarget(dd));

其中，DoDroped在拖放发生时被调用：
procedure TForm1.DoDroped(Sender: TObject; Msg: Pchar);
begin
...//此处最好不要有太耗时的工作，因为被拖出的程序（比如说是浏览器）
//要等待此事件结束
end;

在FormDestroy时：
RevokeDragDrop(Handle);
OleUninitialize;

一定要用COM对象吗？
用OLE2 接口就行了吧!
TTMyDrop = class(TInterfacedObject, IDropTarget)
这样用的资源更少，也不用包含与com有关的unit了，只用
包含activex就行了。
也不用产生TComObjectFactory。

tqz兄，你的方法我已试验通过，非常感谢！hfade兄你所说的有道理，不过
我没试过，也非常感谢能提供帮助。

多人接受答案了。

有一个小问题，我把OnDroped的事件触发的过程写为
ShowMessage(Msg);
但是我把接收窗口设为OnTop时，我拖拉到窗口释放鼠标后，
没有响应，必须要点击一下才行，这是为何