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.

[zeras]

Ich suche nach einer Möglichkeit, eine Email direkt in ein Delphiprogramm zu ziehen und dann noch Kommentare etc. abzulegen. Wichtig ist, dass man die Email dann irgendwie wieder mit Outlook aufkriegen müßte.
Geht das damit auch?

[Mschmidt]

Jaein -
du musst eine Methode implementieren, die den Typ TYMED_ISTORAGE implementiert.

Delphi-Quellcode:

  
  FormatETC.TYMED := TYMED_ISTREAM Or TYMED_ISTORAGE; // auskommentierten Wert aktivieren
...
   case Medium.tymed of
      TYMED_ISTORAGE: //<<<<< hier deine neue Methode
      TYMED_ISTREAM:
      begin
        ...

das ganze als *.msg abgespeichert und dann gehts auch mit Outlook-Nachrichten (incl. Anlagen)

Msch

[zeras]

Zitat von Mschmidt:

Jaein -
du musst eine Methode implementieren, die den Typ TYMED_ISTORAGE implementiert.

Delphi-Quellcode:

  
  FormatETC.TYMED := TYMED_ISTREAM Or TYMED_ISTORAGE; // auskommentierten Wert aktivieren
...
   case Medium.tymed of
      TYMED_ISTORAGE: //<<<<< hier deine neue Methode
      TYMED_ISTREAM:
      begin
        ...

das ganze als *.msg abgespeichert und dann gehts auch mit Outlook-Nachrichten (incl. Anlagen)

Msch

Danke, dann habe ich ja was für "zwischen den Festen"

[PatBru]

Hallo,
die Komponente funktioniert sehr gut, vielen Dank dafür!

Ich weiß, es schon eine Weile her, aber vielleicht liest ja noch jemand mit.

Wir bekommen einen Fehler bei SaveMessage, Stream.CopyFrom, wenn der Outlook-Anhang in eine Remote-Session oder von einer Remote-Session kopiert wurde.
Die Fehlermeldung ist "Falscher Parameter".

Hat vielleicht jemand eine Idee, woran es liegen könnte?