Advertisement
Guest User

Untitled

a guest
Jun 26th, 2012
125
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 3.37 KB | None | 0 0
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls, FileCtrl, ActiveX, ShlObj, ComObj, Vcl.Buttons;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     SpeedButton1: TSpeedButton;
  12.     SpeedButton2: TSpeedButton;
  13.     procedure SpeedButton1Click(Sender: TObject);
  14.     procedure SpeedButton2Click(Sender: TObject);
  15.   private
  16.     { Private declarations }
  17.   public
  18.  
  19.   end;
  20.  
  21. var
  22.   Form1: TForm1;
  23.  
  24. implementation
  25.  
  26. {$R *.dfm}
  27.  
  28. function MAPISendDocuments(UIParam     : LongInt;
  29.                             DelimChar  : PChar;
  30.                             FilePaths  : PChar;
  31.                             FileNames  : Pchar;
  32.                             Reserved   : LongInt) : LongInt; stdcall; external 'MAPI32.DLL';
  33.  
  34.  
  35. procedure TForm1.SpeedButton1Click(Sender: TObject);
  36. var
  37.     res      :longint;
  38.     pathstr,
  39.     filestr  :array [0..1024] of char;
  40.  
  41. begin
  42.   with TOpenDialog.Create(self) do
  43.   try
  44.     if Execute then
  45.     begin
  46.       strPcopy(pathstr,filename);
  47.       strPcopy(filestr,ExtractFileName(filename));
  48.       Res := MAPISendDocuments(0,';',pathstr,filestr,0);
  49.     end;
  50.   finally
  51.     free;
  52.   end;
  53.  
  54.  
  55.  
  56. end;
  57.  
  58.  
  59. function GetFileListDataObject(const Directory: string; Files:
  60.   TStrings):
  61.   IDataObject;
  62. type
  63.   PArrayOfPItemIDList = ^TArrayOfPItemIDList;
  64.   TArrayOfPItemIDList = array[0..0] of PItemIDList;
  65. var
  66.   Malloc: IMalloc;
  67.   Root: IShellFolder;
  68.   FolderPidl: PItemIDList;
  69.   Folder: IShellFolder;
  70.   p: PArrayOfPItemIDList;
  71.   chEaten: ULONG;
  72.   dwAttributes: ULONG;
  73.   FileCount: Integer;
  74.   i: Integer;
  75. begin
  76.   Result := nil;
  77.   if Files.Count = 0 then
  78.     Exit;
  79.   OleCheck(SHGetMalloc(Malloc));
  80.   OleCheck(SHGetDesktopFolder(Root));
  81.   OleCheck(Root.ParseDisplayName(0, nil,
  82.     PWideChar(WideString(Directory)),
  83.     chEaten, FolderPidl, dwAttributes));
  84.   try
  85.     OleCheck(Root.BindToObject(FolderPidl, nil, IShellFolder,
  86.       Pointer(Folder)));
  87.     FileCount := Files.Count;
  88.     p := AllocMem(SizeOf(PItemIDList) * FileCount);
  89.     try
  90.       for i := 0 to FileCount - 1 do
  91.       begin
  92.         OleCheck(Folder.ParseDisplayName(0, nil,
  93.           PWideChar(WideString(Files[i])), chEaten, p^[i],
  94.           dwAttributes));
  95.       end;
  96.       OleCheck(Folder.GetUIObjectOf(0, FileCount, p^[0], IDataObject,
  97.         nil,
  98.         Pointer(Result)));
  99.     finally
  100.       for i := 0 to FileCount - 1 do begin
  101.         if p^[i] <> nil then Malloc.Free(p^[i]);
  102.       end;
  103.       FreeMem(p);
  104.     end;
  105.   finally
  106.     Malloc.Free(FolderPidl);
  107.   end;
  108. end;
  109.  
  110.  
  111. procedure TForm1.SpeedButton2Click(Sender: TObject);
  112. var
  113.   SelFileList: TStrings;
  114.   I: Integer;
  115.   DataObject: IDataObject;
  116.   Effect: Integer;
  117.   CLSID_SendMail: TGUID;
  118.   DT: IDropTarget;
  119.   P: TPoint;
  120.  
  121. begin
  122.   CLSID_SendMail := StringToGUID('{9E56BE60-C50F-11CF-9A2C-00A0C90A90CE}');
  123.   with TOpenDialog.Create(self) do
  124.   try
  125.     SelFileList := TStringlist.Create;
  126.     if Execute then
  127.     begin
  128.       SelFileList.Capacity := 1;
  129.       SelFileList.Add(FileName);
  130.       DataObject := GetFileListDataObject(ExtractFilePath(FileName), SelFileList);
  131.       Effect := DROPEFFECT_NONE;
  132.       CoCreateInstance(CLSID_SendMail, nil, CLSCTX_ALL, IDropTarget, DT);
  133.       DT.DragEnter(DataObject, MK_LBUTTON, P, Effect);
  134.       DT.Drop(DataObject, MK_LBUTTON, P, Effect);
  135.     end;
  136.   finally
  137.     free;
  138.     SelFileList.Free;
  139.   end;
  140. end;
  141.  
  142. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement