この発言に対し以下のコメントが寄せられています

#01168　ぜえた          さん　RE:「送る」の動作をプログラムで実現する




　こんにちは、ぜえた です。




「送る」（エクスプローラで右クリックして現われるコンテキストメニューの
中にあるもの）の動作をエミュレートする関数（ユニット）です。

「送る」を行なって動作する処理は、Drop Handlerが行なっており、エクスプ
ローラはそれを呼び出しているだけです。この関数はその呼び出しを行ないま
す。

Drop Handlerは Shell Extensionのひとつで、通常のファイルは Drag and 
Dropを受け入れませんが、これを作ることによって受け入れることができるよ
うになります。「送る」でも同じ仕組みでデータが渡されます。

もしかしたら該当する APIがあったりするのかもしれませんが、知らないので
作ってしまいました。知っている方がいたら教えてください。
またここらへんはよく知っているというわけではないので、間違っていたら指
摘してください(^^;

unit SendToU;

interface

uses Windows, SysUtils, Classes, ActiveX, ShlObj, ComObj;

function GetFileListDataObject(const Directory: string; Files: TStrings):
  IDataObject;
function ExtToCLSID(const Ext: string): string;
function GetClassData(const CLSID, SubKey: string): string;
procedure SendTo(const Receiver, Directory: string; Files: TStrings);

implementation

function GetFileListDataObject(const Directory: string; Files: TStrings):
  IDataObject;
// Directory: 親ディレクトリ、
// Files: 相対パスのファイル名のリスト、
//  から Data Object を生成する関数。
// 注意：Directoryが空文字列なら、Filesは絶対パスも可。
// 　　　ファイルは存在するもののみ。
type
  PArrayOfPItemIDList = ^TArrayOfPItemIDList;
  TArrayOfPItemIDList = array[0..0] of PItemIDList;
var
  Root: IShellFolder;
  FolderPidl: PItemIDList;
  Folder: IShellFolder;
  p: PArrayOfPItemIDList;
  chEaten: ULONG;
  dwAttributes: ULONG;
  FileCount: Integer;
  i: Integer;
  Malloc: IMalloc;
begin
  Result := nil;
  OleCheck(SHGetMalloc(Malloc));
  OleCheck(SHGetDesktopFolder(Root));
  OleCheck(Root.ParseDisplayName(0, nil, PWideChar(WideString(Directory)),
    chEaten, FolderPidl, dwAttributes));
  try
    OleCheck(Root.BindToObject(FolderPidl, nil, IShellFolder,
      Pointer(Folder)));
    FileCount := Files.Count;
    p := AllocMem(SizeOf(PItemIDList) * FileCount);
    try
      for i := 0 to FileCount - 1 do begin
        OleCheck(Folder.ParseDisplayName(0, nil,
          PWideChar(WideString(Files[i])), chEaten, p^[i], dwAttributes));
      end;
      OleCheck(Folder.GetUIObjectOf(0, FileCount, p[0], IDataObject, nil,
        Pointer(Result)));
    finally
      for i := 0 to FileCount - 1 do begin
        if p[i] <> nil then Malloc.Free(p[i]);
      end;
      FreeMem(p);
    end;
  finally
    Malloc.Free(FolderPidl);
  end;
end;

function ExtToCLSID(const Ext: string): string;
// 拡張子から CLSID(文字列)を取得する関数。
var
  S: array[0..255] of Char;
  cb: Integer;
begin
  Result := '';
  cb := SizeOf(S);
  if RegQueryValue(HKEY_CLASSES_ROOT, PChar(Ext), S, cb)
    <> ERROR_SUCCESS then Exit;
  Result := S;
end;

function GetClassData(const CLSID, SubKey: string): string;
// CLSIDのデータを取得する関数。
var
  S: array[0..255] of Char;
  Key: string;
  cb: Integer;
begin
  Result := '';
  Key := CLSID;
  if SubKey <> '' then
    Key := Key + '\' + SubKey;
  cb := SizeOf(S);
  if RegQueryValue(HKEY_CLASSES_ROOT, PChar(Key), S, cb)
    <> ERROR_SUCCESS then Exit;
  Result := S;
end;

procedure SendTo(const Receiver, Directory: string; Files: TStrings);
// 「送る」をエミュレートする関数。
// Receiverに送り先のファイル名を指定する。
//   拡張子が重要。「ﾒｰﾙ受信者」に渡す場合は '.MAPIMail'だけでもよい。
//   ショートカットに渡す場合など、Reveiverの位置が必要なときはフルパ
//   スを指定。
//   拡張子は見えなくされていることがあるので、そのときはコマンドプロ
//   ンプトやファイルマネージャで確認するとよい。
// Directory, Filesは GetFileListDataObjectと同じ。
var
  Ext: string;
  CLSID: string;
  DropHandlerGUID: string;
  DropHandler: IUnknown;
  Data: IDataObject;
  dwEffect: DWORD;
begin
  // 拡張子に対応する Drop Handlerを取得する。
  Ext := ExtractFileExt(Receiver);
  CLSID :=  ExtToCLSID(Ext);
  DropHandlerGUID := GetClassData(CLSID, 'shellex\DropHandler');
  DropHandler := CreateComObject(StringToGUID(DropHandlerGUID));
  // ファイルリストの Data Objectを作る。
  Data := GetFileListDataObject(Directory, Files);
  // Drop Handlerにデータをわたす。
  OleCheck((DropHandler as IPersistFile).Load(PWideChar(WideString(Receiver)),
    STGM_READ));
  dwEffect := DROPEFFECT_COPY or DROPEFFECT_MOVE or DROPEFFECT_LINK;
  OleCheck((DropHandler as IDropTarget).DragEnter(Data, MK_LBUTTON,
    Point(0, 0), dwEffect));
  OleCheck((DropHandler as IDropTarget).Drop(Data, MK_LBUTTON,
    Point(0, 0), dwEffect));
end;

// Coinitialize, CoUninitializeは ComObjユニットがやってくれる。
end.

//////////////////////////////////////////////////////////////////

// サンプル（「ﾒｰﾙ受信者」に送る）
procedure TForm1.Button1Click(Sender: TObject);
var
  Files: TStrings;
begin
  Files := TStringList.Create;
  try
    Files.Add('C:\Test.txt');
    Files.Add('C:\Test.jpg');
    SendTo('ﾒｰﾙ受信者.MAPIMail', '', Files);
  finally
    Files.Free;
  end;
end;

                                                    ぜえた (QZC05100)
 


- FDELPHI  MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 00/10/01 -

Original document by ぜえた          氏 ID:(QZC05100)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。