1. Accueil
  2. Tous les snippets
  3. Snippets Delphi / Pascal
  4. Exploration récursive de répertoire

Exploration récursive de répertoire

Soyez le premier à donner votre avis sur cette source.

Snippet vu 7 118 fois - Téléchargée 21 fois

Commenter

Contenu du snippet

J'en avais un peu marre du copier/coller à chaque fois que je devais explorer un répertoire.. du coup, voici une fonction générique qui fait le boulot et renvoie le résultat dans un TStrings. On lui passe le chemin d'un répertoire de base, un filtre genre '*.pdf',et 2 paramètres optionnels.
Côté pratique: si on lui passe un TStrings, le résultat est ajouté à la fin de la liste, sinon création d'une nouvelle liste. La récursivité est aussi optionnelle (récursive par défaut), même si l'intérêt d'une telle fonction est justement la récursivité!

Source / Exemple : 


{------------------------------------------------------------------------------
  Objet: Renvoie une liste des fichiers trouvés.
  Paramètres: -aRep = répertoire de départ
              -aFilter = filtre (ex: '*.tif')
              -aFileType = type de fichiers recherchés (faAnyFile, ...)
              -NoExtApart = Dans le cas où aFilter='*', doit-on lister tous les
                    fichiers (False) ou uniquement ceux sans extension (True)?
              -aList (optionnel) = si nil, création d'une nouvelle liste; sinon
                    ajout à la fin de la liste passée en argument
              -Recurse (optionnel) = récursif? (True par défaut)
 ------------------------------------------------------------------------------}
function ScruterRepertoire(aRep, aFilter: String; aFileType: Integer; NoExtApart: Boolean;
                           aList:TStrings = nil; Recurse: Boolean = True): TStrings;
var
  info: TSearchRec;
  Dir: String;
begin
  if aList<>nil then Result:= aList
  else Result:= TStringList.Create;

  if aRep[Length(aRep)]='\' then Dir:= aRep
  else Dir:= aRep + '\';

  if FindFirst(Dir + aFilter, aFileType, info)=0 then
    repeat
      if (info.Attr and faDirectory =0) then  //fichier
        // Si on ne veut que les fichiers sans ext et que le fichier en a une, on le zappe!
        if not (NoExtApart and (aFilter='*') and (ExtractFileExt(info.Name)<>'')) then
            Result.Add(Dir + info.FindData.cFileName);
    until FindNext(info)<>0;
  FindClose(info);

  if Recurse then
    begin
      if FindFirst(Dir + '*', faDirectory, info)=0 then
        repeat
          if (info.Attr and faDirectory <>0) and (info.Name<>'.') and (info.Name<>'..') then
              ScruterRepertoire(Dir + info.FindData.cFileName, aFilter, aFileType, NoExtApart, Result, Recurse);
        until FindNext(info)<>0;
      FindClose(info);
    end; //end if recurse
end;

Conclusion :


Tout commentaire bla bla bla...

A voir également

Ajouter un commentaire Commentaires
Signaler
Messages postés
65
Date d'inscription
samedi 29 octobre 2005
Statut
Membre
Dernière intervention
8 août 2011
Pour FOXI
Bonjour,
Ton programme fonctionne après deux petites modifs.
Supprimer les lignes :
if aList <> nil then exit; ou mettre : if aList = nil then exit;
et
aList.Clear; sinon à chaque récursion on pert le début de la recherche !
Ta procedure a été appelée pour le test par :

Création d'un bouton, Edit1 pour le dossier, Edit2 pour le filtre, et Memo1 pour le résulat.

procedure TForm1.Button1Click(Sender: TObject);
var S:TStrings; i:integer;
FileType: integer;
begin
try
S := TStringList.Create;
S.Clear;
FileType:=faHidden+faSysfile+faVolumeID+faDirectory+faArchive+faAnyFile;
ScruterRepertoire(Edit1.Text, Edit2.Text, FileType, S, True);
for i:=0 to S.Count-1 do Memo1.Lines.Add(S[i]);
finally
S.Free;
end;
end;
Signaler
Messages postés
139
Date d'inscription
mardi 27 novembre 2007
Statut
Membre
Dernière intervention
10 mai 2010
 2
Petit commentaire sur l'ajout du paramètre NoExtApart:

quand on utilise FindFirst, on peut lister tous les fichiers avec extensions ('*.*') ou tous les fichiers ('*'). J'ai ajouter ce paramètre pour y remédier; si on met le paramètre à True, le filtre '*' ne renverra que les fichiers SANS extension; si le paramètre est False, c'est le fonctionnement classique..
Signaler
Messages postés
139
Date d'inscription
mardi 27 novembre 2007
Statut
Membre
Dernière intervention
10 mai 2010
 2
@fOxi: Oui, si on veut... 2 remarques cependant:
1- Si on passe une liste <> nil , on zappe => pas moyen de concaténer plusieurs recherches dans la même liste;
2- ton FindFirst comporte un filtre et un "FileType" => tu n'explores que les sous-répertoires qui correspondent au filtre; pour peu que ton filtre ne concerne pas les répertoires, ta procédure n'est plus récursive...
Signaler
Messages postés
4202
Date d'inscription
samedi 16 octobre 2004
Statut
Modérateur
Dernière intervention
13 juin 2020
 35
procedure ScruterRepertoire(const aRep, aFilter: String; const aFileType: Integer; aList: TStrings; const Recurse: Boolean = True);
var
info : TSearchRec;
fPrm : string;
begin
if aList <> nil then
exit;

fPrm := aRep;
if fPrm[Length(fPrm)] <> '\' then
fPrm := fPrm + '\';

aList.BeginUpdate;
try
aList.Clear;
if FindFirst(fPrm+aFilter, aFileType, info) = 0 then
case Recurse of
false :
repeat
if (info.Attr and faDirectory) = 0 then
aList.Add(fPrm + info.FindData.cFileName);
until FindNext(info) <> 0;
true :
repeat
if (info.Attr and faDirectory) <> 0 then
begin
if (info.Name <> '.') and (info.Name <> '..') then
ScruterRepertoire(fPrm + info.FindData.cFileName, aFilter, aFileType, aList, Recurse)
end
else
if (Info.Attr and faDirectory) = 0 then
aList.Add(fPrm + Info.FindData.cFileName);
until FindNext(info) <> 0;
end;
finally
findClose(info);
aList.EndUpdate;
end;
end;
Signaler
Messages postés
139
Date d'inscription
mardi 27 novembre 2007
Statut
Membre
Dernière intervention
10 mai 2010
 2
Salut Bacterius,
n'étant pas sûr de tout ce que je vais dire (écrire!), je parle sous le contrôle de la communauté:
les '.' et '..' sont respectivement le répertoire courant et le répertoire parent. Je pense que c'est grossomodo comme ça que Windows sait où il se situe dans le système de fichiers. on voit ces répertoires quand on fait un 'dir' dans la ligne de commande, ou dans certaines applis développées pour d'anciennes versions de Windows (versions 3.xx). Le répertoire '..' était affiché dans l'explorateur pour permettre de remonter au répertoire parent. Donc non, ce n'est pas un bug, ce sont bien des répertoires, ou au moins des raccourcis. Si tu tapes 'cd .' dans l'invite de commande, tu changes de répertoire et te repositionnes sur...le même répertoire!!! si tu tapes 'cd ..' tu remontes au rep parent.

En ce qui concerne Callback, je te remercie pour la piste, je vais explorer ça.

@+
Afficher les 7 commentaires
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (JeremyLecouvert)