How can I simulate ‘Send To…’ with Delphi?

Default email client with selected files auto-attached

Default mail client with selected files auto-attached

The following code is based on these two articles:

Drop a FileListBox and a button on a form and set the FileListBox MultiSelect property to true.

Use this code to pass the selected entries in the filelistbox to the default mail application.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl;

type
  TForm1 = class(TForm)
    FileListBox1: TFileListBox;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

uses
  ActiveX, ShlObj, ComObj;

{$R *.dfm}

function GetFileListDataObject(const Directory: string; Files:
  TStrings):
  IDataObject;
type
  PArrayOfPItemIDList = ^TArrayOfPItemIDList;
  TArrayOfPItemIDList = array[0..0] of PItemIDList;
var
  Malloc: IMalloc;
  Root: IShellFolder;
  FolderPidl: PItemIDList;
  Folder: IShellFolder;
  p: PArrayOfPItemIDList;
  chEaten: ULONG;
  dwAttributes: ULONG;
  FileCount: Integer;
  i: Integer;
begin
  Result := nil;
  if Files.Count = 0 then
    Exit;
  OleCheck(SHGetMalloc(Malloc));
  OleCheck(SHGetDesktopFolder(Root));
  OleCheck(Root.ParseDisplayName(0, nil,
    PWideChar(WideString(Directory)),
    chEaten, FolderPidl, dwAttributes));
  try
    OleCheck(Root.BindToObject(FolderPidl, nil, IShellFolder,
      Pointer(Folder)));
    FileCount := Files.Count;
    p := AllocMem(SizeOf(PItemIDList) * FileCount);
    try
      for i := 0 to FileCount - 1 do
      begin
        OleCheck(Folder.ParseDisplayName(0, nil,
          PWideChar(WideString(Files[i])), chEaten, p^[i],
          dwAttributes));
      end;
      OleCheck(Folder.GetUIObjectOf(0, FileCount, p^[0], IDataObject,
        nil,
        Pointer(Result)));
    finally
      for i := 0 to FileCount - 1 do
      begin
        if p^[i] <> nil then
          Malloc.Free(p^[i]);
      end;
      FreeMem(p);
    end;
  finally
    Malloc.Free(FolderPidl);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  SelFileList: TStrings;
  I: Integer;
  DataObject: IDataObject;
  Effect: Integer;
  CLSID_SendMail: TGUID;
  DT: IDropTarget;
  P: TPoint;
begin
  CLSID_SendMail := StringToGUID('{9E56BE60-C50F-11CF-9A2C-00A0C90A90CE}');

  with FileListBox1 do
  begin
    SelFileList := TStringList.Create;
    try
      SelFileList.Capacity := SelCount;
      for i := 0 to FileListBox1.Items.Count - 1 do
        if Selected[i] then
          SelFileList.Add(Items[i]);
      DataObject := GetFileListDataObject(Directory, SelFileList);
    finally
      SelFileList.Free;
    end;
    Effect := DROPEFFECT_NONE;
    CoCreateInstance(CLSID_SendMail, nil, CLSCTX_ALL, IDropTarget, DT);
    DT.DragEnter(DataObject, MK_LBUTTON, P, Effect);
    DT.Drop(DataObject, MK_LBUTTON, P, Effect);
  end;
end;

end.

About these ads

Leave a Reply

Please log in using one of these methods to post your comment:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s