SHFileOperationコンポーネント

 エクスプローラのファイルコピーや移動を行なうSHFileOperationをコンポーネントにしました。このコンポーネントを使用するとエクスプローラと同じようにアニメーション付きでファイル操作を行なうことができます。
 以前は某氏が作られたTSHFOPコンポーネントを使用していましたが、このコンポーネントはソースではなくコンパイル済みユニットでの配布になっており、Delphi4でのインストールに難がありました。さらにはDelphi5ではどうしてもインストール出来ないため、自前で作成してしまいました。
不具合を修正しました(1999/12/26)

{
  SHFileOperationコンポーネント

  TSHFOperation

  1999/10/21  Copyright(c) M&I

  TSHFileOpStruct構造体の説明

  メンバー
    wFunc
      オペレーションの種類を指定する.
        FO_COPY
          pFromで指定されたファイルをpToで指定された場所にコピー
        FO_DELETE
          pFromで指定されたファイルを消す(pToは無視される)
        FO_MOVE
          pFromで指定されたファイルをpToで指定された場所に移動
        FO_RENAME
          pFromで指定されたファイル名を変更.

    pFrom
      コピーや移動などしたいファイルの指定バッファ

    pTo
      コピーや移動先の指定バッファ

    fFlags
      ファイル操作をコントロールするフラグ.次の定数の組み合わせで設定する
        FOF_ALLOWUNDO
          可能なら元の情報を維持する。これをTrueにしてFO_DELETEを実行すると、
      可能な場合にはファイルやフォルダがゴミ箱に入ります。
        FOF_FILESONLY
          ワイルドカード(*.*)を指定したとき、ファイルだけをコピーし、
          サブディレクトリとそのファイルをコピーしたくない場合、指定する。
        FOF_MULTIDESTFILES
          元として指定するファイル名等と対になるターゲットファイル名を
          設定するときはこのフラグが必要
        FOF_NOCONFIRMATION
          すべての確認メッセージを表示しないようにする。
        FOF_NOCONFIRMMKDIR
          存在しないディレクトリを指定した場合、そのディレクトリを作成する
          かどうか確認メッセージを出させないようにするには、このフラグを
          セットする
        FOF_RENAMEONCOLLISION
          移動、コピー先または変更先ファイル名がすでに存在した場合、この
          フラグをセットすると、別名で宛先のディレクトリに収める(たとえ
          ば "コピー 〜 ..."、"コピー (2) 〜 ...")
        FOF_SILENT
          進行状況を示すダイアログボックスを表示させないで、この関数を使う
          場合、このフラグを設定
        FOF_SIMPLEPROGRESS
          進行状況を示すダイアログボックスは表示されるが、処理対象ファイル
          名が表示されない。

    fAnyOperationsAborted
      進行状況を表示するダイアログや確認のメッセージを表示した場合、
      ユーザーが「キャンセル」ボタンを押すと、このフラグがTRUEにセット
      される

    lpszProgressTitle
      進行状況を表示するダイアログボックスのタイトルを設定する
      (fFlagsにFOF_SIMPLEPROGRESSがセットされたときのみ有効)

}

unit ShfOperation;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ShellAPI;

type
  TwFunc = (foMOVE, foCOPY, foDELETE, foRENAME);
  // オプション
  TfFlags = class(TPersistent)
  private
    FALLOWUNDO,
    FFILESONLY,
    FMUILIDESTFILES,
    FNOCONFIRMATION,
    FNOCONFIRMMKDIR,
    FRENAMEONCOLLISION,
    FSILENT,
    FSIMPLEPROGRESS: Boolean;
  published
    property ALLOWUNDO:         Boolean read FALLOWUNDO         write FALLOWUNDO;
    property FILESONLY:         Boolean read FFILESONLY         write FFILESONLY;
    property MUILIDESTFILES:    Boolean read FMUILIDESTFILES    write FMUILIDESTFILES;
    property NOCONFIRMATION:    Boolean read FNOCONFIRMATION    write FNOCONFIRMATION;
    property NOCONFIRMMKDIR:    Boolean read FNOCONFIRMMKDIR    write FNOCONFIRMMKDIR;
    property RENAMEONCOLLISION: Boolean read FRENAMEONCOLLISION write FRENAMEONCOLLISION;
    property SILENT:            Boolean read FSILENT            write FSILENT;
    property SIMPLEPROGRESS:    Boolean read FSIMPLEPROGRESS    write FSIMPLEPROGRESS;
  end;
  TShfOperation = class(TComponent)
  private
    { Private 宣言 }
    FSHFOP:   TSHFileOpStruct;
    FwFunc:   TwFunc;
    FpFrom:   TStrings;
    FpToFl:   TStrings;
    FpTo:     string;
    FfFlags:  TfFlags;
    FfAnyOperationsAbort: Boolean;
    FlpszProgressTitle: string;
    procedure SetwFrom(const Value: TStrings);
    procedure SetwTo(const Value: TStrings);
  protected
    { Protected 宣言 }
  public
    { Public 宣言 }
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    function Execute: integer;
  published
    { Published 宣言 }
    property FromFFList:     TStrings  read FpFrom   write SetwFrom;
    property OperationF:     TwFunc    read FwFunc   write FwFunc;
    // MULTIDESTFILESがFalseの場合にはターゲットは単一のファイル又はフォルダ名
    property ToFolder:       string   read FpTo     write FpTo;
    // MULTIDESTFILESがTrueの場合にはターゲットファイルリストを使用する
    property ToFiles:        TStrings  read FpToFl   write SetwTo;
    property Options:        TfFlags   read FfFlags  write FfFlags;
    property fAbort:         Boolean   read FfAnyOperationsAbort;
    property ProgressTitle:  string   read FlpszProgressTitle write FlpszProgressTitle;
  end;

procedure Register;

implementation

constructor TShfOperation.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FpFrom  := TStringList.Create;
  FpToFl  := TStringList.Create;
  FfFlags := TfFlags.Create;
end;

destructor TShfOperation.Destroy;
begin
  FpFrom.Free;
  FpToFl.Free;
  FfFlags.Free;
  inherited Destroy;
end;

procedure TShfOperation.SetwFrom(const Value: TStrings);
begin
  FpFrom.Assign(Value);
end;

procedure TShfOperation.SetwTo(const Value: TStrings);
begin
  FpToFl.Assign(Value);
end;

// TStringListからTSHFileOpStructに渡すファイルリスト形式に
// 変換する
// フォーマットはファイル名#0ファイル名#0ファイル名#0ファイル名#00
procedure SetFiles(Files: PChar; List: TStrings);
var
  i: integer;
  fp: PChar;
  path: string;
begin
  fp := Files;
  for i := 0 to List.Count - 1 do
  begin
    path := List.Strings[i];
    StrPCopy(fp, path);
    Inc(fp, Length(path) + 1);
  end;
  Inc(fp);
  fp^ := #0;
end;

function TShfOperation.Execute: integer;
var
  flag: WORD;
  from, tof: PChar;
  fsize, tsize, i: integer;
begin
  if FpFrom.Count = 0 then
    raise Exception.Create('ShfOperation:ファイルが指定されていません.');

  //オプションを構築する(スマートさに欠けますね)
  flag := 0;
  if FfFlags.ALLOWUNDO then
    flag := flag or FOF_ALLOWUNDO;
  if FfFlags.FILESONLY then
    flag := flag or FOF_FILESONLY;
  if FfFlags.MUILIDESTFILES then
    flag := flag or FOF_MULTIDESTFILES;
  if FfFlags.NOCONFIRMATION then
    flag := flag or FOF_NOCONFIRMATION;
  if FfFlags.NOCONFIRMMKDIR then
    flag := flag or FOF_NOCONFIRMMKDIR;
  if FfFlags.RENAMEONCOLLISION then
    flag := flag or FOF_RENAMEONCOLLISION;
  if FfFlags.SILENT then
    flag := flag or FOF_SILENT;
  if FfFlags.SIMPLEPROGRESS then
    flag := flag or FOF_SIMPLEPROGRESS;

  // 元ファイルリストを作成するためのメモリサイズを計算して確保する
  fsize := 0;
  for i := 0 to FpFrom.Count - 1 do
    fsize := fsize + Length(FpFrom.Strings[i]) + 1;
  fsize := fsize + 10;
  try
    from := AllocMem(fsize); //Getmemを使用していたためメモリが0クリアされていなかった
  except
    raise Exception.Create('ShfOperation:メモリ割当てに失敗しました.');
  end;
  SetFiles(from, FpFrom);

  // オプションにMUILIDESTFILESが指定されている場合にターゲット
  // ファイルリストを作成する
  tsize := 0;
  if FfFlags.MUILIDESTFILES then
  begin
    if FpToFl.Count = 0 then
      raise Exception.Create('ShfOperation:ターゲットが指定されていません.');
    for i := 0 to FpToFl.Count - 1 do
      tsize := tsize + Length(FpToFl.Strings[i]) + 1;
    tsize := tsize + 10;
    try
      tof := Allocmem(tsize); //Getmemから変更
    except
      raise Exception.Create('ShfOperation:メモリ割当てに失敗しました.');
    end;
    SetFiles(tof, FpToFl);
  end;

  with FSHFOP do
  begin
    case FwFunc of
      foMOVE:   wFunc := FO_MOVE;
      foCOPY:   wFunc := FO_COPY;
      foDELETE: wFunc := FO_DELETE;
      foRENAME: wFunc := FO_RENAME;
    end;
    Wnd     := Application.Handle;
    fFlags  := flag;
    pFrom   := from;
    // MUILIDESTFILESオプションによってターゲットの指定を変える
    if FfFlags.MUILIDESTFILES then
      pTo   := tof
    else
      pTo   := PChar(FpTo);
    fAnyOperationsAborted := False;
    hNameMappings := nil;
    // ダイアログタイトルが指定されていればセット
    if FlpszProgressTitle <> '' then
      lpszProgressTitle := PChar(FlpszProgressTitle);
  end;
  try
    // 実行
    Result := SHFileOperation(FSHFOP);
  finally
    ;
  end;
  // ユーザによる処理中断有無をセット
  FfAnyOperationsAbort := FSHFOP.fAnyOperationsAborted;
  // 確保したメモリを開放する
  FreeMem(from, fsize);
  if (tsize > 0) and (tof <> nil) then
    FreeMem(tof, tsize);
end;

procedure Register;
begin
  RegisterComponents('Samples', [TShfOperation]);
end;

end.

実際のコンポーネントはコンポーネントからダウンロードして下さい。

戻る