Development

Experimental # 5

We accept Microsoft Office Outlook Drag&Drop

There is no need to use third-party components to implement Drag-And-Drop of Messages from Microsoft Office Outlook.
Preserving our understanding that all you need is available from Delphi and Windows, we offer this example. Just run it and Drag-And-Drop *.msg from the file system, or Message from Microsoft Office Outlook.

That is all …

function TOutlookDropTarget.DragEnter(const DataObject: IDataObject;
  grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT; stdcall;
var
  FormatEtc: TFormatEtc;
  StgMedium: TStgMedium;
  Storage: IStorage;
  Accept: Boolean;
  StorageGUID: TGUID;
  cFiles: Cardinal;
  iCount: Integer;
  FileName: array [0 .. MAX_PATH - 1] of Char;
  pwcFileName: PWideChar;
begin
  Accept := False;
  // Is it IStorage ?
  FormatEtc.cfFormat := CF_FILECONTENTS;
  FormatEtc.ptd := nil;
  FormatEtc.dwAspect := DVASPECT_CONTENT;
  FormatEtc.lindex := 0;
  FormatEtc.tymed := TYMED_ISTORAGE;
  Storage := nil;

  if DataObject.GetData(FormatEtc, StgMedium) = S_OK then
  begin
    Storage := IStorage(StgMedium.stg);
    // is it Mail Message ???
    Accept := (Storage <> nil) and Succeeded(ReadClassStg(Storage, StorageGUID))
      and IsEqualGUID(CLSID_MailMessage, StorageGUID);
    Storage := nil;
    ReleaseStgMedium(StgMedium);
  end
  else
  begin
    FormatEtc.cfFormat := CF_HDROP;
    FormatEtc.ptd := nil;
    FormatEtc.dwAspect := DVASPECT_CONTENT;
    FormatEtc.lindex := 0;
    FormatEtc.tymed := TYMED_HGLOBAL;
    Storage := nil;
    if DataObject.GetData(FormatEtc, StgMedium) = S_OK then
    begin
      cFiles := DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0);
      for iCount := 0 to cFiles - 1 do
      begin
        if Accept then
          break;
        DragQueryFile(StgMedium.hGlobal, iCount, FileName, SizeOf(FileName));
        if GetFileAttributes(FileName) = faDirectory then
          Continue;

        pwcFileName := StringToOleStr(FileName);
        try
          if StgOpenStorage(pwcFileName, nil, STGM_TRANSACTED or
            STGM_SHARE_EXCLUSIVE or STGM_READWRITE, nil, 0, Storage) = S_OK then
            Accept := (Storage <> nil) and
              Succeeded(ReadClassStg(Storage, StorageGUID)) and
              IsEqualGUID(CLSID_MailMessage, StorageGUID);
        finally
          SysFreeString(pwcFileName);
          Storage := nil;
        end;
      end;

      ReleaseStgMedium(StgMedium);
    end;
  end;

  // Dont allow drop if not an Extended MAPI IMessage
  if not(Accept) then
  begin
    Result := S_FALSE;
    Exit;
  end;

  Result := S_OK;

  if FLink and BOOL(dwEffect and DROPEFFECT_LINK) then
    dwEffect := DROPEFFECT_LINK
  else
    dwEffect := DROPEFFECT_COPY;

  // Send the drag enter message to the control
  if Assigned(THackWin(FControl).OnDragOver) then
  begin
    Accept := False;
    THackWin(FControl).OnDragOver(FControl, Self, pt.x, pt.y,
      dsDragEnter, Accept);
    if not(Accept) then
      dwEffect := DROPEFFECT_NONE;
  end

end;

function TOutlookDropTarget.DragOver(grfKeyState: Longint; pt: TPoint;
  var dwEffect: Longint): HRESULT; stdcall;
var
  Accept: Boolean;
begin
  Result := S_OK;

  if FLink and BOOL(dwEffect and DROPEFFECT_LINK) then
    dwEffect := DROPEFFECT_LINK
  else
    dwEffect := DROPEFFECT_COPY;

  // Send the drag move message to the control
  if Assigned(THackWin(FControl).OnDragOver) then
  begin
    Accept := False;
    THackWin(FControl).OnDragOver(FControl, Self, pt.x, pt.y,
      dsDragMove, Accept);
    if not(Accept) then
      dwEffect := DROPEFFECT_NONE;
  end
  else
    dwEffect := DROPEFFECT_NONE;
end;

function TOutlookDropTarget.DragLeave: HRESULT; stdcall;
var
  Accept: Boolean;
  pt: TPoint;
begin
  Result := S_OK;

  // Send the drag record message to the control
  if Assigned(THackWin(FControl).OnDragOver) then
  begin
    Accept := False;
    pt := FControl.ScreenToClient(Point(0, 0));
    THackWin(FControl).OnDragOver(FControl, Self, pt.x, pt.y,
      dsDragLeave, Accept);
  end;
end;

function TOutlookDropTarget.Drop(const DataObject: IDataObject;
  grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT;
var
  StgMedium: TStgMedium;
  StgMediumItem: TStgMedium;
  Storage: IStorage;
  FormatEtc: TFormatEtc;
  FileGroupDescriptor: PFileGroupDescriptor;
  iCount: Integer;
  ExMAPIMessages: TExMAPIMessages;
  PGlobalLock: Pointer;
  StorageGUID: TGUID;
  cFiles: Cardinal;
  FileName: array [0 .. MAX_PATH - 1] of Char;
  pwcFileName: PWideChar;
begin
  Result := S_OK;

  if DataObject = nil then
    Exit;
  FileGroupDescriptor := nil;

  if Assigned(THackWin(FControl).OnDragDrop) then
  begin
    if FLink and BOOL(dwEffect and DROPEFFECT_LINK) then
      dwEffect := DROPEFFECT_LINK
    else
      dwEffect := DROPEFFECT_COPY;

    ExMAPIMessages := TExMAPIMessages.Create(FLink);

    // Get the file descriptors
    FormatEtc.cfFormat := CF_FILEDESCRIPTOR;
    FormatEtc.ptd := nil;
    FormatEtc.dwAspect := DVASPECT_CONTENT;
    FormatEtc.lindex := -1;
    FormatEtc.tymed := TYMED_HGLOBAL;

    if (DataObject.GetData(FormatEtc, StgMedium) = S_OK) then
    begin // 0
      PGlobalLock := GlobalLock(StgMedium.hGlobal);
      try
        iCount := SizeOf(UINT) + PFileGroupDescriptor(PGlobalLock)^.cItems *
          SizeOf(TFileDescriptor);
        GetMem(FileGroupDescriptor, iCount);
        Move(PFileGroupDescriptor(PGlobalLock)^, FileGroupDescriptor^, iCount);
      finally
        // Unlock the memory
        GlobalUnLock(StgMedium.hGlobal);
        // Release the storage medium
        ReleaseStgMedium(StgMedium);
      end;

      // Iterate each of the files
      for iCount := 0 to FileGroupDescriptor.cItems - 1 do
      begin

        // Set up for getting the file data
        FormatEtc.cfFormat := CF_FILECONTENTS;
        FormatEtc.ptd := nil;
        FormatEtc.dwAspect := DVASPECT_CONTENT;
        FormatEtc.lindex := iCount;
        FormatEtc.tymed := TYMED_ISTORAGE;

        if (DataObject.GetData(FormatEtc, StgMediumItem) = S_OK) then
        begin // 1
          if (StgMediumItem.tymed <> TYMED_ISTORAGE) then
          begin
            ReleaseStgMedium(StgMediumItem);
            Continue;
          end;

          Storage := IStorage(StgMediumItem.stg);

          if (ReadClassStg(Storage, StorageGUID) <> S_OK) or
            (IsEqualGUID(CLSID_MailMessage, StorageGUID) = False) then
          begin
            Storage := nil;
            ReleaseStgMedium(StgMediumItem);
            Continue;
          end;

          ExMAPIMessages.AddItem(Storage);
          Storage := nil;
          // Release the storage medium
          ReleaseStgMedium(StgMediumItem);
        end; // 1
      end; // for iCount:=0 to FileGroupDescriptor.cItems-1 do
    end // 0
    else
    begin
      FormatEtc.cfFormat := CF_HDROP;
      FormatEtc.ptd := nil;
      FormatEtc.dwAspect := DVASPECT_CONTENT;
      FormatEtc.lindex := -1;
      FormatEtc.tymed := TYMED_HGLOBAL;

      if (DataObject.GetData(FormatEtc, StgMedium) = S_OK) then
      begin // F0
        cFiles := DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0);
        for iCount := 0 to cFiles - 1 do
        begin
          // Storage:=nil;
          DragQueryFile(StgMedium.hGlobal, iCount, FileName, SizeOf(FileName));
          if GetFileAttributes(FileName) = faDirectory then
            Continue;
          pwcFileName := StringToOleStr(FileName);
          try
            if Succeeded(StgOpenStorage(pwcFileName, nil, STGM_TRANSACTED or
              STGM_SHARE_EXCLUSIVE or STGM_READWRITE, nil, 0, Storage)) and
              (Storage <> nil) and Succeeded(ReadClassStg(Storage, StorageGUID))
              and IsEqualGUID(CLSID_MailMessage, StorageGUID) then
              ExMAPIMessages.AddItem(Storage);

            // Storage:=nil;
          finally
            SysFreeString(pwcFileName);
          end;
        end; // for iCount:=0 to cFiles-1 do

        ReleaseStgMedium(StgMedium);
      end; // F0
    end; // else begin

    // Pass the items as the source
    THackWin(FControl).OnDragDrop(FControl, ExMAPIMessages, pt.x, pt.y);

    ExMAPIMessages.Free;

    if Assigned(FileGroupDescriptor) then
      FreeMem(FileGroupDescriptor);

  end
  else
    dwEffect := DROPEFFECT_NONE;
end;