Delphi-PRAXiS - Outlook-Attachments in einem TStream

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.