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

标签 delphi email drag-and-drop outlook thunderbird

是否有人已经实现了将电子邮件从 Outlook 和/或 Thunderbird(从现在开始“OT”)拖放到 Delphi 表单的功能。

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

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

修改后我想做的事情:

  1. 他们在 OT 中点击电子邮件,
  2. 将保存的文件拖放到 Delphi 表单上。

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

注意:我不需要支持所有 OT 版本。我可以接受不支持 Outlook 2003(例如),但不支持 2010。因此,如果该技术无法自动适用于所有 OT 版本,我会更喜欢适用于最新版本的技术。

最后说明:很明显,无论如何,我只对拖放电子邮件感兴趣(例如,对 Outlook 日历项目不感兴趣)。一个想法是拖放附件。但这可能是 future 的额外改进。

最佳答案

首先,如果您能找到一个现成的库可以开箱即用(例如 ldsandon 建议的库),请使用它,因为所有这些操作都是手动完成的 是痛苦和令人沮丧的。该文档有时不完整,并且可能包含错误:您最终会通过反复试验来完成一些事情,而 Google 不会拯救您,因为没有多少人深入研究 Ole 拖放功能,而其中大多数人这样做可能会使用现成的代码。

如何用普通的 Pascal 语言执行此操作

理论上,用于使应用程序处理 OLE Drop 的 API 非常简单。您所需要做的就是提供 IDropTarget 的实现执行您需要的操作并调用 RegisterDragDrop 的接口(interface)提供应用程序窗口和界面的句柄。

这是我的实现方式:

  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 , DragOverDragLeave考虑到我这样做是为了一个实验,这是微不足道的:我会接受一切:

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 收到的实际内容进行头部或尾部处理的问题。例如,在此流中找到电子邮件的主题:__substg1.0_800A001F 。在此流中找到消息正文:__substg1.0_1000001F 。对于一封简单的电子邮件,我收到了 59 个非零大小的流。

关于delphi - 如何实现从outlook邮件或thunderbird拖放到delphi表单?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/4756845/

相关文章:

delphi - 在Delphi中使用REST请求

email - 无法与主机 smtp.gmail.com 建立连接 [权限被拒绝 #13]

ios - 由多个文本字段组成的邮件表单

javascript - 带有可调整大小元素的 HTML 拖放仪表板

javascript - 修改 webkitdragdrop.js 使用类而不是 ID

string - Cmd字符串到delphi中的PAnsiChar

sql - delphi 中存储过程的返回值始终为空

delphi - WideString 与 Delphi 2009 中的 String 相同吗

python - 抓取网站后发送带有附件的电子邮件

reactjs - 如何解决 'react-dnd-html5-backend' 不包含默认导出?