LaB*_*cca 7 delphi email outlook thunderbird drag-and-drop
有没有人已经实现了从Outlook和/或Thunderbird(从现在的"OT")到Delphi表单的电子邮件拖放.
我需要为用户提供一种在我的应用程序数据库中存储重要电子邮件的方法,而无需编写OT插件.目前他们使用这种技术:
在修改之后我想做:
所以基本上我是从资源管理器中实现拖放.我需要一个额外的层,允许我的应用程序将原来在OT上的电子邮件视为普通文件,因此我可以从OT拖动,就像它是一个普通的Windows资源管理器窗口一样.
注意:我不需要支持所有OT版本.我可以接受不支持Outlook 2003(例如)但不支持2010.因此,如果该技术不能自动适用于所有OT版本,我将更喜欢使用最新版本的版本.
最后的说明:很明显,我只对拖放电子邮件感兴趣(例如,不是Outlook日历项目).一个想法是拖动和删除附件.但这可能是未来的额外改进.
Cos*_*und 10
首先,如果你能找到一个现成的库来开箱即用(就像ldsandon建议的那样)使用它,因为手工完成所有这些都是痛苦和令人沮丧的.文档有时是不完整的,可能包含错误:你最终会通过反复试验来做事情,谷歌不会拯救你,因为很多人都没有深入研究Ole拖放的深度,而且大多数都是那可能会使用现成的代码.
从理论上讲,用于使应用程序处理OLE drop的API非常简单.您需要做的就是提供一个IDropTarget
接口的实现,它可以满足您的需求并调用RegisterDragDrop
为您的应用程序窗口和界面提供句柄.
以下是我的实现方式:
TDropTargetImp = class(TInterfacedObject, IDropTarget)
public
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;
Run Code Online (Sandbox Code Playgroud)
实施DragEnter
,DragOver
并且DragLeave
是微不足道的,考虑我正在做这个实验:我会接受一切:
function TDropTargetImp.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
begin
dwEffect := DROPEFFECT_COPY;
Result := S_OK;
end;
function TDropTargetImp.DragLeave: HResult;
begin
Result := S_OK;
end;
function TDropTargetImp.DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
begin
dwEffect := DROPEFFECT_COPY;
Result := S_OK;
end;
Run Code Online (Sandbox Code Playgroud)
真正的工作将在TDropTargetImp.Drop
.
function TDropTargetImp.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var iEnum: IEnumFORMATETC;
DidRead:LongInt;
F: TFormatEtc;
STG:STGMEDIUM;
Response:Integer;
Stream:IStream;
Storage: IStorage;
EnumStg: IEnumStatStg;
ST_TAG: STATSTG;
FileStream: TFileStream;
Buff:array[0..1023] of Byte;
begin
if dataObj.EnumFormatEtc(DATADIR_GET, iEnum) = S_OK then
begin
{
while (iEnum.Next(1, F, @DidRead) = S_OK) and (DidRead > 0) do
begin
GetClipboardFormatName(F.cfFormat, FormatName, SizeOf(FormatName));
ShowMessage(FormatName + ' : ' + IntToHex(F.cfFormat,4) + '; lindex=' + IntToStr(F.lindex));
end;
}
ZeroMemory(@F, SizeOf(F));
F.cfFormat := $C105; // CF_FILECONTENTS
F.ptd := nil;
F.dwAspect := DVASPECT_CONTENT;
F.lindex := 0{-1}; // Documentation says -1, practice says "0"
F.tymed := TYMED_ISTORAGE;
Response := dataObj.GetData(F, STG);
if Response = S_OK then
begin
case STG.tymed of
TYMED_ISTORAGE:
begin
Storage := IStorage(STG.stg);
if Storage.EnumElements(0, nil, 0, EnumStg) = S_OK then
begin
while (EnumStg.Next(1, ST_TAG, @DidRead) = S_OK) and (DidRead > 0) do
begin
if ST_TAG.cbSize > 0 then
begin
Response := Storage.OpenStream(ST_TAG.pwcsName, nil, STGM_READ or STGM_SHARE_EXCLUSIVE, 0, Stream);
if Response = S_OK then
begin
// Dump the stored stream to a file
FileStream := TFileStream.Create('C:\Temp\' + ST_TAG.pwcsName + '.bin', fmCreate);
try
while (Stream.Read(@Buff, SizeOf(Buff), @DidRead) = S_OK) and (DidRead > 0) do
FileStream.Write(Buff, DidRead);
finally FileStream.Free;
end;
end
else
case Response of
STG_E_ACCESSDENIED: ShowMessage('STG_E_ACCESSDENIED');
STG_E_FILENOTFOUND: ShowMessage('STG_E_FILENOTFOUND');
STG_E_INSUFFICIENTMEMORY: ShowMessage('STG_E_INSUFFICIENTMEMORY');
STG_E_INVALIDFLAG: ShowMessage('STG_E_INVALIDFLAG');
STG_E_INVALIDNAME: ShowMessage('STG_E_INVALIDNAME');
STG_E_INVALIDPOINTER: ShowMessage('STG_E_INVALIDPOINTER');
STG_E_INVALIDPARAMETER: ShowMessage('STG_E_INVALIDPARAMETER');
STG_E_REVERTED: ShowMessage('STG_E_REVERTED');
STG_E_TOOMANYOPENFILES: ShowMessage('STG_E_TOOMANYOPENFILES');
else
ShowMessage('Err: #' + IntToHex(Response, 4));
end;
end;
end;
end;
end
else
ShowMessage('TYMED?');
end;
end
else
case Response of
DV_E_LINDEX: ShowMessage('DV_E_LINDEX');
DV_E_FORMATETC: ShowMessage('DV_E_FORMATETC');
DV_E_TYMED: ShowMessage('DV_E_TYMED');
DV_E_DVASPECT: ShowMessage('DV_E_DVASPECT');
OLE_E_NOTRUNNING: ShowMessage('OLE_E_NOTRUNNING');
STG_E_MEDIUMFULL: ShowMessage('STG_E_MEDIUMFULL');
E_UNEXPECTED: ShowMessage('E_UNEXPECTED');
E_INVALIDARG: ShowMessage('E_INVALIDARG');
E_OUTOFMEMORY: ShowMessage('E_OUTOFMEMORY');
else
ShowMessage('Err = ' + IntToStr(Response));
end;
end;
Result := S_OK;
end;
Run Code Online (Sandbox Code Playgroud)
此代码接受"Drop",查找一些CF_FILECONTENTS,将其打开为TYMED_ISTORAGE,将该存储中的每个流丢弃到一个文件中C:\Temp\<stream_name>.bin
; 我尝试使用Delphi 2010和Outlook 2007,它可以正常工作:打开那些保存的文件(很多!)我可以通过电子邮件以意想不到的方式找到所有内容.我确定某处的文档可以准确地解释每个文件应该包含哪些内容,但我并不真正关心从Outlook接受拖放文件,所以我看起来并不远.再次,ldsandon的链接看起来很有希望.
这些代码看起来很短,但这不是困难的根源.这方面的文件确实缺乏; 我在每个角落都遇到了路障,从这开始:
F.lindex := 0{-1}; // Documentation says -1, practice says "0"
Run Code Online (Sandbox Code Playgroud)
Msdn的文档明确说"lindex"的唯一有效值是-1:猜猜是什么,-1不起作用,0确实如此!
然后是这一短代码:
Response := Storage.OpenStream(ST_TAG.pwcsName, nil, STGM_READ or STGM_SHARE_EXCLUSIVE, 0, Stream);
Run Code Online (Sandbox Code Playgroud)
具体来说,这两个有关:
STGM_READ or STGM_SHARE_EXCLUSIVE
Run Code Online (Sandbox Code Playgroud)
获得这种组合是一个试错的问题.我不喜欢反复试验:这是我想要的最佳标志组合吗?这会在每个平台上运行吗?我不知道...
然后是从Outlook收到的实际内容的头部或尾部的问题.例如,在此流中找到了电子邮件的SUBJECT : __substg1.0_800A001F
. 在这个流中找到了消息的正文:__substg1.0_1000001F
.对于一个简单的电子邮件消息,我得到了59个非零大小的流.
小智 7
您必须使用OLE拖放,但是您必须能够处理您收到的数据,因为每个应用程序都可以以自己的格式存储数据.你可以找到一个不错的Delphi实现OLE拖放的位置
Outlook Express和Thunderbird应该以RFC2822格式或类似的方式传输数据,Outlook可能会以自己的消息格式传输数据,它应该被记录为Microsoft Open Specification程序的一部分