今気づきましたが、フォルダを列挙することはできないです。
| history | TOP |
2008/01/01:作成
| はじめに | TOP |
今年最初のねたです。エクスプローラからのドラッグ&ドロップは、Windowsを使う上で非常に有効な処理ですが、結構面倒です。特にフォルダを再帰的に掘り進めていくのは、定型処理の割に理由のわからないメンドくささがあります。
今回はそのメンドくささにけりをつけるつもりで、ドラッグ&ドロップの処理が必要なアプリのベースにできそうなプロジェクトを作ってみました。
結局のところ、今まで何度も書いてることの焼き直しですが、すこーしだけ色をつけてみました。
WMDropFiles のメッセージイベントで再帰処理をやってしまうと、ファイルが多くなったときやフォルダの階層が深くなったときに(たしか)動作がとまってしまいます。なので、ドロップされたパスだけをいったん保持して、そこからのファイルの検索自体はメインスレッドとは別のスレッドでバックグラウンドでやってみようと。ただ、そうすると、その別のスレッドから検索結果を受け取らないといけないわけで、なんとも微妙ですが...
両方の場合で作ってみて、操作感を比べてみようかと思ったんですが、邪魔くさくてあきらめました。
| サンプル画面とダウンロード | TOP |
20080101DropFolder.zip(173,529Bytes) テストに使ったソースコードと実行ファイルです。
こんな画面です。ファイルやフォルダをドロップすると、ファイルはそのまま追加して、フォルダの場合は最下層まで掘り進んでいきます。で、すべてのファイルを列挙します。ここでは、C:¥Windows¥ フォルダをドロップしました。もちろん途中で我慢できずにキャンセルしました。
今気づきましたが、フォルダを列挙することはできないです。
残念ながら動作確認は不完全ですが、キャンセルはききます。
| ソースコード(検索スレッド) | TOP |
//=============================================================================
// ファイルを再帰的に検索するスレッド
// 2008.01.01 BlueLeaf1336 fjtkt@ybb.ne.jp
//=============================================================================
unit FindFile;
interface
uses
Windows, Classes, SysUtils, SyncObjs;
//=============================================================================
// Subject: [Delphi-ML:4452] Re: ディレクトリ構造を得るには？
//=============================================================================
type
TFindState = (fsIdle, // 何もしてない(いつでも終了できる)
fsFind // 検索中(終了前に検索中断する必要がある)
);
TFindFileThread = class(TThread)
private
// 検索対象のパス
FPathList: TStringList;
// 検索結果
FResultList: TStringList;
// 状態(検索中かどうか)
FFindState: TFindState;
// 掘り下げるレベル(負: 無限 0: 掘り下げない 正: 掘り下げる)
FMaxLevel: Integer;
// 検索中のフォルダ
FCurrentPath: String;
// 検索を中断させるフラグ
FCancel: Boolean;
public
// コンストラクタ
constructor Create();
// デストラクタ
destructor Destroy(); override;
public
// 外部から検索対象のパスを追加する
procedure PutPath(const APath: String);
// 外部から検索をキャンセルする(検索中断と FPathListクリア)
procedure Cancel();
// 外部から検索結果を取り出す
procedure GetResult(AResult: TStrings; const ACount: Integer = 100);
protected
// パスをひとつずつ FindFiles に渡す
procedure Execute(); override;
// 検索本体
procedure FindFiles(const APath: String; const ALevel: Integer);
// 検索リストの件数
function GetResultCount(): Integer;
public
// 外部から掘り下げるレベルを変更する
property MaxLevel: Integer read FMaxLevel write FMaxLevel;
// 外部から検索中のフォルダを確認する
property CurrentPath: String read FCurrentPath;
// 外部から検索リストの件数を確認する
property ResultCount: Integer read GetResultCount;
end;
var
GFindFileThread: TFindFileThread = nil;
implementation
var
CS: TCriticalSection;
//=============================================================================
// TFindFileThread implementation
//=============================================================================
//-----------------------------------------------------------------------------
// コンストラクタ
constructor TFindFileThread.Create();
begin
inherited Create(True);
FPathList := TStringList.Create();
FPathList.Sorted := True;
FPathList.Duplicates := dupIgnore;
FResultList := TStringList.Create();
FResultList.Duplicates := dupIgnore;
FFindState := fsIdle;
FMaxLevel := -1;
FCurrentPath := '';
FCancel := False;
// FormCreate でプロパティ設定後 Resume();
//Resume();
end;
//-----------------------------------------------------------------------------
// デストラクタ
destructor TFindFileThread.Destroy();
begin
FPathList.Free();
FResultList.Free();
end;
//-----------------------------------------------------------------------------
// 外部から検索対象のパスを追加する
procedure TFindFileThread.PutPath(const APath: String);
begin
CS.Enter();
// フォルダなら検索対象リストに追加
if (DirectoryExists(APath)) then
begin
FPathList.Add(IncludeTrailingPathDelimiter(APath));
end
else
// ファイルなら結果リストに追加
if (FileExists(APath)) then
begin
FResultList.Add(APath);
end;
CS.Leave();
end;
//-----------------------------------------------------------------------------
// 外部から検索をキャンセルする(検索中断と FPathListクリア)
procedure TFindFileThread.Cancel();
begin
CS.Enter();
// 検索対象のリストもクリア
FPathList.Clear();
// 結果リストもクリア
FResultList.Clear();
CS.Leave();
// 検索中なら
if (FFindState = fsFind) then
begin
// 中断させる
FCancel := True;
end;
end;
//-----------------------------------------------------------------------------
// 外部から検索結果を取り出す
procedure TFindFileThread.GetResult(AResult: TStrings; const ACount: Integer);
var
i: Integer;
LCount: Integer;
begin
CS.Enter();
// 取り出す件数を決定
LCount := ACount;
if (LCount > FResultList.Count) then
begin
LCount := FResultList.Count;
end;
// 取り出してメンバのリストから削除
for i := 0 to LCount - 1 do
begin
AResult.Add(FResultList[0]);
FResultList.Delete(0);
end;
CS.Leave();
end;
//-----------------------------------------------------------------------------
// パスをひとつずつ FindFiles に渡す
procedure TFindFileThread.Execute();
var
LPath: String;
begin
while (not Terminated) do
begin
Sleep(1);
FCurrentPath := '';
if (FPathList.Count > 0) then
begin
// 検索対象のリストからひとつ取り出す
CS.Enter();
LPath := FPathList[0];
FPathList.Delete(0);
CS.Leave();
// 検索実行
FFindState := fsFind;
FindFiles(LPath, 0);
FFindState := fsIdle;
FCancel := False;
end;
end;
end;
//-----------------------------------------------------------------------------
// 検索本体
procedure TFindFileThread.FindFiles(const APath: String; const ALevel: Integer);
var
LPath: String;
LRec: TSearchRec;
begin
LPath := IncludeTrailingPathDelimiter(APath);
if (not DirectoryExists(LPath)) then Exit;
// 検索中のパス
FCurrentPath := APath;
// なんか入ってるかな？
if FindFirst(LPath + '*.*', faAnyFile, LRec) = 0 then
begin
try
repeat
// レベルチェック
if (FMaxLevel >= 0) and (FMaxLevel < ALevel) then Exit;
// キャンセルチェック
if (FCancel) then Exit;
// 自フォルダと親フォルダは無視
if (LRec.Name = '.') or (LRec.Name = '..') then Continue;
// フォルダだったら
if ((LRec.Attr and faDirectory) <> 0) then
begin
// 掘り下げる
FindFiles(LPath + LRec.Name, ALevel + 1);
end
// ファイル
else
if (FileExists(LPath + LRec.Name)) then
begin
// 結果リストに追加
CS.Enter();
FResultList.Add(LPath + LRec.Name);
CS.Leave();
end;
until
FindNext(LRec) <> 0;
finally
FindClose(LRec);
end;
end;
end;
//-----------------------------------------------------------------------------
// 検索リストの件数
function TFindFileThread.GetResultCount(): Integer;
begin
Result := FResultList.Count;
end;
//-----------------------------------------------------------------------------
// 開始・終了処理
initialization
CS := TCriticalSection.Create();
GFindFileThread := TFindFileThread.Create();
finalization
GFindFileThread.Free();
CS.Free();
end.
| ソースコード(フォーム側) | TOP |
//=============================================================================
// TMainForm implementation
//=============================================================================
//-----------------------------------------------------------------------------
// エクスプローラからのドラッグアンドドロップを受け付けるようにする
// http://www2.big.or.jp/~osamu/Delphi/tips.cgi?index=0218.txt
procedure TMainForm.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.EXStyle or WS_EX_ACCEPTFILES;
end;
//-----------------------------------------------------------------------------
// フォーム作成時
procedure TMainForm.FormCreate(Sender: TObject);
begin
FTimerThread := TTimerThread.Create(False);
GFindFileThread.Resume();
end;
//-----------------------------------------------------------------------------
// フォーム破棄時
procedure TMainForm.FormDestroy(Sender: TObject);
begin
FTimerThread.Free();
// 検索中ならキャンセル
GFindFileThread.Cancel();
end;
//-----------------------------------------------------------------------------
// エクスプローラからドロップされた時の処理
// http://www2.big.or.jp/~osamu/Delphi/tips.cgi?index=0218.txt
procedure TMainForm.WMDropFiles(var Msg: TWMDropFiles);
var
LPathName: Array[0..MAX_PATH] of Char;
i, LCount: integer;
begin
// ドロップされたファイルの数を取得する
LCount := DragQueryFile(Msg.Drop, DWORD(-1), LPathName, SizeOf(LPathName));
for i := 0 to LCount - 1 do
begin
// それぞれのファイル名を取得する
DragQueryFile(Msg.Drop, i, LPathName, SizeOf(LPathName));
// 検索スレッドに追加
GFindFileThread.PutPath(LPathName);
end;
// ドロップ完了
DragFinish(Msg.Drop);
end;
//-----------------------------------------------------------------------------
// キャンセル
procedure TMainForm.Button1Click(Sender: TObject);
begin
GFindFileThread.Cancel();
end;
//-----------------------------------------------------------------------------
// 検索スレッドから結果を取り出す
procedure TMainForm.UpdateList();
begin
Label1.Caption := GFindFileThread.CurrentPath;
if (GFindFileThread.ResultCount > 0) then
begin
ListBox1.Items.BeginUpdate();
GFindFileThread.GetResult(ListBox1.Items);
ListBox1.Items.EndUpdate();
end;
end;
| EOF | TOP |