お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"ディレクトリ再帰を小オブジェクトに"





 定番のディレクトリ再帰処理をオブジェクトにしてみました。
 継承側で DownSubDirectory と UpParentDirectory を
 任意の処理に override します。
 使用例はディレクトリ構造ごと削除のイメージですので
 下位のディレクトリから処理するために UpParentDirectory のみを
 使っています。

 mes16 へ初めての書き込みで緊張しております。 どきどき。(笑)
 まだ Delphi の既存の型を継承してコンポーネントを作るレベルまで
 達していませんが みなさんの書き込みを参考にして いつか
 挑戦してみたい!(いつになることやら。 そのまえに DP4 買わなきゃ。)

ps.
 ところで再帰処理の「再帰」って 英語でなんて書けばいいんでせう?
 TSearchTree じゃなくて もうちょっと格好いい型名にしたいんですが。


program ShowDirDeleteProcess;

{$APPTYPE CONSOLE}

uses
        Windows,SysUtils;

(* --- Dir 再帰オブジェクト ------------------------------------------- *)

type
        TSearchTree = class
        private
                SrchAttr        : integer;
                procedure       DirLoop(Path: string);
                // 再帰処理
        public
                procedure       DownSubDirectory(Path: string); virtual;
                // 降りていったサブディレクトリ毎の処理
                procedure       UpParentDirectory(Path: string); virtual;
                // 子 Dir から上がってきたディレクトリ毎の処理
                procedure       Search(Path: string; attr: integer);
                // -->Path:再帰基点 Dir, Attr:検索 Dir 属性
        end;

procedure TSearchTree.DirLoop(Path: string);
var
        SrchRec : TSearchRec;
        R : integer;
begin
        R := FindFirst( Path+'*.*', faDirectory+SrchAttr, SrchRec );
        while R=0 do begin
                if ( SrchRec.Attr and faDirectory > 0 ) and
                                ( SrchRec.Name[1] <> '.') then begin
                        DownSubDirectory( Path+SrchRec.Name );
                        DirLoop( Path+SrchRec.Name+'\' );
                        UpParentDirectory( Path+SrchRec.Name );
                end;
                R := FindNext( SrchRec );
        end;
        FindClose( SrchRec );
end;

procedure TsearchTree.DownSubDirectory(Path: string);
begin end;

procedure TsearchTree.UpParentDirectory(Path: string);
begin end;

procedure TSearchTree.Search(Path: string; attr: integer);
begin
        //念のため faDirectory:$10 を消す
        SrchAttr := attr and $ffffffef;
        //基点 Dir も対象にする
        DownSubDirectory( Path );
        DirLoop( Path+'\' );
        UpParentDirectory( Path );
end;

(* --- 使用例 --------------------------------------------------------- *)

type
        TDelDirShow = class( TSearchTree )
                procedure       UpParentDirectory(Path: string); override;
        end;

procedure TDelDirShow.UpParentDirectory(Path: string);
begin
        // DeleteFile に *.* は使えないんですが
        // 処理のイメージということで
        writeln( 'DeleteFile( '+Path+'\*.* )' );
        writeln( 'RmDir( '+Path+' )' );
end;

function GetSystemDir: string;
var
        SysDir : array [0..MAX_PATH] of Char;
begin
        if GetSystemDirectory( SysDir, MAX_PATH )=0 then Result := ''
                else Result := string( SysDir );
end;

var
        DS : TDelDirShow;
begin
        DS := TDelDirShow.Create;
        try
                DS.Search( GetSystemDir, 0 );
                // 基点 Dir がちょっと悪趣味(笑)
        finally
                DS.Free;
        end;
end.


(PXC07042) - とらじ -

Original document by 寅次            氏 ID:(PXC07042)


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

Copyright 1996-2002 Delphi Users' Forum