Я имел дело с Outlook IDataObject с раньше.
Outlook предоставляет те же CFSTR_FILEDESCRIPTOR / CFSTR_FILECONTENTS, что и обычные объекты оболочки из Explorer.
Когда я перечисляю форматы в IDataObject, я вижу их:
0: cfFormat: TClipFormat = "RenPrivateSourceFolder" (49972)
tymed: Longint = 4 (TYMED_ISTREAM)
1: cfFormat: TClipFormat = "RenPrivateMessages" (49587)
tymed: Longint = 4 (TYMED_ISTREAM)
2: cfFormat: TClipFormat = "RenPrivateItem" (49812)
tymed: Longint = 1 (TYMED_HGLOBAL)
3: cfFormat: TClipFormat = CFSTR_FILEDESCRIPTOR ("FileGroupDescriptor", 49281)
tymed: Longint = 1 (TYMED_HGLOBAL)
4: cfFormat: TClipFormat = CFSTR_FILEDESCRIPTORW ("FileGroupDescriptorW", 49280)
tymed: Longint = 1 (TYMED_HGLOBAL)
5: cfFormat: TClipFormat = "FileNameW" (49159)
tymed: Longint = 2 (TYMED_FILE)
6: cfFormat: TClipFormat = CFSTR_FILECONTENTS ("FileContents", 49282)
tymed: Longint = 12 (TYMED_ISTREAM, TYMED_ISTORAGE)
7: cfFormat: TClipFormat = "Object Descriptor" (49166)
tymed: Longint = 1 (TYMED_HGLOBAL)
8: cfFormat: TClipFormat = CF_TEXT (1)
tymed: Longint = 1 (TYMED_HGLOBAL)
9: cfFormat: TClipFormat = CF_UNICODETEXT (13)
tymed: Longint = 1 (TYMED_HGLOBAL)
10: cfFormat: TClipFormat = "CSV" (49993)
tymed: Longint = 1 (TYMED_HGLOBAL)
При перетаскивании на VirtualStringTree я использую Drag-Drop, но концепция оболочки такая же. я могу отправить фрагменты своего кода (который в конечном итоге сохраняет электронную почту Outlook в базе данных)
function HandleOleDrop(DataObject: IDataObject; var DropEffect: TDropEffect;
FileContentsCallback: TFileContentsCallback;
FilenameCallback: TFilenameCallback;
BitmapCallback: TBitmapCallback;
StreamCallback: TStreamCallback): HResult;
var
enum: IEnumFORMATETC;
OLEFormat: TFormatEtc;
Fetched: Integer;
begin
//Go through the formats list in order, looking for the formats we understand.
//The order they are given to us is the order the original application's idea
//of better to worse
Result := DataObject.EnumFormatEtc(DATADIR_GET, enum);
if Failed(Result) then
Exit;
Result := enum.Reset;
if Failed(Result) then
Exit;
while enum.Next(1, OLEFormat, @Fetched) = S_OK do
begin
OutputDebugString(PChar('[HelpDeskShellOperations.HandleOleDrop] ClipboardFormat = ' + ClipFormatToStr(OleFormat.cfFormat)));
if OLEFormat.cfFormat = CF_FILEDESCRIPTOR then
begin
//Transfer data as if it were a file, regardless of how it is actually stored
//If CF_FILEDESCRIPTOR is present, then a CF_FILECONTENTS must also be
//present later on in the formats list
Result := GetFileContents(DataObject, DropEffect, FileContentsCallback);
Break;
end
else if OleFormat.cfFormat = CF_HDROP then
begin
Result := GetHDropContents(DataObject, DropEffect, FilenameCallback);
Break;
end
else if OleFormat.cfFormat = CF_BITMAP then
begin
Result := GetBitmapContents(DataObject, DropEffect, BitmapCallback);
Break;
end;
{ else if OleFormat.cfFormat = CF_PNGStream then
begin
Result := GetStreamContents(OleFormat.cfFormat, DataObject, 'untitled.png', DropEffect, StreamCallback);
Break;
end
else if OleFormat.cfFormat = CF_GIFStream then
begin
Result := GetStreamContents(OleFormat.cfFormat, DataObject, 'untitled.gif', DropEffect, StreamCallback);
Break;
end
else if OleFormat.cfFormat = CF_JFIFStream then
begin
Result := GetStreamContents(OleFormat.cfFormat, DataObject, 'untitled.jpeg', DropEffect, StreamCallback);
Break;
end;}
// else if Formats[i] = ... then
// begin
//Handle another format
// Break;
// end
end;
end;
Хитрость выше в том, что мы перечисляем форматы, которые содержит IDataObject. Нам нравится CF_FILEDESCRIPTOR, и мы обращаемся с этим специально:
function GetFileContents(DataObject: IDataObject; var Effect: TDropEffect; FileContentsCallback: TFileContentsCallback): HResult;
var
hr: HResult;
format: TFormatEtc;
FileDescriptorMedium: TStgMedium;
fgdGlobal: hGlobal; //global memory object where the descriptors are
fgd: PFileGroupDescriptor; //descriptors
Descriptors: PFileDescriptorArray; //helper to access descriptors dynamic array
nItem: Integer;
FileContentsMedium: TStgMedium;
// stm: IStream;
begin
//1. Extract the CFSTR_FILEDESCRIPTOR format as a TYMED_HGLOBAL value.
ZeroMemory(@format, SizeOf(TFormatEtc));
format.cfFormat := CF_FILEDESCRIPTOR;
format.dwAspect := DVASPECT_CONTENT;
format.tymed := TYMED_HGLOBAL;
ZeroMemory(@FileDescriptorMedium, SizeOf(FileDescriptorMedium));
Result := DataObject.GetData(format, FileDescriptorMedium); //Free the medium at the end
if Failed(Result) then
Exit;
try
//2. The hGlobal member of the returned STGMEDIUM structure points to a
// global memory object. Lock that object by passing the hGlobal value
// to GlobalLock.
fgdGlobal := FileDescriptorMedium.hGlobal;
fgd := GlobalLock(fgdGlobal);
try
//3. Cast the pointer returned by GlobalLock to a FILEGROUPDESCRIPTOR pointer.
// It will point to a FILEGROUPDESCRIPTOR structure followed by one or more
// FILEDESCRIPTOR structures. Each FILEDESCRIPTOR structure contains a
// description of a file that is contained by one of the accompanying
// CFSTR_FILECONTENTS formats.
Descriptors := Addr(fgd.fgd[0]);
//4. Examine the FILEDESCRIPTOR structures to determine which one corresponds
// to the file you want to extract. The zero-based index of that
// FILEDESCRIPTOR structure is used to identify the file's
// CFSTR_FILECONTENTS format. Because the size of a global memory block is
// not byte-precise, use the structure's nFileSizeLow and nFileSizeHigh
// members to determine how many bytes represent the file in the global
// memory object.
for nItem := 0 to fgd.cItems - 1 do
begin
//5. Call IDataObject::GetData with the cfFormat member of the FORMATETC
// structure set to the CFSTR_FILECONTENTS value and the lIndex member
// set to the index that you determined in the previous step. The tymed
// member is typically set to TYMED_HGLOBAL | TYMED_ISTREAM | TYMED_ISTORAGE.
// The data object can then choose its preferred data transfer mechanism.
ZeroMemory(@format, SizeOf(TFormatEtc));
format.cfFormat := CF_FILECONTENTS;
format.dwAspect := DVASPECT_CONTENT;
format.lindex := nItem;
format.tymed := TYMED_HGLOBAL or TYMED_ISTREAM or TYMED_ISTORAGE;
//NOTE: IStorage based files are a bitch to deal with
ZeroMemory(@FileContentsMedium, SizeOf(FileContentsMedium));
//Now get the file's contents
hr := DataObject.GetData(format, FileContentsMedium);
if Failed(hr) then
Continue;
try
{
Progress: nItem+1 of fgd.cItems
}
//6. The STGMEDIUM structure that IDataObject::GetData returns will
// contain a pointer to the file's data. Examine the tymed member of
// the structure to determine the data transfer mechanism.
{ i now have afile's name/size/date/etc in
Descriptors[nItem]
and the guts of file in
FileContentsMedium
(which could actually be in an hGlobal, IStream or IStorage.
Use ConvertStorageMediumToIStream to convert whatever it is into an IStream)
}
// stm := ConvertStorageMediumToIStream(FileContentsMedium);
if Assigned(FileContentsCallback) then
FileContentsCallback(Descriptors[nItem], FileContentsMedium, nItem + 1, fgd.cItems);
finally
//Call ReleaseStgMedium to release the global memory object.
ReleaseStgMedium(FileContentsMedium);
end;
end;
finally
GlobalUnlock(fgdGlobal);
end;
finally
ReleaseStgMedium(FileDescriptorMedium);
end;
end;
И у моего приложения есть обратный вызов, поэтому он может поместить файл туда, куда хочет. В моем случае я помещаю файл в объект, чтобы потом его можно было сохранить в базе данных:
function TfrmTicketDetail.FileContentsCallback(const Descriptor: TFileDescriptor; const medium: TStgMedium; Progress: Integer; MaxProgress: Integer): Boolean;
var
szFilename: string;
Attachment: TAttachment;
ListItem: TVirtualListItem;
stm: IStream;
vclStream: TStream;
begin
try
szFilename := descriptor.cFilename;
Attachment := TAttachment.Create(dmodGlobal.ADOConnection);
Attachment.RecordID := ToolKit.CreateGUID;
Attachment.AutoGenerateRecordID := false;
Attachment.setStateNew;
Attachment.PrevState := Attachment.State;
Attachment.IsLink := False;
{Helpdesk attachments don't let you save the "date" of the attachment}
if (descriptor.dwFlags and FD_CREATETIME) = FD_CREATETIME then
Attachment.CreationDate := FileTimeToDateTime(descriptor.ftCreationTime)
else if (descriptor.dwFlags and FD_WRITESTIME) = FD_WRITESTIME then
Attachment.CreationDate := FileTimetoDateTime(descriptor.ftLastWriteTime)
else
Attachment.CreationDate := Now;
Attachment.FileName := ExtractFileName(szFilename);
Attachment.FullPath := ExtractFilePath(szFilename);
Attachment.Extension := ExtractFileExt(szFilename);
Attachment.Version := '';
Attachment.Comment := '';
Attachment.TicketGUID := StringToGUID(GUID);
Attachment.UserGUID := StringToGUID(dmodGlobal.UserGUID);
stm := ConvertStorageMediumToIStream(medium);
vclStream := TOleStream.Create(stm);
Attachment.FileStream := vclStream;
{Most often they don't fill in the file size structure member,
so we have to go to the contents to find the size.}
if (descriptor.dwFlags and FD_FILESIZE) = FD_FILESIZE then
begin
Attachment.Size := (Descriptor.nFileSizeLow and $7FFFFFFF);
//Yes, i know, ignoring the upper 32-bits, and throwing away the "sign" bit.
//If you wanna change the database to handle an unsigned 64-bit, you BE MY GUEST - jerk wad
//descriptor.nFileSizeLow or (descriptor.nFileSizeHigh shl 32)
end
else
begin
Attachment.Size := Integer(GetIStreamSize(stm) and $7FFFFFFF);
end;
//Add it to the listivew
ListItem := lvAttachments.Items.Add;
ListItem.Data := Attachment;
olAttachments.Add(Attachment);
TAttachment.RefreshAttachmentListItem(ListItem);
FFlags.SetFlags(FLAG_MODIFIED);
SetStatus(STATUS_MODIFIED);
Result := True;
except
on e: Exception do
begin
Result := False;
MessageDlg('New Attachment Failed: ' + ToolKit.CRLF + e.Message, mtError, [mbOK], 0);
end;
end;
end;