umakecd.pas

来自「这个程序的基础框架部分是我在玩OOP玩得走火入魔的时候写的（当然那个时候是有意要」· PAS 代码 · 共 89 行

{*******************************************************}
{                                                       }
{       DirTree Demo                                    }
{                                                       }
{       版权所有 (C) 2005 zbird                         }
{                                                       }
{*******************************************************}

unit uMakeCD;

interface

uses
  Classes, SysUtils, Dialogs, uUtils, uIntAddSubX;

type
  TvxMakeCD = class(TThread)
  private
    FDirPath: string;
    FSubXAdder: IvxAddSubFileFactory;
    procedure MakeDirList(aDirPath: string; aSubXAdder: IvxAddSubFileFactory);
  protected
    procedure Execute; override;
  public
    constructor Create(aDirPath: string; aSubXAdder: IvxAddSubFileFactory);
  end;
  
implementation

{
********************************** TvxMakeCD ***********************************
}
constructor TvxMakeCD.Create(aDirPath: string; aSubXAdder:
        IvxAddSubFileFactory);
begin
  FDirPath := aDirPath;
  FSubXAdder := aSubXAdder;
  inherited Create(False);
end;

procedure TvxMakeCD.Execute;
begin
  MakeDirList(FDirPath, FSubXAdder);
end;

procedure TvxMakeCD.MakeDirList(aDirPath: string; aSubXAdder:
        IvxAddSubFileFactory);
var
  FSearchRec, DSearchRec: TSearchRec;
  FindResult: Integer;
  
  function IsDirNotation(ADirName: string): Boolean;
  begin
    Result := (ADirName = '.') or (ADirName = '..');
  end;
  
begin
  aDirPath := GetDirectoryName(aDirPath);
  FindResult := FindFirst(aDirPath + '*.*', faDirectory, DSearchRec);//找目录
  try
    while FindResult = 0 do
    begin
      if ((DSearchRec.Attr and faDirectory) = faDirectory) and not
        IsDirNotation(DSearchRec.Name) then
      begin
        MakeDirList(aDirPath + DSearchRec.Name,
            aSubXAdder.AddSubDir(aDirPath + DSearchRec.Name, DSearchRec));
      end;
      FindResult := FindNext(DSearchRec);
    end;
  finally
    FindClose(DSearchRec);
  end;
  
  FindResult := FindFirst(aDirPath + '*.*', faAnyFile + faHidden +//找文件
    faSysFile + faReadOnly, FSearchRec);
  try
    while FindResult = 0 do
    begin
      aSubXAdder.AddSubFile(aDirPath + FSearchRec.Name, FSearchRec);
      FindResult := FindNext(FSearchRec);
    end;
  finally
    FindClose(FSearchRec);
  end;
end;

end.