Прежде всего, если вы можете найти готовую библиотеку, которая делает это из коробки (например, предложенную ldsandon ), используйте ее, потому что все это выполняется вручную больно и разочаровывает. Временами документация неполная и может содержать ошибки: в конечном итоге вы будете делать что-то методом проб и ошибок, и Google не спасет вас, потому что не многие люди копаются в глубинах Ole drag-and-drop, и большинство из них который, вероятно, будет использовать готовый код.
Как это сделать на простом Паскале
Теоретически API, который используется для того, чтобы приложение обрабатывало отбрасывание OLE, очень прост. Все, что вам нужно сделать, это предоставить реализацию интерфейса IDropTarget, который делает то, что вам нужно, и вызвать RegisterDragDrop, предоставляя дескриптор окна вашего приложения и интерфейса.
Вот как выглядит моя реализация:
TDropTargetImp = class(TInterfacedObject, IDropTarget)
public
function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
function DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
function DragLeave: HResult; stdcall;
function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
end;
Реализация DragEnter, DragOver и DragLeave тривиальна, учитывая, что я делаю это для эксперимента: я просто приму все :
function TDropTargetImp.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
begin
dwEffect := DROPEFFECT_COPY;
Result := S_OK;
end;
function TDropTargetImp.DragLeave: HResult;
begin
Result := S_OK;
end;
function TDropTargetImp.DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
begin
dwEffect := DROPEFFECT_COPY;
Result := S_OK;
end;
Настоящая работа будет сделана в TDropTargetImp.Drop.
function TDropTargetImp.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var iEnum: IEnumFORMATETC;
DidRead:LongInt;
F: TFormatEtc;
STG:STGMEDIUM;
Response:Integer;
Stream:IStream;
Storage: IStorage;
EnumStg: IEnumStatStg;
ST_TAG: STATSTG;
FileStream: TFileStream;
Buff:array[0..1023] of Byte;
begin
if dataObj.EnumFormatEtc(DATADIR_GET, iEnum) = S_OK then
begin
{
while (iEnum.Next(1, F, @DidRead) = S_OK) and (DidRead > 0) do
begin
GetClipboardFormatName(F.cfFormat, FormatName, SizeOf(FormatName));
ShowMessage(FormatName + ' : ' + IntToHex(F.cfFormat,4) + '; lindex=' + IntToStr(F.lindex));
end;
}
ZeroMemory(@F, SizeOf(F));
F.cfFormat := $C105; // CF_FILECONTENTS
F.ptd := nil;
F.dwAspect := DVASPECT_CONTENT;
F.lindex := 0{-1}; // Documentation says -1, practice says "0"
F.tymed := TYMED_ISTORAGE;
Response := dataObj.GetData(F, STG);
if Response = S_OK then
begin
case STG.tymed of
TYMED_ISTORAGE:
begin
Storage := IStorage(STG.stg);
if Storage.EnumElements(0, nil, 0, EnumStg) = S_OK then
begin
while (EnumStg.Next(1, ST_TAG, @DidRead) = S_OK) and (DidRead > 0) do
begin
if ST_TAG.cbSize > 0 then
begin
Response := Storage.OpenStream(ST_TAG.pwcsName, nil, STGM_READ or STGM_SHARE_EXCLUSIVE, 0, Stream);
if Response = S_OK then
begin
// Dump the stored stream to a file
FileStream := TFileStream.Create('C:\Temp\' + ST_TAG.pwcsName + '.bin', fmCreate);
try
while (Stream.Read(@Buff, SizeOf(Buff), @DidRead) = S_OK) and (DidRead > 0) do
FileStream.Write(Buff, DidRead);
finally FileStream.Free;
end;
end
else
case Response of
STG_E_ACCESSDENIED: ShowMessage('STG_E_ACCESSDENIED');
STG_E_FILENOTFOUND: ShowMessage('STG_E_FILENOTFOUND');
STG_E_INSUFFICIENTMEMORY: ShowMessage('STG_E_INSUFFICIENTMEMORY');
STG_E_INVALIDFLAG: ShowMessage('STG_E_INVALIDFLAG');
STG_E_INVALIDNAME: ShowMessage('STG_E_INVALIDNAME');
STG_E_INVALIDPOINTER: ShowMessage('STG_E_INVALIDPOINTER');
STG_E_INVALIDPARAMETER: ShowMessage('STG_E_INVALIDPARAMETER');
STG_E_REVERTED: ShowMessage('STG_E_REVERTED');
STG_E_TOOMANYOPENFILES: ShowMessage('STG_E_TOOMANYOPENFILES');
else
ShowMessage('Err: #' + IntToHex(Response, 4));
end;
end;
end;
end;
end
else
ShowMessage('TYMED?');
end;
end
else
case Response of
DV_E_LINDEX: ShowMessage('DV_E_LINDEX');
DV_E_FORMATETC: ShowMessage('DV_E_FORMATETC');
DV_E_TYMED: ShowMessage('DV_E_TYMED');
DV_E_DVASPECT: ShowMessage('DV_E_DVASPECT');
OLE_E_NOTRUNNING: ShowMessage('OLE_E_NOTRUNNING');
STG_E_MEDIUMFULL: ShowMessage('STG_E_MEDIUMFULL');
E_UNEXPECTED: ShowMessage('E_UNEXPECTED');
E_INVALIDARG: ShowMessage('E_INVALIDARG');
E_OUTOFMEMORY: ShowMessage('E_OUTOFMEMORY');
else
ShowMessage('Err = ' + IntToStr(Response));
end;
end;
Result := S_OK;
end;
Этот код принимает «Drop», ищет некоторые CF_FILECONTENTS, открывает его как TYMED_ISTORAGE, сбрасывает каждый отдельный поток в этом хранилище в файл в C:\Temp\<stream_name>.bin; Я пробовал это с Delphi 2010 и Outlook 2007, все работает нормально: открывая эти сохраненные файлы (их много!), Я могу найти все из сообщения электронной почты неожиданным образом. Я уверен, что где-то есть документация, которая точно объясняет, что каждый из этих файлов должен содержать, но мне не очень важно принимать перетаскиваемые файлы из Outlook, поэтому я не зашел слишком далеко. Опять же, ссылка ldsandon выглядит многообещающе.
Этот код выглядит довольно коротким, но это не источник трудностей. Документация для этого действительно отсутствовала; Я бью дорожные блоки на каждом углу, начиная с этого:
F.lindex := 0{-1}; // Documentation says -1, practice says "0"
В документации Msdn ясно, что единственное допустимое значение для "lindex" - -1: угадайте, что -1 не работает, 0 работает!
Тогда есть эта короткая строка кода:
Response := Storage.OpenStream(ST_TAG.pwcsName, nil, STGM_READ or STGM_SHARE_EXCLUSIVE, 0, Stream);
конкретно, эти две константы:
STGM_READ or STGM_SHARE_EXCLUSIVE
получение этой комбинации было вопросом проб и ошибок. Я не люблю проб и ошибок: это оптимальная комбинация флагов для того, что я хочу? Будет ли это работать на каждой платформе? Я не знаю ...
Тогда возникает вопрос создания заголовков или хвостов реального содержимого, получаемого из Outlook. Например, в этом потоке был найден объект электронной почты: __substg1.0_800A001F. Тело сообщения было найдено в этом потоке: __substg1.0_1000001F. За простое электронное письмо я получил 59 потоков ненулевого размера.