SHFileOperationコンポーネント
エクスプローラのﾌｧｲﾙコピーや移動を行なうSHFileOperationをコンポーネントにしました。このコンポーネントを使用するとエクスプローラと同じようにアニメーション付きでファイル操作を行なうことができます。
以前は某氏が作られたTSHFOPコンポーネントを使用していましたが、このコンポーネントはソースではなくコンパイル済みユニットでの配布になっており、Delphi４でのインストールに難がありました。さらにはDelphi5ではどうしてもインストール出来ないため、自前で作成してしまいました。
不具合を修正しました(1999/12/26)
{
SHFileOperationコンポーネント
TSHFOperation
1999/10/21 Copyright(c) Ｍ＆Ｉ
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.