この発言は
#01167　ぜえた          さんの「送る」の動作をプログラムで実現する
に対するコメントです

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

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




　ぜえた さん、こんにちは。(^^;

Dropできないとき(DROPEFFECT_NONE)、Dropのかわりに、DragLeaveを呼ぶはず
なのに呼んでなかったり、Effectを考慮してなかったりしていたので、次のを
使ってください。

unit SendToU;

interface

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

function GetFileListDataObject(const Directory: string; Files: TStrings;
  var OKEffects: DWORD): IDataObject;
function ExtToCLSID(const Ext: string): string;
function GetClassData(const CLSID, SubKey: string): string;
function DoSendTo(const Receiver, Directory: string; Files: TStrings;
  OKEffects: DWORD; var Effect: DWORD): Boolean;
procedure SendTo(const Receiver, Directory: string; Files: TStrings);

implementation

function GetFileListDataObject(const Directory: string; Files: TStrings;
  var OKEffects: DWORD): IDataObject;
// ファイル名のリストから Data Objectを生成する関数。
// Directory: [in]  親ディレクトリ。
// Files:     [in]  相対パスのファイル名のリスト。
// OKEffects: [out] DROPEFFECT_COPY, DROPEFFECT_MOVE, DROPEFFECT_LINK
//            の組合せ。ファイルに許される効果を示す。
// Result:    [out] ファイル名のリストを含む 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;
  // SFGAO_CANCOPY = DROPEFFECT_COPY, etc なのです。
  OKEffects := DROPEFFECT_COPY or DROPEFFECT_MOVE or DROPEFFECT_LINK;
  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));
        OKEffects := OKEffects and 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;

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

procedure SendTo(const Receiver, Directory: string; Files: TStrings);
// DoSendTo関数の簡易版。効果は考えない。
var
  Effect: DWORD;
begin
  DoSendTo(Receiver, Directory, Files,
    DROPEFFECT_COPY or DROPEFFECT_MOVE or DROPEFFECT_LINK, Effect);
end;

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

                                                    ぜえた (QZC05100)
 



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

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