delphi - 将 IDropTarget.Drop 方法中获取的 IDataObject 转换为 Outlook 消息并将其保存在磁盘上

Question

我需要对用户在表单上的拖放操作使用react。从资源管理器接受文件并不困难，但接受 OLE 对象(Outlook 电子邮件)放置对我来说就很难处理了。

到目前为止，我有一个已实现 IDropTarget 接口(interface)的 Delphi 表单。

  IDropTarget = interface(IUnknown)
    ['{00000122-0000-0000-C000-000000000046}']
    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;

这是 Drop 方法的实现:

function TForm1.Drop(const dataObj: IDataObject; grfKeyState: Integer;
  pt: TPoint; var dwEffect: Integer): HResult;
var
   aFmtEtc: TFORMATETC;
   aStgMed: TSTGMEDIUM;
   pData: PChar;
 begin


   if (dataObj = nil) then
     raise Exception.Create('IDataObject-Pointer is not valid!');
   with aFmtEtc do
   begin
     cfFormat := CF_UNICODETEXT;
     ptd := nil;
     dwAspect := DVASPECT_CONTENT;
     lindex := 0;
     tymed := TYMED_ISTREAM Or TYMED_ISTORAGE;
   end;

   {Get the data}
   OleCheck(dataObj.GetData(aFmtEtc, aStgMed));
   try

     {Lock the global memory handle to get a pointer to the data}
     pData := GlobalLock(aStgMed.hGlobal);
     { Replace Text }
     Memo1.Text := pData;
   finally
     {Finished with the pointer}
     GlobalUnlock(aStgMed.hGlobal);
     {Free the memory}
     ReleaseStgMedium(aStgMed);
   end;
   Result := S_OK;
 end;

此实现将消息预览添加到备忘录中。

如何将从 Outlook 收到的邮件保存到硬盘上？我会欣赏任何语言的示例，即使是伪代码。

Answer 1

我之前处理过 Outlook IDataObject。

Outlook 公开与 Explorer 中的常规 shell 对象相同的 CFSTR_FILEDESCRIPTOR/CFSTR_FILECONTENTS。

当我枚举 IDataObject 中的格式时，我看到它们:

0:  cfFormat: TClipFormat = "RenPrivateSourceFolder" (49972)
    tymed: Longint = 4  (TYMED_ISTREAM)

1:  cfFormat: TClipFormat = "RenPrivateMessages" (49587)
    tymed: Longint = 4  (TYMED_ISTREAM)

2:  cfFormat: TClipFormat = "RenPrivateItem" (49812)
    tymed: Longint = 1  (TYMED_HGLOBAL)

3:  cfFormat: TClipFormat = CFSTR_FILEDESCRIPTOR ("FileGroupDescriptor", 49281)
    tymed: Longint = 1  (TYMED_HGLOBAL)

4:  cfFormat: TClipFormat = CFSTR_FILEDESCRIPTORW ("FileGroupDescriptorW", 49280)
    tymed: Longint = 1  (TYMED_HGLOBAL)

5:  cfFormat: TClipFormat = "FileNameW" (49159)
    tymed: Longint = 2  (TYMED_FILE)

6:  cfFormat: TClipFormat = CFSTR_FILECONTENTS ("FileContents", 49282)
    tymed: Longint = 12  (TYMED_ISTREAM, TYMED_ISTORAGE)

7:  cfFormat: TClipFormat = "Object Descriptor" (49166)
    tymed: Longint = 1  (TYMED_HGLOBAL)

8:  cfFormat: TClipFormat = CF_TEXT (1)
    tymed: Longint = 1  (TYMED_HGLOBAL)

9:  cfFormat: TClipFormat = CF_UNICODETEXT (13)
    tymed: Longint = 1  (TYMED_HGLOBAL)

10: cfFormat: TClipFormat = "CSV" (49993)
    tymed: Longint = 1  (TYMED_HGLOBAL)

我在拖放到VirtualStringTree上时使用拖放，但 shell 概念是相同的。我可以重新发布我的代码片段(最终将 Outlook 电子邮件保存到数据库中)

function HandleOleDrop(DataObject: IDataObject; var DropEffect: TDropEffect;
    FileContentsCallback: TFileContentsCallback;
    FilenameCallback: TFilenameCallback;
    BitmapCallback: TBitmapCallback;
    StreamCallback: TStreamCallback): HResult;
var
    enum: IEnumFORMATETC;
    OLEFormat: TFormatEtc;
    Fetched: Integer;
begin
    //Go through the formats list in order, looking for the formats we understand.
    //The order they are given to us is the order the original application's idea
    //of better to worse
   Result := DataObject.EnumFormatEtc(DATADIR_GET, enum);
   if Failed(Result) then
      Exit;

   Result := enum.Reset;
   if Failed(Result) then
      Exit;

    while enum.Next(1, OLEFormat, @Fetched) = S_OK do
   begin
        OutputDebugString(PChar('[HelpDeskShellOperations.HandleOleDrop] ClipboardFormat = ' + ClipFormatToStr(OleFormat.cfFormat)));
      if OLEFormat.cfFormat = CF_FILEDESCRIPTOR then
    begin
            //Transfer data as if it were a file, regardless of how it is actually stored
            //If CF_FILEDESCRIPTOR is present, then a CF_FILECONTENTS must also be
            //present later on in the formats list
            Result := GetFileContents(DataObject, DropEffect, FileContentsCallback);
            Break;
        end
        else if OleFormat.cfFormat = CF_HDROP then
        begin
            Result := GetHDropContents(DataObject, DropEffect, FilenameCallback);
            Break;
        end
        else if OleFormat.cfFormat = CF_BITMAP then
        begin
            Result := GetBitmapContents(DataObject, DropEffect, BitmapCallback);
            Break;
        end;
{       else if OleFormat.cfFormat = CF_PNGStream then
        begin
            Result := GetStreamContents(OleFormat.cfFormat, DataObject, 'untitled.png', DropEffect, StreamCallback);
            Break;
        end
        else if OleFormat.cfFormat = CF_GIFStream then
        begin
            Result := GetStreamContents(OleFormat.cfFormat, DataObject, 'untitled.gif', DropEffect, StreamCallback);
            Break;
        end
        else if OleFormat.cfFormat = CF_JFIFStream then
        begin
            Result := GetStreamContents(OleFormat.cfFormat, DataObject, 'untitled.jpeg', DropEffect, StreamCallback);
            Break;
        end;}

        //      else if Formats[i] = ... then
        //      begin
         //Handle another format
      //            Break;
      //        end
   end;
end;

上面的技巧是我们枚举IDataObject 包含的格式。我们喜欢CF_FILEDESCRIPTOR，并对其进行特殊处理:

function GetFileContents(DataObject: IDataObject; var Effect: TDropEffect; FileContentsCallback: TFileContentsCallback): HResult;
var
   hr: HResult;
   format: TFormatEtc;
   FileDescriptorMedium: TStgMedium;
   fgdGlobal: hGlobal; //global memory object where the descriptors are
   fgd: PFileGroupDescriptor; //descriptors
   Descriptors: PFileDescriptorArray; //helper to access descriptors dynamic array
   nItem: Integer;
   FileContentsMedium: TStgMedium;
   //   stm: IStream;
begin
   //1. Extract the CFSTR_FILEDESCRIPTOR format as a TYMED_HGLOBAL value.
   ZeroMemory(@format, SizeOf(TFormatEtc));
   format.cfFormat := CF_FILEDESCRIPTOR;
   format.dwAspect := DVASPECT_CONTENT;
   format.tymed := TYMED_HGLOBAL;
   ZeroMemory(@FileDescriptorMedium, SizeOf(FileDescriptorMedium));

   Result := DataObject.GetData(format, FileDescriptorMedium); //Free the medium at the end
   if Failed(Result) then
      Exit;
   try
      //2. The hGlobal member of the returned STGMEDIUM structure points to a
          //   global memory object. Lock that object by passing the hGlobal value
          //   to GlobalLock.
      fgdGlobal := FileDescriptorMedium.hGlobal;
      fgd := GlobalLock(fgdGlobal);
      try
         //3. Cast the pointer returned by GlobalLock to a FILEGROUPDESCRIPTOR pointer.
         //   It will point to a FILEGROUPDESCRIPTOR structure followed by one or more
         //   FILEDESCRIPTOR structures. Each FILEDESCRIPTOR structure contains a
         //   description of a file that is contained by one of the accompanying
         //   CFSTR_FILECONTENTS formats.
         Descriptors := Addr(fgd.fgd[0]);

         //4. Examine the FILEDESCRIPTOR structures to determine which one corresponds
         //   to the file you want to extract. The zero-based index of that
         //   FILEDESCRIPTOR structure is used to identify the file's
         //   CFSTR_FILECONTENTS format. Because the size of a global memory block is
         //   not byte-precise, use the structure's nFileSizeLow and nFileSizeHigh
         //   members to determine how many bytes represent the file in the global
         //   memory object.
         for nItem := 0 to fgd.cItems - 1 do
         begin
            //5. Call IDataObject::GetData with the cfFormat member of the FORMATETC
            //   structure set to the CFSTR_FILECONTENTS value and the lIndex member
            //   set to the index that you determined in the previous step. The tymed
            //   member is typically set to TYMED_HGLOBAL | TYMED_ISTREAM | TYMED_ISTORAGE.
            //   The data object can then choose its preferred data transfer mechanism.
            ZeroMemory(@format, SizeOf(TFormatEtc));
            format.cfFormat := CF_FILECONTENTS;
            format.dwAspect := DVASPECT_CONTENT;
            format.lindex := nItem;
            format.tymed := TYMED_HGLOBAL or TYMED_ISTREAM or TYMED_ISTORAGE;
            //NOTE: IStorage based files are a bitch to deal with
            ZeroMemory(@FileContentsMedium, SizeOf(FileContentsMedium));

            //Now get the file's contents
            hr := DataObject.GetData(format, FileContentsMedium);
            if Failed(hr) then
               Continue;
            try
               {
                Progress: nItem+1 of fgd.cItems
               }

                       //6. The STGMEDIUM structure that IDataObject::GetData returns will
                       //   contain a pointer to the file's data. Examine the tymed member of
                       //   the structure to determine the data transfer mechanism.

               { i now have afile's name/size/date/etc in
                 Descriptors[nItem]
                and the guts of file in
                 FileContentsMedium
                (which could actually be in an hGlobal, IStream or IStorage.
                Use ConvertStorageMediumToIStream to convert whatever it is into an IStream)
               }
          //  stm := ConvertStorageMediumToIStream(FileContentsMedium);

               if Assigned(FileContentsCallback) then
                  FileContentsCallback(Descriptors[nItem], FileContentsMedium, nItem + 1, fgd.cItems);
            finally
               //Call ReleaseStgMedium to release the global memory object.
               ReleaseStgMedium(FileContentsMedium);
            end;
         end;
      finally
         GlobalUnlock(fgdGlobal);
      end;
   finally
      ReleaseStgMedium(FileDescriptorMedium);
   end;
end;

我的应用程序有一个回调，因此它可以将文件放在它想要的位置。就我而言，我将文件填充到一个对象中，以便稍后可以将其保存到数据库中:

function TfrmTicketDetail.FileContentsCallback(const Descriptor: TFileDescriptor; const medium: TStgMedium; Progress: Integer; MaxProgress: Integer): Boolean;
var
    szFilename: string;
    Attachment: TAttachment;
    ListItem: TVirtualListItem;
    stm: IStream;
    vclStream: TStream;
begin
    try
        szFilename := descriptor.cFilename;

        Attachment := TAttachment.Create(dmodGlobal.ADOConnection);

        Attachment.RecordID := ToolKit.CreateGUID;
        Attachment.AutoGenerateRecordID := false;
        Attachment.setStateNew;
        Attachment.PrevState := Attachment.State;
        Attachment.IsLink := False;

        {Helpdesk attachments don't let you save the "date" of the attachment}
        if (descriptor.dwFlags and FD_CREATETIME) = FD_CREATETIME then
            Attachment.CreationDate := FileTimeToDateTime(descriptor.ftCreationTime)
        else if (descriptor.dwFlags and FD_WRITESTIME) = FD_WRITESTIME then
            Attachment.CreationDate := FileTimetoDateTime(descriptor.ftLastWriteTime)
        else
            Attachment.CreationDate := Now;

        Attachment.FileName := ExtractFileName(szFilename);
        Attachment.FullPath := ExtractFilePath(szFilename);
        Attachment.Extension := ExtractFileExt(szFilename);
        Attachment.Version := '';
        Attachment.Comment := '';
        Attachment.TicketGUID := StringToGUID(GUID);
        Attachment.UserGUID := StringToGUID(dmodGlobal.UserGUID);

        stm := ConvertStorageMediumToIStream(medium);
        vclStream := TOleStream.Create(stm);
        Attachment.FileStream := vclStream;

        {Most often they don't fill in the file size structure member,
         so we have to go to the contents to find the size.}
        if (descriptor.dwFlags and FD_FILESIZE) = FD_FILESIZE then
        begin
            Attachment.Size := (Descriptor.nFileSizeLow and $7FFFFFFF);
            //Yes, i know, ignoring the upper 32-bits, and throwing away the "sign" bit.
            //If you wanna change the database to handle an unsigned 64-bit, you BE MY GUEST - jerk wad
            //descriptor.nFileSizeLow or (descriptor.nFileSizeHigh shl 32)
        end
        else
        begin
            Attachment.Size := Integer(GetIStreamSize(stm) and $7FFFFFFF);
        end;

        //Add it to the listivew
        ListItem := lvAttachments.Items.Add;
        ListItem.Data := Attachment;
        olAttachments.Add(Attachment);
        TAttachment.RefreshAttachmentListItem(ListItem);
        FFlags.SetFlags(FLAG_MODIFIED);
        SetStatus(STATUS_MODIFIED);

        Result := True;
    except
        on e: Exception do
        begin
            Result := False;
            MessageDlg('New Attachment Failed: ' + ToolKit.CRLF + e.Message, mtError, [mbOK], 0);
        end;
    end;
end;