Sujet Précédent Sujet Suivant

Problème de récursivité?

basile9 Messages postés 7 Date d'inscription jeudi 25 septembre 2003 Statut Membre Dernière intervention 13 août 2007 - 21 oct. 2006 à 00:19
f0xi Messages postés 4205 Date d'inscription samedi 16 octobre 2004 Statut Modérateur Dernière intervention 12 mars 2022 - 21 oct. 2006 à 20:07
Bonjour

J'ai adapté une procédure récursive, qui marchait très bien en TP7, pour Delphi 6, dans un programme console.

Voiçi cette procedure, à base de FindFirst, FindNext et FindClose:

Elle est appelée la première fois par:
dircur:='';
Scanfic('c:');{c: pour exemple}

----------------------------------------------------------
Procedure ScanFics(Dir: String);
Var
Fich: TSearchRec;
Begin
DirCur := DirCur + Dir + '\';
If FindFirst(DirCur + '*.*', $37, Fich) = 0 Then
Begin
try
Repeat
If fich.name[1] <> '.' Then
Begin
If (Fich.attr And $10) = $10 Then
Begin { Répertoire}
TraiteNomExt(dircur + Fich.name, true);{traite le nom du répertoire}
ScanFics(fich.name);{scanne ce nouveau répertoire}
setlength(dircur, length(dircur) - 1);{on supprime le '\'}
dircur := ExtractFileDir(dircur); {on remonte d'un niveau}
End
Else { traite le nom d'un fichier}
TraiteNomExt(fich.name, False);
end;
Until findnext(Fich) <> 0;
finally
sysutils.findclose(fich);
end;
End;
End;
----------------------------------------------------------

Mais, presque instantanément, je tombe sur l'erreur 'fichier introuvable' et le suivi des variables ne m'a pas permis de comprendre.

Un très grand merci par avance si vous pouvez m'aider à trouver l'erreur.

3 réponses

Réponse 1 / 3
f0xi Messages postés 4205 Date d'inscription samedi 16 octobre 2004 Statut Modérateur Dernière intervention 12 mars 2022 35
21 oct. 2006 à 00:58
Regarde dans ma source depoc, j'y ai une procedure recursive de scan fichier avec filtres ect...

sinon j'en ai une objet stand alone qui le fait bien, le temps de trouver le code ....

voila, copie cela dans une unité vide, ensuite declare l'unitée dans les uses,
crée une variable de type TPathScanner.

var PhScan : TPathScanner;

dans le create de la fiche mets par exemple :

PhScan := TPathScanner.Create;

PhScan.Directory := 'c:\program files'; // repertoire a scanner
PhScan.Filter    := '.exe';   // filtre d'extention de fichier
PhScan.UseFilter := true;     // utiliser le filtre d'extention
PhScan.ScanSubs  := true;     // scanner les sous repertoire
PhScan.Scan(ListBox1.Items);  // scan le repertoire definit et renvois la liste de fichier dans listbox1

dans l'evenement OnClick d'un boutton place ensuite :

if PhScan.SelectDir then
   PhScan.Scan(ListBox1.Items);

Dans le close/destroy de la fiche mets :

PhScan.Free;

TotalDirs indique le nombre de repertoires scannés (0 si ScanSubs = false)
TotalFiles indique le nombre de fichiers trouvés
TotalSize indique la taille totale de tout les fichiers trouvés

unit PathScan;

interface

uses windows, sysutils, classes, filectrl, forms;

type
  TPathScanner = class(TObject)
  private
    fFirstDir   : string;
    fExtFilter  : string;
    fUseFilter  : boolean;
    fScanSubs   : boolean;
    fTotalDirs  : int64;
    fTotalFiles : int64;
    fTotalSize  : int64;
  protected
    procedure Scanner(Strings : TStrings; const CurDir : string);
    function AttrToStr(const Attr : integer) : string;
  public
    property Directory : string   read fFirstDir  write fFirstDir;
    property Filter    : string   read fExtFilter write fExtFilter;
    property UseFilter : boolean  read fUseFilter write fUseFilter;
    property ScanSubs  : boolean  read fScanSubs  write fScanSubs;
    property TotalDirs : int64    read fTotalDirs;
    property TotalFiles: int64    read fTotalFiles;
    property TotalSize : int64    read fTotalSize;
    function SelectDir : boolean;
    procedure Scan(Strings : TStrings);
    constructor Create;
    destructor Destroy; override;
  end;

implementation

constructor TPathScanner.Create;
begin
  inherited create;
  fTotalDirs := 0;
  fTotalFiles:= 0;
  fTotalSize := 0;
  fExtFilter := '';
  fFirstDir  := '';
  fUseFilter := false;
  fScanSubs  := false;
end;

destructor TPathScanner.Destroy;
begin
  inherited Destroy;
end;

procedure TPathScanner.Scan(Strings : TStrings);
begin
  fTotalDirs := 0;
  fTotalFiles:= 0;
  fTotalSize := 0;
  Strings.BeginUpdate;
  Scanner(Strings,fFirstDir);
  Strings.EndUpdate;
end;

function TPathScanner.AttrToStr(const Attr : integer) : string;
begin
  result := '......';
  if (attr and faVolumeId) <> 0 then  result[1] := 'V'
  else
  if (attr and faDirectory) <> 0 then result[1] := 'D'
  else
     result[1]  := 'F';

  if (attr and faArchive)  <> 0 then result[2] := 'A';
  if (attr and faHidden)   <> 0 then result[3] := 'H';
  if (attr and faReadOnly) <> 0 then result[4] := 'R';
  if (attr and faSysFile)  <> 0 then result[5] := 'S';
  if (attr and faSymLink)  <> 0 then result[6] := 'L';
end;

function TPathScanner.SelectDir : boolean;
var DResult : string;
begin
  result := false;
  If SelectDirectory('Sélèctionnez un dossier :','',DResult) Then begin
     fFirstDir := IncludeTrailingBackSlash(DResult);
     result := true;
  end;
end;

procedure TPathScanner.Scanner(Strings : TStrings; const CurDir : string);
var SRC : TSearchrec;
    SDN : string;
    LC  : integer;  { LC compteur pour processmessage | IDS index de l'element ajouté }
begin
  if DirectoryExists(CurDir) then begin
     { init du compteur a 0 }
     LC  := 0;
     SDN := copy(CurDir,length(fFirstDir)+1,length(CurDir));
     try
       { on recherche le premier fichier ou repertoire }
       if findfirst(CurDir+'*.*',faAnyFile,SRC) = 0 then begin
          { entrée dans la boucle }
          repeat
            { on incremente le compteur }
            inc(LC);

            { si le nom est different de . ou .. (root directory) }
            if (SRC.Name <> '.') and (SRC.Name <> '..') then begin

               { si l'attributs nous indique qu'il s'agit d'un repertoire }
               if fScanSubs and ((SRC.Attr and faDirectory) <> 0) then begin
                  { on recursse ScanProject sur le nouveau repertoire }
                  inc(fTotalDirs);
                  Scanner(Strings,CurDir+SRC.Name+'\');
               end else

               { si l'attribut nous indique qu'il s'agit d'un fichier }
               if not ((SRC.Attr and faVolumeID) <> 0) then begin
                  { on ajoute l'element et on recupere l'index dans IDS }
                  if (not fUseFilter) or (fUseFilter and (ExtractFileExt(SRC.Name) = fExtFilter)) then begin
                     inc(fTotalFiles);
                     inc(fTotalSize,SRC.Size);
                     Strings.Add(SDN+SRC.Name{+'>'+AttrToStr(SRC.Attr)+'>'+IntToStr(SRC.Size)});
                  end;
               end;
            end;
            { tout les dix passages on appel application.processmessage pour rafraichir
              l'affichage }
            if (LC mod 10) = 0 then begin
               application.ProcessMessages;
            end;

          { la boucle se termine quand FindNext ne trouve plus rien }
          until findnext(SRC) <> 0;
       end;
     finally
       { et enfin on ferme SRC }
       FindClose(SRC);
     end;
  end;
end;

end.

<hr size="2" width="100%" />Croc (click me)
0
Réponse 2 / 3
basile9 Messages postés 7 Date d'inscription jeudi 25 septembre 2003 Statut Membre Dernière intervention 13 août 2007
21 oct. 2006 à 09:03
Merci f0xi pour ton aide précieuse : je viens d'essayer ta routine : elle marche beaucoup mieux que la mienne :-) et je l'adopte ..

Bravo pour ta gentillesse et ton dévouement.
0
Réponse 3 / 3
f0xi Messages postés 4205 Date d'inscription samedi 16 octobre 2004 Statut Modérateur Dernière intervention 12 mars 2022 35
21 oct. 2006 à 20:07
c'est fait pour =)

<hr size="2" width="100%" />Croc (click me)
0

Discussions similaires

Maximum d'un tableau en récursivité
amapro -
DARKSIDIOUS -

1 réponse
Fonction recursive
Tajmouti -
Whismeril -

3 réponses
Recursivité
culroussi -
khabdou -

10 réponses
Récursivité ???
Also know as -
f0xi -

6 réponses
Résoudre un labyrinthe en PYTHON récursif
Exypni -
hbouia -

1 réponse
Rejoignez-nous