Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit Unit1;
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, FileCtrl, ActiveX, ShlObj, ComObj, Vcl.Buttons;
- type
- TForm1 = class(TForm)
- SpeedButton1: TSpeedButton;
- SpeedButton2: TSpeedButton;
- procedure SpeedButton1Click(Sender: TObject);
- procedure SpeedButton2Click(Sender: TObject);
- private
- { Private declarations }
- public
- end;
- var
- Form1: TForm1;
- implementation
- {$R *.dfm}
- function MAPISendDocuments(UIParam : LongInt;
- DelimChar : PChar;
- FilePaths : PChar;
- FileNames : Pchar;
- Reserved : LongInt) : LongInt; stdcall; external 'MAPI32.DLL';
- procedure TForm1.SpeedButton1Click(Sender: TObject);
- var
- res :longint;
- pathstr,
- filestr :array [0..1024] of char;
- begin
- with TOpenDialog.Create(self) do
- try
- if Execute then
- begin
- strPcopy(pathstr,filename);
- strPcopy(filestr,ExtractFileName(filename));
- Res := MAPISendDocuments(0,';',pathstr,filestr,0);
- end;
- finally
- free;
- end;
- end;
- 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.SpeedButton2Click(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 TOpenDialog.Create(self) do
- try
- SelFileList := TStringlist.Create;
- if Execute then
- begin
- SelFileList.Capacity := 1;
- SelFileList.Add(FileName);
- DataObject := GetFileListDataObject(ExtractFilePath(FileName), SelFileList);
- 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;
- finally
- free;
- SelFileList.Free;
- end;
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement