unit RicercaFileeDirectory;

(***********************************************************)
(*    by Mauro Falzari (open.source@email.it), AGO 2002
(***********************************************************)

interface

uses
  Classes;

type
  TExpandedFolder = class
  private
    FDirNames, FFileNames: TStringList;
    FPath: string;
    FDepth, FMaxDepth: Shortint;
    FCancel: Boolean;
    procedure Get;
    procedure SetPath(const Value: string);
    procedure SetMaxDepth(const Value: Shortint);
    function GetDirNames: TStringList;
    function GetFileNames: TStringList;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Cancel;
    { serve per cancellare la ricerca in corso, nel caso di operazioni
      troppo lunghe }

    property Path: string read FPath write SetPath;
    { percorso della cartella corrente}

    property MaxDepth: Shortint read FMaxDepth write SetMaxDepth;
    { profondità di ispezione delle sottocartelle:

      se -1 equivale al massimo livello raggiungibile, cioè verrà
        restituito un elenco contenente TUTTI i files contenuti
        in TUTTE le sottocartelle e un elenco contenente i nomi
        di TUTTE le sottocartelle esistenti

      se 0 verrà ispezionata solo la cartella corrente, cioè verrà
        restituito un elenco contenente i files contenuti
        nella sola cartella corrente e un elenco delle cartelle
        contenute nella sola cartella corrente

      se > 0 il controllo verrà fatto fino al livello dato}

    property DirNames: TStringList read GetDirNames;
    { lista dei nomi delle sottocartelle }

    property FileNames: TStringList read GetFileNames;
    { lista dei nomi dei file contenuti E nella cartella corrente
      E nelle sottocartelle }

  end;

implementation

uses
  Windows, SysUtils, Forms;

const
  NO_MAX_DEPTH: Shortint = -1;
    //non c'è limite alla profondità di ricerca

constructor TExpandedFolder.Create;
begin
  FDirNames:= TStringList.Create;
  FFileNames:= TStringList.Create;
  FMaxDepth:= NO_MAX_DEPTH;
end;

destructor TExpandedFolder.Destroy;
begin
  FDirNames.Free;
  FFileNames.Free;
end;

procedure TExpandedFolder.Cancel;
begin
  FCancel:= True;
end;

function IsDotName(const FileName: string): Boolean;
{ rileva se il nome del file è '.' o '..'

  In DOS il nome di file '.' equivale alla directory corrente,
  mentre il nome '..' alla directory immediatamente superiore.
  Qui è sufficiente eseguire un controllo solo sull'ultimo
  carattere se è uguale a '.', perchè il DOS (Win98SE) non permette
  nomi di file terminanti con uno o più punti, che vengono troncati
  automaticamente (es: 'AFILE...' diventa 'AFILE'}
begin
  Result:= FileName[Length(FileName)] = '.';
end;

function IsDirectory(const FileName: string): Boolean;
const
{ questi valori vengono usati dal programma "Microangelo" per
  mostrare le cartelle con icone differenti da quelle predefinite
  (Win98SE)}
  MICROANGELO_FOLDER_SYS  =   17;
  MICROANGELO_FOLDER_CUST =   20;
begin
  Result:= (GetFileAttributes(PChar(FileName)) in
    [faDirectory, MICROANGELO_FOLDER_CUST, MICROANGELO_FOLDER_SYS]);
end;

procedure TExpandedFolder.Get;
var
  s: TSearchRec;
  NameComplete,NameNoComplete: string;
  ASubFolder: TExpandedFolder;
const
  FIND_ALL_FILES  =   '\*.*';
  FIND_RESULT_OK  =   0;
begin
  FDirNames.Clear;
  FFileNames.Clear;
  FCancel:= False;
  try
    if FindFirst(ExcludeTrailingPathDelimiter(FPath) +
      FIND_ALL_FILES, faAnyFile, s) = FIND_RESULT_OK
    then
      repeat
        Application.ProcessMessages;    //permette d'intercettare
//per esempio la pressione di un tasto collegato col metodo Cancel
        if FCancel then Exit;           //vedi metodo Cancel
        NameComplete:= IncludeTrailingPathDelimiter(FPath) + s.Name;
        NameNoComplete:= s.Name;
        if not IsDotName(s.Name) then
          if IsDirectory(NameComplete) then
            begin
              FDirNames.Add(NameNoComplete);
              ASubFolder:= TExpandedFolder.Create;    //RICORSIONE
              try
                Inc(FDepth, ASubFolder.FDepth);
                if (FMaxDepth = NO_MAX_DEPTH)
                  or (FDepth > FMaxDepth)
                then
                begin
                  Application.ProcessMessages;
                  if FCancel then Exit;   //vedi metodo Cancel
                  ASubFolder.FDepth:= FDepth + 1;
                  ASubFolder.MaxDepth:= FMaxDepth;
                  ASubFolder.Path:= NameComplete;
                  FDirNames.AddStrings(ASubFolder.DirNames);
                  FFileNames.AddStrings(ASubFolder.FileNames)
                end
              finally
                ASubFolder.Free
              end           //try
            end
          else              //nel caso si tratti di un file
            FFileNames.Add(NameComplete)
      until FindNext(s) <> FIND_RESULT_OK
  finally
    FindClose(s)
  end
end;

procedure TExpandedFolder.SetPath(const Value: string);
begin
  if (Trim(Value) <> EmptyStr) and
    (UpperCase(Trim(Value)) <> FPath)
  then
  begin
    FPath:= UpperCase(Trim(Value));
    Get;
  end
end;

procedure TExpandedFolder.SetMaxDepth(const Value: Shortint);
begin
  if Value <> FMaxDepth then
  begin
    if Value > NO_MAX_DEPTH then
      FMaxDepth := NO_MAX_DEPTH
    else
      FMaxDepth:= Value;
    if FPath <> EmptyStr then
      Get;
  end
end;

function TExpandedFolder.GetFileNames: TStringList;
begin
  FFileNames.Sort;
  Result:= FFileNames;
end;

function TExpandedFolder.GetDirNames: TStringList;
begin
  FDirNames.Sort;
  Result:= FDirNames;
end;

end.


 