Copyright © 2025 IMIBO. Privacy Statement
Extended MAPI in DELPHI
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;