Drag&Drop aus neuem Outlook

[jbg]

So, ich habe ein paar Minuten zeit gehabt und die Drag-and-Drop-Component-Suite etwas angeschaut. Eigentlich könnte die alles. Es ist nur nicht alles zusammengebaut.

Zuerst muss die Klasse TOutlookDataFormat um das Clipboard-Format TFileClipboardFormat erweitert werden und die Dateinamen, die per async. HDROP rein kommen, in einer Files-Stringliste abgelegt werden. Das macht die folgende DataFormat-Klasse.
Man könnte das auch direkt in TOutlookDataFormat einbauen, aber so geht das auch, ohne Änderungen am Originalcode.

Delphi-Quellcode:

type
  TNewAndClassicOutlookDataFormat = class(TOutlookDataFormat)
  private
    FFiles: TUnicodeStrings;
  protected
    class procedure RegisterCompatibleFormats; override;
  public
    constructor Create(AOwner: TDragDropComponent); override;
    destructor Destroy; override;
    function Assign(Source: TClipboardFormat): Boolean; override;
    function AssignTo(Dest: TClipboardFormat): Boolean; override;
    procedure Clear; override;

    property Files: TUnicodeStrings read FFiles;
  end;

{ TNewAndClassicOutlookDataFormat }

class procedure TNewAndClassicOutlookDataFormat.RegisterCompatibleFormats;
begin
  inherited RegisterCompatibleFormats;
  RegisterDataConversion(TFileClipboardFormat, 1); // New Outlook (WebApp)
end;

function TNewAndClassicOutlookDataFormat.Assign(Source: TClipboardFormat): Boolean;
begin
  if Source is TFileClipboardFormat then
  begin
    FFiles.Assign(TFileClipboardFormat(Source).Files);
    Result := True;
  end
  else
    Result := inherited Assign(Source);
end;

function TNewAndClassicOutlookDataFormat.AssignTo(Dest: TClipboardFormat): Boolean;
begin
  if Dest is TFileClipboardFormat then
  begin
    TFileClipboardFormat(Dest).Files.Assign(FFiles);
    Result := True;
  end
  else
    Result := inherited AssignTo(Dest);
end;

constructor TNewAndClassicOutlookDataFormat.Create(AOwner: TDragDropComponent);
begin
  inherited Create(AOwner);
  FFiles := TUnicodeStringList.Create;
end;

destructor TNewAndClassicOutlookDataFormat.Destroy;
begin
  FFiles.Free;
  inherited Destroy;
end;

procedure TNewAndClassicOutlookDataFormat.Clear;
begin
  FFiles.Clear;
  inherited Clear;
end;

Dann muss man diese Klasse registrieren:

Delphi-Quellcode:

initialization
  TNewAndClassicOutlookDataFormat.RegisterDataFormat;

Dann muss man an der TDropEmptyTarget Komponente die Eigenschaft "AllowAsyncTransfer" auf True stellen und beim DataFormatAdapter die "DataFormatClass"-Eigenschaft auf "TNewAndClassicOutlookDataFormat" setzen.

Delphi-Quellcode:

DropEmptyTarget1.AllowAsyncTransfer := True; // Required for the "New Outlook" to receive EML filenames
DataFormatAdapterOutlook.DataFormatClass := TNewAndClassicOutlookDataFormat;
DataFormatAdapterOutlook.Enabled := True; // Setting DataFormClass disables the DataFormat

Jetzt kann man im OnDrop-Ereignis die Dateinamen empfangen:

Delphi-Quellcode:

OutlookDataFormat := DataFormatAdapterOutlook.DataFormat as TNewAndClassicOutlookDataFormat;
if OutlookDataFormat.Files.Count > 0 then // "New Outlook"
begin
  // Handle *.eml files
  for I := 0 to OutlookDataFormat.Files.Count - 1 do
  begin
    if SameText('.eml', ExtractFileExt(OutlookDataFormat.Files[I])) then
    begin
      Eml := TIdMessage.Create(nil);
      try
        Eml.LoadFromFile(OutlookDataFormat.Files[I]);
        // ...
      finally
        Eml.Free;
      end;
    end;
  end;
end
else
begin
  // Handle "Classic Outlook" *.msg files
  OutlookDataFormat.Messages.LockSession;
  for I := 0 to OutlookDataFormat.Messages.Count - 1 do
    // ...
end;

Um das "Bestätigen des Downloads" im New Outlook kommt man aber nicht herum, da es sich technisch dort um einen Download handelt. Und EML-Dateien "gefährlich" sind.