Explorer への Drop

ソースはこちら（GitHub）

流行りに乗っかったわけではないですが、必要に駆られて OLE Drag and Drop （アプリケーションからエクスプローラーへデータをドロップ）を実装しようとしました。

しかし！
「仮想ファイル（存在しないファイル）」を「IStream」で書き出していく IDataObject の良いサンプルが無く、非常に悩みました。

ちなみに、どんな時に存在しないファイルの書き出しが必要かというと、例えば FTP でファイル名だけ判っているファイルをエクスプローラにドロップする時です。
選択されているファイルを先にダウンロードする訳にもいかないので、IDataObject.GetData が来たときに IStream インターフェースを実装しているストリームを返してやります。

そんな実装がしたかっただけなのですが、さっぱり上手く行きません。
そこで、サンプルを探していたら

The Drag and Drop Component Suite for Delphi

というコンポーネントを発見したので、早速導入してみました。

……しかし、コンパイルが通りません。
Delphi 2010 用で更新が止まってるため、いくつか不整合が起きたようです。

まず DragDrop.pas の 2483 行目の

const
  sClipNames: array[CF_TEXT..CF_MAX-1] of string =
    ('CF_TEXT', 'CF_BITMAP', 'CF_METAFILEPICT', 'CF_SYLK', 'CF_DIF', 'CF_TIFF',
    'CF_OEMTEXT', 'CF_DIB', 'CF_PALETTE', 'CF_PENDATA', 'CF_RIFF', 'CF_WAVE',
    'CF_UNICODETEXT', 'CF_ENHMETAFILE', 'CF_HDROP', 'CF_LOCALE');

を

const
  sClipNames: array[CF_TEXT..CF_MAX-1] of string =
    (
      'CF_TEXT',
      'CF_BITMAP',
      'CF_METAFILEPICT',
      'CF_SYLK',
      'CF_DIF',
      'CF_TIFF',
      'CF_OEMTEXT',
      'CF_DIB',
      'CF_PALETTE',
      'CF_PENDATA',
      'CF_RIFF',
      'CF_WAVE',
      'CF_UNICODETEXT',
      'CF_ENHMETAFILE',
      'CF_HDROP',
      '',
      'CF_LOCALE'
    );

と変えてやります。

次に DragDropContext の101 行目

    function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
      pszName: LPSTR; cchMax: UINT): HResult; stdcall;
 
    { IContextMenu2 }
    function HandleMenuMsg(uMsg: UINT; WParam, LParam: Integer): HResult; stdcall;
 
    { IContextMenu3 }
    function HandleMenuMsg2(uMsg: UINT; wParam, lParam: Integer;
      var lpResult: Integer): HResult; stdcall;

を

    function GetCommandString(idCmd: UINT_PTR; uFlags: UINT; pwReserved: PUINT;
      pszName: LPSTR; cchMax: UINT): HResult; stdcall;
 
    { IContextMenu2 }
    function HandleMenuMsg(uMsg: UINT; WParam: WPARAM; LParam: LPARAM): HResult; stdcall;
 
    { IContextMenu3 }
    function HandleMenuMsg2(uMsg: UINT; wParam: WPARAM; lParam: LPARAM; var lpResult: LRESULT): HResult; stdcall;

と変更します。
実装部も同じように引数を変更します。

次に DragDropSource, DragDropTarget の中で TThread.Resume を使っている部分があるので

{$ifndef VER21_PLUS}
procedure TDropSourceThread.Start;
begin
  {$WARNINGS OFF}
  Resume;
  {$WARNINGS ON}
end;
{$endif}

{$ifndef VER21_PLUS}
procedure TDropTargetTransferThread.Start;
begin
  {$WARNINGS OFF}
  Resume;
  {$WARNINGS ON}
end;
{$endif}

こんな風に {$WARNINGS} で囲ってやります。

これで、コンパイルが通るので同梱の DragDropD2011.dpk を開いてビルド＆インストールします。
すると、これらのコンポーネントが登録されます。



では、元々やりたかった仮想ファイルのコピーを実装します。
Demo も入っている（\Demos\AsyncSource）のですが、プロジェクト規模が無駄に大きくて判りづらいです。
「AsyncSource with Filestreams」にいたっては Indy を使って FTP を実装しています……
必要なところが見えなくて非常に判りづらい！

ということで、最も簡単なデモを作りました。

まず、Form に、TDataFormatAdapter と TDropEmptySource を置きます。



次にオブジェクトインスペクタで TDataFormatAdapter と TDropEmptySource を結びつけます。



画像の様に DataFormatName は TVirtualFileStreamDataFormat とし、Enabled を True にしておきます。

Enabled プロパティは DataFormatName と DragDropComponent が設定されていないと変更できません。

そして DataFormatAdapter1 にイベントハンドラを設定し、その中身を作ります。

procedure TForm1.FormCreate(Sender: TObject);
begin
  // イベントハンドラを設定する
  (DataFormatAdapter1.DataFormat as TVirtualFileStreamDataFormat).OnGetStream
    := OnGetStream;
end;
 
procedure TForm1.OnGetStream(
  Sender: TFileContentsStreamOnDemandClipboardFormat;
  Index: integer;
  out AStream: IStream);
var
  Data: TVirtualFileStreamDataFormat;
begin
  // ここは非同期で別スレッドから呼ばれるので、
  // ここでファイルのダウンロードなどをし、ファイルを一旦生成する
  // 生成した一時ファイルは TDropEmptySource.OnAfterDrop イベントなどの
  // タイミングで適宜削除する
 
  // 追加しておいたファイルを取り出す
  Data := TVirtualFileStreamDataFormat(DataFormatAdapter1.DataFormat);
 
  // 追加してある何番目のファイルかが Index に入っている
  if (Index < Data.FileNames.Count) then
    AStream :=
      // TStreamAdapter を使うと IStream の実装が得られる
      TStreamAdapter.Create(
        TFileStream.Create(
          Data.FileNames[Index],
          fmOpenRead or fmShareDenyNone),
        soOwned
      );
end;

これで、非同期にファイルをコピーする仕組みは整いました。
実際にファイルの Drop を実行するためには TDropEmptySource.Execute を使います。

procedure TForm1.DropExecute;
var
  Data: TVirtualFileStreamDataFormat;
begin
  // OnMouseMove から呼ばれる（煩雑になるため機能を分けた）
 
  // TVirtualFileStreamDataFormat.FileNames にコピーするファイル名を追加する
  Data := TVirtualFileStreamDataFormat(DataFormatAdapter1.DataFormat);
  Data.FileNames.Clear;
 
  // 今回は自分をコピーしてみる
  Data.FileNames.Add(Application.ExeName);
 
  if (Data.FileNames.Count > 0) then
    DropEmptySource1.Execute(True); // True を渡すと非同期で実行する
end;

ここでは「存在しないファイル」を用意するのが面倒なので「自分自身」をコピーするようにしました。
サンプルでは、フォームのどこでもドラッグすると、エクスプローラーにドロップできます。



是非お試しあれ。