Solved

Outlook mail drag & drop

Posted on 2002-07-08
7
626 Views
Last Modified: 2012-01-31
Hi all,

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).

Code example or something similar would be great.

Thanks.
0
Comment
Question by:samone
  • 5
  • 2
7 Comments
 
LVL 26

Expert Comment

by:Russell Libby
ID: 7138932

samone,

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.
0
 
LVL 26

Expert Comment

by:Russell Libby
ID: 7138934

samone,

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.
0
 
LVL 26

Expert Comment

by:Russell Libby
ID: 7138935

samone,

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.
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 26

Accepted Solution

by:
Russell Libby earned 200 total points
ID: 7138942

Sorry for the double/triple posts. EE is a little quirky at times

Russell
0
 

Author Comment

by:samone
ID: 7140249
Thank you for a quick and working answer.

Do oyu also know how to tweak this to also include any attachments included in the mails.

//Samone
0
 
LVL 26

Expert Comment

by:Russell Libby
ID: 7140626

Samone,
Sorry, not sure how to pull in the attachment(s). (not without doing a fair amount of research to figure it out).
My offhand guess would be to use OLE Automation, but if you post it as a question, others here may have some better ideas.

Russell
0
 

Author Comment

by:samone
ID: 7140738
Ok thank you, will see if it's necassary, else I leave it.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Communication Between RC4 Delphi <-> PHP 3 101
Convert a string into a TDateTime 5 52
Adoquery sql  left join does not work 25 81
Firemonkey DbLookupComboBox equivalent ? 2 38
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
This Micro Tutorial will give you a basic overview how to record your screen with Microsoft Expression Encoder. This program is still free and open for the public to download. This will be demonstrated using Microsoft Expression Encoder 4.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

863 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

27 Experts available now in Live!

Get 1:1 Help Now