Moin,
ich hänge schon seit Ewigkeiten an dem Thema einzelne Dateianhänge aus Outlook per Drag&Drop.
Ganze Emails funktionieren.
Ich habe mich gestern mit ChatGPT dran gesetzt. Mit dem Code bekomme ich auch Filedescription aber nicht den FileContent.
Hat sich jemand damit schon einmal beschäftigt?
Succeeded(DataObj.GetData(FormatEtc, Medium)) gibt immer false zurück
Code:
procedure Tform3.extractOutlookAttachment(DataObj: IDataObject;var FileList: TStringList);
var
FormatEtc: TFormatEtc;
Medium: TStgMedium;
FileDescriptor: PFileGroupDescriptorW;
I: Integer;
Stream: IStream;
FileName: string;
FileHandle: THandle;
FileBuffer: array of Byte;
BytesRead: LongInt;
const
CFSTR_FILEDESCRIPTOR = 'FileGroupDescriptorW';
CFSTR_FILECONTENTS = 'FileContents';
function GetFormatEtc(Format: string): TFormatEtc;
begin
Result.cfFormat := RegisterClipboardFormat(PChar(Format));
Result.ptd := nil;
Result.dwAspect := DVASPECT_CONTENT;
Result.lindex := -1;
Result.tymed := TYMED_HGLOBAL;
end;
begin
// 1. Datei-Beschreibung abrufen
FormatEtc := GetFormatEtc(CFSTR_FILEDESCRIPTOR);
if Succeeded(DataObj.GetData(FormatEtc, Medium)) then
try
FileDescriptor := GlobalLock(Medium.hGlobal);
try
for I := 0 to FileDescriptor.cItems - 1 do
begin
FileName := GetEnvironmentVariable('TEMP') + '\'+WideCharToString(FileDescriptor.fgd[I].cFileName);
FileList.add(FileName);
showmessage(FileName);
// 2. Datei-Inhalt abrufen
FormatEtc := GetFormatEtc(CFSTR_FILECONTENTS);
FormatEtc.lindex := I; // Dateiindex setzen
if Succeeded(DataObj.GetData(FormatEtc, Medium)) then // Wird nie getriggert
try
Stream := IStream(Medium.stm);
FileHandle := FileCreate(FileName);
try
SetLength(FileBuffer, 4096);
repeat
Stream.Read(@FileBuffer[0], Length(FileBuffer), @BytesRead);
FileWrite(FileHandle, FileBuffer[0], BytesRead);
until BytesRead = 0;
finally
FileClose(FileHandle);
end;
finally
ReleaseStgMedium(Medium);
end;
end;
finally
GlobalUnlock(Medium.hGlobal);
end;
finally
ReleaseStgMedium(Medium);
end;
end;