如何实现从outlook邮件或thunderbird拖放到delphi表单？

Question

有没有人已经实现了从Outlook和/或Thunderbird（ 从现在的“OT” ）到Delphi表单的电子邮件拖放。

我需要为用户提供一种在我的应用程序数据库中存储重要电子邮件的方法，而无需编写OT插件。 目前他们使用这种技术：

1. 从OT他们点击一封电子邮件，
2. 另存为...
3. 保存在桌面或临时文件夹中，
4. 将保存的文件拖放到Delphi表单上。

在修改之后我想做：

1. 从OT他们点击一封电子邮件，
2. 将保存的文件拖放到Delphi表单上。

所以基本上我是从资源管理器中实现拖放。 我需要一个额外的层，允许我的应用程序将原来在OT上的电子邮件视为普通文件，因此我可以从OT拖动，就像它是一个普通的Windows资源管理器窗口一样。

注意：我不需要支持所有OT版本。 我可以接受不支持Outlook 2003（例如）但不支持2010.因此，如果该技术不能自动适用于所有OT版本，我将更喜欢使用最新版本的版本。

最后的说明：很明显，我只对拖放电子邮件感兴趣（例如，不是Outlook日历项目）。 一个想法是拖动和删除附件。 但这可能是未来的额外改进。

Answer 1

首先，如果你能找到一个现成的库来开箱即用（就像ldsandon建议的那样 ）使用它，因为手工完成所有这些都是痛苦和令人沮丧的。 文档有时是不完整的，可能包含错误：你最终会通过反复试验来做事情，谷歌不会拯救你，因为很多人都没有深入研究Ole拖放的深度，而且大多数都是那可能会使用现成的代码。

如何在普通Pascal中执行此操作

从理论上讲，用于使应用程序处理OLE drop的API非常简单。 您需要做的就是提供IDropTarget接口的实现，它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;

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;

真正的工作将在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;

此代码接受“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"

Msdn的文档明确说“lindex”的唯一有效值是-1：猜猜是什么，-1不起作用，0确实如此！

然后是这一短代码：

Response := Storage.OpenStream(ST_TAG.pwcsName, nil, STGM_READ or STGM_SHARE_EXCLUSIVE, 0, Stream);

具体来说，这两个有关：

STGM_READ or STGM_SHARE_EXCLUSIVE

获得这种组合是一个试错的问题。 我不喜欢反复试验：这是我想要的最佳标志组合吗？ 这会在每个平台上运行吗？ 我不知道...

然后是从Outlook收到的实际内容的头部或尾部的问题。 例如，在此流中找到了电子邮件的SUBJECT： __substg1.0_800A001F 。 在此流中找到了消息正文： __substg1.0_1000001F 。 对于一个简单的电子邮件消息，我得到了59个非零大小的流。

Answer 2

您必须使用OLE拖放 ，但是您必须能够处理您收到的数据，因为每个应用程序都可以以自己的格式存储数据。 你可以找到一个不错的Delphi实现OLE拖放的位置

Outlook Express和Thunderbird应该以RFC2822格式或类似的方式传输数据，Outlook可能会以自己的消息格式传输数据，它应该被记录为Microsoft Open Specification程序的一部分