Outlook-Attachments in einem TStream

[Mschmidt]

Hallo,
wer mal eine Lösung benötigt, wie man an Outlook-Attachments kommt, ohne diese zuerst auf die Platte zu sichern, erhält unten einen kleine Komponente, die
sich als Clipboard-Viewer registriert (daher benötigt man ein Fensterhandle) und drei Properties zur Verfügung stellt.
- Count= Anzahl der Dateien in der Zwischenablage
- FilenameByIndex= Array der Dateinamen (0..Count-1)
- FilestreamByIndex=Array der Dateistreams (0..Count-1)
sowie ein Event, welches immer dann aufgerufen wird, wenn sich die Zwischenablage ändert.
Ist nicht vollkommen, aber funktioniert.

Delphi-Quellcode:

unit ClpBrdFiles;
interface
uses
  System.SysUtils,
  System.Classes,
  Vcl.Controls,
  Winapi.Windows,
  Winapi.Messages,
  System.Variants,
  System.Generics.Collections,
  Winapi.ShlObj,
  Clipbrd,
  Winapi.ActiveX,
  Vcl.AxCtrls;
type
 //Record stored File and Filecontent as Stream
 TClipboardFile = Record
    Filename: string;                    // Filename
    FileStream: TMemoryStream;           // Content
  End;
  TClipboardFilesList = TList<TClipboardFile>; // List of Record
  TNotifyClipboardEvent = procedure of object; // Event Type
  TClpBrdFiles = class(TComponent) // Component
  private
    CF_FILECONTENTS        : UINT;
    CF_FILEDESCRIPTOR      : UINT;
    CF_FileGroupDescriptor : UINT;
    CF_FileGroupDescriptorW: UINT;
    NextWnd: HWND; // next window
    fHWnd  : HWND; // himself
    fFiles:TClipboardFilesList; // Instance of List of Record
    fFilesCount:integer;        // count of files
    fNotifyClipboardEvent: TNotifyClipboardEvent; // Callback Event
    function GetMessageCount(const dataObj: IDataObject): integer; // Load
    procedure SaveMessage(const dataObj: IDataObject; Stream:TMemoryStream; Index : Integer);//Save
    procedure EmptyList; // Clear List 
    function getFileNameByIndex(index: integer): string; // getter
    function getFileStreamByIndex(Index: integer): TStream; // getter
  protected
    procedure WndMethod(var Msg: TMessage); virtual;
  public
    constructor Create(AOwner:TComponent);override;
    destructor destroy;override;
    procedure WMCHANGECBCHAIN(Msg:TMessage);
    procedure WMDRAWCLIPBOARD(Msg:TMessage);
    property Count:integer read fFilesCount; // read only property
    property FileNameByIndex[index:integer]:string read getFileNameByIndex;
    property FileStreamByIndex[Index:integer]:TStream read getFileStreamByIndex;
  published
    property NotifyClipboardEvent:TNotifyClipboardEvent read fNotifyClipboardEvent
             write fNotifyClipboardEvent;
  end;
procedure Register;
implementation
procedure Register;
begin
  RegisterComponents('MSch', [TClpBrdFiles]);
end;

// Create Constructor
// initialize the component and create a window handle
// and register the clipboard formats

constructor TClpBrdFiles.Create(AOwner: TComponent);
begin
  inherited create(AOwner);
  fFiles:= TClipboardFilesList.Create;
  fHWnd := AllocateHWnd(WndMethod);
  CF_FileContents := $8000 Or RegisterClipboardFormat(CFSTR_FILECONTENTS) And $7FFF;
  CF_FileGroupDescriptor := $8000 Or RegisterClipboardFormat(CFSTR_FILEDESCRIPTORA) And $7FFF;
  CF_FileGroupDescriptorW := $8000 Or RegisterClipboardFormat(CFSTR_FILEDESCRIPTORW) And $7FFF;
  NextWnd := SetClipboardViewer(fHwnd);
end;

// release the component
destructor TClpBrdFiles.destroy;
begin
  ChangeClipboardChain(fHWND, NextWnd);
  EmptyList;
  fFiles.Free;
  DeallocateHWnd(fHWnd);
  inherited;
end;

// clear the list
procedure TClpBrdFiles.EmptyList;
var
  I:Integer;
begin
  for I := 0 to fFiles.Count-1 do
     fFiles[i].FileStream.Free;
  fFiles.Clear;
end;

// get the Filename by index
function TClpBrdFiles.getFileNameByIndex(index: integer): string;
begin
  result:='';
  if (fFilesCount>0) and (index>=0)and (index<=fFilesCount-1)then
    result:= fFiles[index].Filename;
end;

// get the filestream by index
function TClpBrdFiles.getFileStreamByIndex(Index: integer): TStream;
begin
  result:=nil;
  if (fFilesCount>0) and (index>=0)and (index<=fFilesCount-1)then
    result:= fFiles[index].FileStream;
end;

// get the count of files and fill the list
function TClpBrdFiles.GetMessageCount(const dataObj: IDataObject): integer;
var
  ClipboardFile       : TClipboardFile;
  FormatETC           : TFORMATETC;
  STGMedium           : TSTGMEDIUM;
  FileGroupDescriptor : ^TFileGroupDescriptor;
  FileDescriptor      : TFileDescriptor;
  I                   : integer;
begin
  FormatETC.cfFormat := CF_FileGroupDescriptorW;
  FormatETC.dwAspect := DVASPECT_CONTENT;
  FormatETC.lindex   := -1;
  FormatETC.ptd      := nil;
  FormatETC.TYMED    := TYMED_HGLOBAL;
  if dataObj.QueryGetData(FormatETC) <> S_OK then
    FormatETC.cfFormat := CF_FileGroupDescriptor;
  if dataObj.GetData(FormatETC, STGMedium) = S_OK then
  begin
    FileGroupDescriptor:= GlobalLock(STGMedium.hGlobal);
    result:=FileGroupDescriptor.cItems;
    for I := 0 to FileGroupDescriptor.cItems-1 do
    begin
      FileDescriptor := FileGroupDescriptor.fgd[i];
      ClipboardFile.Filename:=FileDescriptor.cFileName;
      ClipboardFile.FileStream:= TMemoryStream.Create;
      fFiles.Add(ClipboardFile);
    end;
    GlobalUnlock(STGMedium.hGlobal);
    ReleaseStgMedium(STGMedium);
  end;
  for I := 0 to fFiles.Count-1 do
    SaveMessage(dataObj,fFiles[i].FileStream,I);
end;

// store the filestream into the list
procedure TClpBrdFiles.SaveMessage(const dataObj: IDataObject;
  Stream: TMemoryStream; Index: Integer);
var
  FormatETC: TFORMATETC;
  Medium   : TSTGMEDIUM;
  OleStream: TOleStream;
begin
  FillChar(FormatETC,sizeOf(FormatETC),0);
  FillChar(Medium,sizeOf(Medium),0);
  FormatETC.cfFormat := CF_FileContents;
  FormatETC.dwAspect := DVASPECT_CONTENT;
  FormatETC.lindex   := Index;
  FormatETC.ptd      := nil;
  FormatETC.TYMED    := TYMED_ISTREAM ;//Or TYMED_ISTORAGE;  not used
  if dataObj.GetData(FormatETC, Medium) = S_OK then
  begin
    case Medium.tymed of
      TYMED_HGLOBAL: {not used};
      TYMED_ISTREAM:
      begin
        OleStream:=TOleStream.Create(ISTREAM(Medium.stm));
        try
          Stream.CopyFrom(OleStream,OleStream.Size);
        finally
          OleStream.Free;
        end;
      end;
    end;
  end;
end;

// standard event - send the message WM_CHANGECBCHAIN to the next window
procedure TClpBrdFiles.WMCHANGECBCHAIN(Msg: TMessage);
begin
   if HWND(Msg.WParam) = NextWnd then
      NextWnd := HWND(Msg.LParam)
    else
      if NextWnd <> 0 then
        SendMessage(NextWnd, WM_CHANGECBCHAIN, Msg.WParam, Msg.LParam);
end;

// standard event - read the clipboard and send the message to next window
procedure TClpBrdFiles.WMDRAWCLIPBOARD(Msg: TMessage);
var
  DataObject: IDataObject;
  ClipboardFile:TClipboardFile;
begin
  if clipboard.HasFormat(CF_FILECONTENTS) then
  begin
    if OleGetClipboard(DataObject)=S_OK then
    begin
      EmptyList;
      fFilesCount:= GetMessageCount(DataObject);
      // Call other Procedure if available
      if assigned(fNotifyClipboardEvent) then
        fNotifyClipboardEvent();
    end;
  end;
  if NextWnd <> 0 then
    SendMessage(NextWnd, WM_DRAWCLIPBOARD, Msg.WParam, Msg.LParam);
end;

procedure TClpBrdFiles.WndMethod(var Msg: TMessage);
var
  Handled: Boolean;
begin
  Handled := True;
  case Msg.Msg of
    WM_CHANGECBCHAIN:WMCHANGECBCHAIN(Msg);
    WM_DRAWCLIPBOARD:WMDRAWCLIPBOARD(Msg);
  else
    Handled := False;
  end;
  if Handled then
    Msg.Result := 0
  else
    Msg.Result := DefWindowProc(fHWnd, Msg.Msg,Msg.WParam, Msg.LParam);
end;
initialization
   OleInitialize(nil);
finalization
  OleUninitialize;
end.