Visit our Sponsor   Visit our Sponsor
delphi3000.com - the free delphi knowledge platform
delphi3000.com - the free delphi knowledge platform
500 Users Online NOW
Have a look at your member-status

connecting people's knowledge


  - Recent ArticlesRSS feed for Recent Articles on delphi3000.com
  - List of All Articles
  - Top Viewed Articles
  - Articles (+Attachem.)
  - Articles Of Interest
  - Categories
  - Top Uploader
  - Search
  - Index

  - My Home
  - Submit an Article
  - My Articles
  - My Personal Data
  - My Bookmarks
  - Activities
  - Login/Logout

  - Sign Up
  - Why Sign Up
  - Newsletter

  - Press
  - Advertise

  - Contact
  - Feedback





Community
Borland
ClubeDelphi
Dr. Bob
UK-BUG
Delphi Meetings
Planeta Delphi



Loremo - the 1.5 liter car coming in 2009




Startblatt.de






Share this article with friendsShare this article with friends
Rate this articleRate this article - to keep the quality of delphi3000.com !
Comment this article or read through previous comments (12)


OLE Drag and DropFormat this article printer-friendly!Bookmark function is only available for registered users!
How to drop an email from Outlook into a Delphi form
Product:
Delphi 4.x (or higher)
Category:
OLE
Skill Level:
Scoring:
Last Update:
01/31/2003
Search Keys:
delphi delphi3000 article borland vcl code-snippet IDropTarget OleInitialize OLE COM ActiveX Drag Drop
Times Scored:
14
Visits:
6474
Uploader: Herbert Poltnik
Company:
Reference: Expert-Exchange
 
Question/Problem/Abstract:
I wonder if there is anyone knowing of a way to drag a mail from Outlook and drop it in a listview control (or something similar).
Answer:



Create a new unit called "olmailitem", select all the code in that unit, and replace with the code supplied below into it. Include this unit in your project. The object class TOlMailDragDrop allows you to set up a TWinControl (or decendant) to accept drag/drop mail items from Outlook.

Example:
--------
var
  olmdd:  TOlMailDragDrop;
begin
  olmdd:=TOlMailDragDrop.Create(ListView1);
end;

This will register ListView1 as a drop target, and the DragEnter code does checking to make sure the drop object is an Outlook mail item(s). There are 2 other things that need to be done in order for this to work;

1.) In the control's OnDragOver, the Accept variable needs to be set to true:

Example:
--------

procedure TForm1.ListView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
Accept:=True;

end;

2.) There needs to be a procedure assigned to OnDragDrop.

Example:
--------

procedure TForm1.ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);
var  maildrop:   TOlMailDrop;
    i:          Integer;
begin
with ListView1 do
begin
    ViewStyle:=vsReport;
    Columns.Clear;
    with Columns.Add do
    begin
       Caption:='From';
       Width:=100;
    end;
    with Columns.Add do
    begin
       Caption:='Subject';
       Width:=100;
    end;
    with Columns.Add do
    begin
       Caption:='Received';
       Width:=100;
    end;
    with Columns.Add do
    begin
       Caption:='Size';
       Width:=80;
    end;

    if (Source is TOlMailDrop) then
    begin
       maildrop:=TOlMailDrop(Source);
       for i:=0 to maildrop.ItemCount-1 do
       begin
          with ListView1.Items.Add do
          begin
             Caption:=maildrop.Items[i].From;
             SubItems.Add(maildrop.Items[i].Subject);
             SubItems.Add(maildrop.Items[i].Received);
             SubItems.Add(maildrop.Items[i].Size);
             // Body is also available
             // maildrop.Items[i].Body
          end;
       end;
    end;
end;
end;

In the OnDragDrop, check for (source is TOlMailDrop). If this it true, then cast the Source as a TOLMailDrop item. This class exposes and itemcount and Items[index] property. (zero based to count-1). The items property is a list that holds each mail item. The TOLMailItem is a packed record that is defined as follows:

type
POLMailItem    =  ^TOLMailItem;
TOlMailItem    =  packed record
    From:       String;
    Subject:    String;
    Received:   String;
    Size:       String;
    Body:       String;
end;

Using the TOlMailItem information, you get the same data that outlook displays and can save the information any way you desire.

Note: Do not attempt to save/persist the TOLMailDrop item that is sent in as Source. It is automatically freed when the OnDragDrop event is finished.


Anyways, hope this gets you started. Let me know if you run into problems

regards,
Russell



---------------------------------------------------------
Code for olmailitem
---------------------------------------------------------

unit olmailitem;

interface
uses
Windows, SysUtils, Classes, Controls, ExtCtrls, ShlObj, ComObj, ActiveX;

type
POLMailItem    =  ^TOLMailItem;
TOlMailItem    =  packed record
    From:       String;
    Subject:    String;
    Received:   String;
    Size:       String;
    Body:       String;
end;

type
TOlMailDrop    =  class(TObject)
private
    // Private declarations
    FItems:     TList;
protected
    // Protected declarations
    function    GetItemCount: Integer;
    procedure   AddItem(AItem: POLMailItem);
    function    GetItems(Index: Integer): TOLMailItem;
public
    // Public declarations
    constructor Create;
    destructor  Destroy; override;
    property    ItemCount: Integer read GetItemCount;
    property    Items[Index: Integer]: TOLMailItem read GetItems; default;
end;

type
TOlMailDragDrop=  class(TObject, IUnknown, IDropTarget)
private
    // Private declarations
    FRefCount:  Integer;
    FControl:   TWinControl;
protected
    // Protected declarations for IUnknown
    function    QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function    _AddRef: Integer; stdcall;
    function    _Release: Integer; stdcall;
    // Protected declarations for IDropTarget
    function    DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
    function    DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; reintroduce; stdcall;
    function    DragLeave: HResult; stdcall;
    function    Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
    // Protected declarations
public
    // Public declarations
    constructor Create(AControl: TWinControl);
    destructor  Destroy; override;
end;

implementation

// Cliboard formats that need to be registered
var
CF_FILECONTENTS:  Integer;
CF_FILEDESCRIPTOR:Integer;

function TOlMailDrop.GetItems(Index: Integer): TOLMailItem;
begin
// Return the item data
result:=POLMailItem(FItems[Index])^;
end;

procedure TOlMailDrop.AddItem(AItem: POLMailItem);
begin
// Add item to string list
FItems.Add(AItem);
end;

function TOlMailDrop.GetItemCount;
begin
// Return the count of mail items
result:=FItems.Count;
end;

constructor TOlMailDrop.Create;
begin
// Perform inherited
inherited Create;

// Set starting values
FItems:=TList.Create;
end;

destructor TOlMailDrop.Destroy;
var  polmi:      POLMailItem;
    i:          Integer;
begin
// Free the item data and list
for i:=FItems.Count-1 downto 0 do
begin
    polmi:=FItems[i];
    Dispose(polmi);
    FItems.Delete(i);
end;
FItems.Free;

// Perform inherited
inherited Destroy;
end;

function TOlMailDragDrop.DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
var  fc:         tagFORMATETC;
    stgm:       tagSTGMEDIUM;
    pstg:       IStorage;
    pstm:       IStream;
    accept:     Boolean;
begin
// Set default
accept:=False;

// Check for outlook mail item
fc.cfFormat:=CF_FILECONTENTS;
fc.ptd:=nil;
fc.dwAspect:=1;
fc.lindex:=0;
fc.tymed:=TYMED_ISTORAGE;
if dataObj.GetData(fc, stgm) = S_OK then
begin
    pstg:=IStorage(stgm.stg);
    // Hard coded to open the outlook message item stream
    if (pstg.OpenStream('__substg1.0_1000001E', nil, STGM_SHARE_EXCLUSIVE or STGM_READ, 0, pstm) = S_OK) then
    begin
       accept:=True;
       pstm:=nil;
    end;
    pstg:=nil;
    ReleaseStgMedium(stgm);
end;

// Dont allow drop if not an outlook mail item
if not(accept) then
begin
    result:=S_FALSE;
    exit;
end;

// Success
result:=S_OK;

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

end;

function TOlMailDragDrop.DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
var  accept:     Boolean;
begin

// Always return success
result:=S_OK;

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

end;

function TOlMailDragDrop.DragLeave: HResult; stdcall;
var  accept:     Boolean;
    pt:         TPoint;
begin
// Always return success
result:=S_OK;

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

function TOlMailDragDrop.Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
var  oditem:     TOLMailDrop;
    stgm:       tagSTGMEDIUM;
    stgmitem:   tagSTGMEDIUM;
    tsitems:    TStringList;
    stat:       STATSTG;
    pstg:       IStorage;
    pstm:       IStream;
    polmi:      POLMailItem;
    fc:         tagFORMATETC;
    szhead:     String;
    buff:       PChar;
    pfgd:       PFileGroupDescriptor;
    dwCount:    Integer;
    dwfetch:    Integer;
begin
// Always return success
result:=S_OK;

// Allocate string list for text form of dropped mail items
tsitems:=TStringList.Create;

// Send the drop message to the control (subclassed as panel)
if Assigned(TPanel(FControl).OnDragDrop) then
begin
    // Create the OLE drop item
    oditem:=TOLMailDrop.Create;

    // Get the text first
    fc.cfFormat:=CF_TEXT;
    fc.ptd:=nil;
    fc.dwAspect:=1;
    fc.lindex:=-1;
    fc.tymed:=TYMED_HGLOBAL;
    if (dataObj.GetData(fc, stgm) = S_OK) then
    begin
       tsitems.Text:=String(PChar(GlobalLock(stgm.hGlobal)));
       GlobalUnlock(stgm.hGlobal);
       ReleaseStgMedium(stgm);
    end;

    // First line should contain the header, so remove it
    if (tsitems.Count > 0) then tsitems.Delete(0);

    // Get the file descriptors
    fc.cfFormat:=CF_FILEDESCRIPTOR;
    fc.ptd:=nil;
    fc.dwAspect:=1;
    fc.lindex:=-1;
    fc.tymed:=TYMED_HGLOBAL;
    if (dataObj.GetData(fc, stgm) = S_OK) then
    begin
       pfgd:=PFileGroupDescriptor(GlobalLock(stgm.hGlobal));
       // Iterate each of the files
       for dwCount:=0 to pfgd.cItems-1 do
       begin
          // Set up for getting the file data
          fc.cfFormat:=CF_FILECONTENTS;
          fc.ptd:=nil;
          fc.dwAspect:=1;
          fc.lindex:=dwCount;
          fc.tymed:=TYMED_ISTORAGE;
          if (dataObj.GetData(fc, stgmitem) = S_OK) then
          begin
             // IStorage (handle the outlook item)
             pstg:=IStorage(stgmitem.stg);
             // Hard coded to open the outlook message item stream
             if (pstg.OpenStream('__substg1.0_1000001E', nil, STGM_SHARE_EXCLUSIVE or STGM_READ, 0, pstm) = S_OK) then
             begin
                pstm.Stat(stat, STATFLAG_DEFAULT);
                buff:=AllocMem(stat.cbSize);
                pstm.Read(buff, stat.cbSize, @dwFetch);
                // Build the mail item
                New(polmi);
                // Parse the header record
                if (tsitems.Count > dwCount) then
                begin
                   szhead:=tsitems[dwcount];
                   polmi.From:=Copy(szhead, 1, Pos(#9, szhead)-1);
                   Delete(szhead, 1, Pos(#9, szhead));
                   polmi.Subject:=Copy(szhead, 1, Pos(#9, szhead)-1);
                   Delete(szhead, 1, Pos(#9, szhead));
                   polmi.Received:=Copy(szhead, 1, Pos(#9, szhead)-1);
                   Delete(szhead, 1, Pos(#9, szhead));
                   polmi.Size:=Copy(szhead, 1, Pos(#9, szhead)-1);
                   Delete(szhead, 1, Pos(#9, szhead));
                end
                else
                begin
                   polmi.From:='';
                   polmi.Subject:='';
                   polmi.Received:='';
                   polmi.Size:='';
                end;
                // Set the msg body
                polmi.Body:=String(buff);
                // Add the mail item
                oditem.AddItem(polmi);
                // Free buffer memory
                FreeMem(buff);
                // Free the stream
                pstm:=nil;
             end;
             // Free the storage
             pstg:=nil;
             // Release the storage medium
             ReleaseStgMedium(stgmitem);
          end;
       end;
       // Unlock the memory
       GlobalUnLock(stgm.hGlobal);
       // Release the storage medium
       ReleaseStgMedium(stgm);
    end;

    // Pass the OLE drop item as the source
    TPanel(FControl).OnDragDrop(FControl, oditem, pt.x, pt.y);

    // Free the string list
    tsitems.Free;
    
    // Free the OLE drop item
    oditem.Free;
end
else
    dwEffect:=DROPEFFECT_NONE;
end;

function TOlMailDragDrop.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
// Return the requested interface
if GetInterface(IID, Obj) then
    result:=S_OK
else
    result:=E_NOINTERFACE;
end;

function TOlMailDragDrop._AddRef: Integer;
begin
// Increment and return the ref count
Inc(FRefCount);
result:=FRefCount;
end;

function TOlMailDragDrop._Release: Integer;
begin
// Decrement and return the ref count
Dec(FRefCount);
result:=FRefCount;
end;

constructor TOlMailDragDrop.Create(AControl: TWinControl);
begin
// Perform inherited
inherited Create;

// Set ref count
FRefCount:=1;

// Set control and register as drop target
FControl:=AControl;
RegisterDragDrop(FControl.Handle, Self);
end;

destructor TOlMailDragDrop.Destroy;
begin
// Revoke the drop target
RevokeDragDrop(FControl.Handle);

// Perform inherited
inherited Destroy;
end;

initialization

// Initialize the OLE libraries
OleInitialize(nil);

// Register the clipboard formats that we need to handle in the
// OLE drag drop operation
CF_FILECONTENTS:=RegisterClipboardFormat(CFSTR_FILECONTENTS);
CF_FILEDESCRIPTOR:=RegisterClipboardFormat(CFSTR_FILEDESCRIPTOR);

finalization

OleUninitialize;

end.




also have a look at UNDU:
http://www.undu.com/Articles/990111b.html






Please rate this article!
Skill level:
BeginnerExpert

Useful:
No!Very!

Overall rating:
PoorExcellent



Comments to this article
Write a new comment
Why ListView Only
    Jerry Holder (Aug 27 2008 2:46AM)

This is a great rountine but I find the listview is more in my way than anything else.  I'd love to drop messages on any type of component but only the ListView accepts them.  Why is that??

thanks
Respond

meaning of substg1.0_1000001E & F
    David Hawk (May 18 2008 1:00AM)

Googling "substg1.0_1000001F" I found the following note:

   substg1.0_1000001F is when BODY is in unicode string
   substg1.0_1000001E is when bo(d)y stored in 8-bit character string
   (posted by Mike Shkolnik of Scalabium Software in borland.public.delphi.oleautomation 5/3/2007).

This is important if you want to retrieve the body of the email. The code in olmailitem.pas assumes 8-bit character string (as would be appropriate for the substg1.0_1000001E in the original code)

I found Outlook 2003 was returning unicode here.

Respond

RE: meaning of substg1.0_1000001E & F
Jerry Holder (Aug 14 2008 12:46AM)

This routine is really good.  Took me awhile, cause I'm not very bright, but eventually I got it working.  Great tip on the E vs. F thing.  Having sai all that, I am unable to get the body in at all.  It seems to pull the first character in but that's it.  Any [simple] ideas?

thanks
jerry

Respond

initialization and constants
    David Hawk (May 17 2008 12:51AM)

Brilliant article!  Thanks to earlier comments, it worked for me with Outlook 2003 and Turbo Delphi (2006).

Two notes:

- the constant Henk referred to ('__substg1.0_1000001F') needs to be changed in TWO  places in olmailitem.pas

- as noted, the olmdd variable can be declared as a private variable in the form.  It would then be initialized in FormCreate and freed in FormDestroy.

procedure TForm1.FormCreate(Sender: TObject);
begin
  olmdd:=TOlMailDragDrop.Create(ListView1);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  olmdd.Free
end;

Respond

Outlook or code problem?
    Henk van Hoek (Dec 24 2007 3:37PM)

I tried this on my PC with Outlook 2003, Delphi 2007 Enterprise, XP SP2.
It did not work.
MyResult := dataObj.GetData(fc, stgm);

MyResult became negative :  -2147221400

Any idea what could be wrong?
I tried different cfFormat settings. Just other nonzero results.

Henk


Respond

RE: Outlook or code problem?
Henk van Hoek (Dec 26 2007 4:51PM)

First of all.
The program worked not by dragging a outlook msg file to the application. That was the first mistake I made.

The second problem I encountered was the __substg1.0_1000001E string.
When I used the string __substg1.1000001F.
Watch the change from E to F as the last character. The program works.

I don't know where the strings I can use are defined and what they mean. Anybody?

Henk
Respond

dropping issues
    andrew radmore (Feb 3 2006 3:40PM)

I have followed this but Outlook dragged items dont seem to be triggering my drag events and I am wondering why?

I was wondering if it might be connected with

Example:
--------
var
  olmdd:  TOlMailDragDrop;
begin
  olmdd:=TOlMailDragDrop.Create(ListView1);
end;

as I was unsure what I was supposed to do with this.

Any help greatly appreciated

Andrew
Respond

RE: dropping issues
andrew radmore (Feb 7 2006 6:52PM)

Fixed the problems with this ;) all my fault *chuckles* Initialising it to late. Just working on getting the attachments now.

Thanx for this article it is great.
Respond

Exactly what I was looking for! - What about attachments?
    frank sorenstam (Nov 11 2005 10:11AM)

Thanks to the writer . Learned a lot.
How do we get the mail attachment files ?

Frank
Respond

RE: Exactly what I was looking for! - What about attachments?
Etem Emrah Alicli (Mar 5 2006 6:42AM)

I still could not make it run. In which part of my code I should create the object?
Any help greatly appreciated.

thanks
Respond

RE: RE: Exactly what I was looking for! - What about attachments?
B Pare (Nov 5 2007 11:50PM)

I also need help. Where do I need to put the initialization code?
Respond

RE: RE: RE: Exactly what I was looking for! - What about attachments?
Henk van Hoek (Dec 26 2007 4:54PM)

I have declared the olmdd: TOlMailDragDrop; in the private part of the TForm1 class.

See my other comment to this article. There is another issue you should know.

Henk
Respond














 
Sign up to consume product discounts for Bronze memberships !

read more


  Visit our Sponsor

 

  Community Ad of
S. Kucherov
 
   














 







     
  Copyright © 2000 - 2007 delphi3000.com - All rights reserved. Terms of use. || Privacy
delphi3000.com is a service by bluestep.com IT-Services GmbH (Vienna)