Optimisation d'une fonction pour lister une arborescence

Signaler
Messages postés
60
Date d'inscription
jeudi 8 mai 2003
Statut
Membre
Dernière intervention
18 février 2011
-
Messages postés
60
Date d'inscription
jeudi 8 mai 2003
Statut
Membre
Dernière intervention
18 février 2011
-
Bonjour

Alors je vous expose mon problème car je n'ai pas trouvé de réponse sur le forum...
J'ai un logiciel qui crée une arborescence des répertoires dans une TTreeview.
Jusque là pas d'embrouille

Pour cela j'utilise la bonne vieille méthode du :

r := FindFirst(repertoire + '*' , faDirectory, sr);
while r = 0 do begin
    if ((sr.Attr and faDirectory) <> 0) and (sr.Name <> '.') and (sr.Name <> '..') then
        etc...
    r := FindNext(sr);
end;

Seulement si l'on y regarde de plus près, la fonction FindFirst ne liste pas seulement les répertoires, elle liste également tous les fichiers contenus dans les répertoires... ce n'est qu'ensuite avec le if ((sr.Attr and faDirectory) <> 0) que l'on garde seulement les répertoires.
Le problème c'est que mine de rien quand on scanne tout un disque dur ça prends bcp plus de temps de lister tout que de lister seulement les répertoires non??

Donc ma question c'est : est-ce que vous connaissez un moyen pour ne lister QUE les répertoires et non pas lister tout puis faire le tri après ?

en espérant avoir été assez clair
merci d'avance
a+
fred

19 réponses

Messages postés
460
Date d'inscription
dimanche 5 décembre 2004
Statut
Membre
Dernière intervention
6 avril 2009
2
Bonjour,

Avec 2 listbox, un donne les fichiers l'autre les dossiers.

Dans ta fonction, le '*' me gène.

voici un exemple qui pourrai peut être t'inspirer :

procedure TForm1.Button1Click(Sender: TObject);
Var Chemin : String;
    Info   : TSearchRec;
begin
  ListBox1.Items.Clear;
  ListBox2.Items.Clear;



  { Pour être sur que la barre oblique finisse le nom du chemin }
  Chemin := IncludeTrailingPathDelimiter(Edit1.Text);



  { Recherche de la première entrée du répertoire }
  If FindFirst(Chemin+'*.*',faAnyFile,Info)=0 Then
  Begin
    Repeat
      { Les fichiers sont affichés dans ListBox1 }
      { Les répertoires sont affichés dans ListBox2 }
      If Not((Info.Attr And faDirectory)=0)
        Then ListBox2.Items.Add(Info.FindData.cFileName)
        Else ListBox1.Items.Add(Info.FindData.cFileName)



      { Il faut ensuite rechercher l'entrée suivante }
    Until FindNext(Info)<>0;



    { Dans le cas ou une entrée au moins est trouvée il faut }
    { appeler FindClose pour libérer les ressources de la recherche }
    FindClose(Info);
  End;



end;


@+,

Cincap

[url]mailto:/url
Messages postés
60
Date d'inscription
jeudi 8 mai 2003
Statut
Membre
Dernière intervention
18 février 2011

hum je pense que tu n'as pas bien saisi mon problème,
en fait la fonction FindFirst(Chemin+'*.*',faAnyFile,Info) va te sortir les noms des répertoires ainsi que les noms des fichiers
et ce n'est qu'après que tu trie avec la fonction If Not((Info.Attr And faDirectory)=0)

c'est déjà ce que je fais, mais le truc c'est que je n'ai pas besoin d'avoir les noms des fichiers, je veux seulement les répertoires, alors je voudrais savoir s'il y a moyen pour que la fonction FindFirst (ou bien une autre fonction) ne sorte QUE les répertoires pour accélérer et alléger la recherche

a+
fred
Messages postés
4297
Date d'inscription
samedi 19 janvier 2002
Statut
Modérateur
Dernière intervention
9 janvier 2013
29
De vos réponses m'est venue l'idée d'en faire la synthèse et d'en tirer une hypothèse à vérifier : à priori, les répertoires n'on pas l'attribut "archive" activé.
En filtrant de manière plus fine, cela éliminerait bon nombre de fichiers dans le traitement. Seuls subsisteront ceux n'ayant pas cet attribut activé :

r := FindFirst(repertoire + '*' , faDirectory - faArchive , sr);

A vérifier...

May Delphi be with you !
<hr color ="#008000" />
Pensez à cliquer sur Réponse acceptée lorsque la réponse vous convient.
http://www.afipa.net/
Messages postés
60
Date d'inscription
jeudi 8 mai 2003
Statut
Membre
Dernière intervention
18 février 2011

merci pour la réponse, ça valait le coup de tenter mais ça ne marche pas
il liste toujours tous les fichiers en plus des répertoires... ou alors je me suis planté

j'ai aussi regardé du coté de windows.findfisrtfile mais j'ai pas trouvé de réponse là non plus...
Messages postés
460
Date d'inscription
dimanche 5 décembre 2004
Statut
Membre
Dernière intervention
6 avril 2009
2
Bonjour,

Sur le site de Bardou Michel, se trouve un composant "Scrute dossier" qui permet de rechercher uniquement les dossiers ou fichiers avec même les sous dossiers.

http://perso.orange.fr/bardou/michel/mescompo/scrute.htm

Voici le code de ce composant :

unit Scrute;



interface



uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;



type
  TScruteEvent = procedure(Sender: TObject; Nom: string) of object;
  TDossier=string;
  TFiltre=String;
  TSousDossier=Boolean;



  TScruteDossier = class(TComponent)
  private
    NomFichierComplet:string;//contient le nom du fichier trouvé au fur et à mesure de l'exploration
    NomDuDossier:string;//contient le nom du dosier trouvé au fur et à mesure de l'exploration
    TailleDuFichier:LongInt;
    DateHeureDuFichier:Integer;
    ValeurDePenetration:Integer;  //permet de récupérer penetration par GetPenetration
    FDossier:TDossier; //contient le dossier de départ de la recherche
    FFiltre:TFiltre;// contient le filtre de la recherche ex : *.* ;*.mp3;*.mid etc...
    FSousDossier:TSousDossier;
    FOnFichier:TScruteEvent;
    FOnDossier:TScruteEvent;
    FOnCreate:TNotifyEvent;
    FOnExecute:TNotifyEvent;
    FOnFinExecute:TNotifyEvent;
    FMaxPenetration:integer;
    Procedure ScruteFichier(Dossier:string;filtre:string;Attributs:integer);
    Procedure ScruteDossier(Penetration:integer;Dossier:string;filtre:string;attributs:integer;recursif:boolean);
    //Function  FNomFichierComplet : string; // renvoie le nom du fichier complet (avec chemin)
  protected
    { Déclarations protégées }
  public
    Stop:boolean; // en mettant stop à true, l'exploration s'arrète. Utilisable par exemple pour répondre aux évènements OnDossier ou OnFichier
    Function GetPenetration:integer;
    Function GetTailleFichier:LongInt;
    Function GetDateHeureFichier:TdateTime;
    Function GetNomFichier:string;
    Function GetNomFichierSimple:string;
    Function GetCheminFichier:string;
    Function GetDossier:string;
    Constructor Create(Aowner:TComponent);override;
    procedure execute;



  published
    property Dossier:TDossier read FDossier write FDossier;
    property Filtre:TFiltre read FFiltre write FFiltre;
    property SousDossier:TSousDossier read FSousDossier write FSousDossier;
    property OnFichier:TScruteEvent read FOnFichier write FOnfichier;
    property OnDossier:TScruteEvent read FOnDossier write FOnDossier;
    property OnCreate:TNotifyEvent read FOnCreate write FOncreate;
    property OnExecute:TNotifyEvent read FOnExecute write FOnExecute;
    property OnFinExecute:TNotifyEvent read FOnFinExecute write FOnFinExecute;
    property MaxPenetration:integer read FMaxPenetration write FMaxPenetration;
  end;



procedure Register;



implementation





procedure TScruteDossier.execute;
begin
  if Assigned(FOnExecute) then FOnExecute(self);
  Stop: =false;
  NomFichierComplet:='';
  NomDuDossier:='';
  TailleDuFichier:=0;
  DateHeureDuFichier:=0;
  ScruteDossier(0,Dossier,filtre,FAanyfile,SousDossier);
  if Assigned(FOnFinExecute) then FOnFinExecute(self);
end;



Constructor TScruteDossier.Create(Aowner:TComponent);
begin
  inherited Create(Aowner);
  FDossier:='c:\';
  FFiltre:='*.*';
  SousDossier:=true;
  Maxpenetration:=10000;
  FOnFichier:=nil;
  FOnDossier:=nil;
  FOnCreate:=nil;
  FOnExecute:=nil;
  If Assigned(FOnCreate) then FOnCreate(Self);//attention : ne fonctionne pas
end;



Function TscruteDossier.GetPenetration:Integer;
begin
  Result:=ValeurDePenetration;
end;
Function TScruteDossier.GetNomFichier:string;
begin
  Result:=NomFichierComplet;
end;



Function TScruteDossier.GetNomFichierSimple:string;
begin
  Result:=extractFileName(NomFichierComplet);
end;





Function TScruteDossier.GetCheminFichier:string;
begin
  Result:=extractFilePath(NomFichierComplet);
end;



Function TScruteDossier.GetDossier:string;
begin
  Result:=NomDuDossier;
end;



function TScruteDossier.GetTailleFichier:LongInt;
begin
  Result:=TailleDuFichier;
end;



function TScruteDossier.GetDateHeureFichier:TDateTime ;
begin
  Result:=FileDateToDateTime(DateHeureDuFichier);
  // pour utiliser la date récupéré, on peut utiliser DecodeDate qui scinde TDateTime en valeurs Année, Mois et Jour.
  // procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Word);
  // Voir aussi DateToStr ou TimeToStr
end;




 



 {ancienne version
Procedure TScruteDossier.ScruteFichier(Dossier:string;filtre:string;Attributs:integer);
var FichierTrouve:string;
    Resultat:Integer;
    SearchRec:TSearchRec;
    MaskPtr,Ptr:Pchar;
begin
  If (Dossier<>'')
    then if  (Dossier[length(Dossier)]='\')
      then Dossier:=copy(Dossier,1,length(Dossier)-1);
  MaskPtr := PChar(Filtre);
  while MaskPtr <> nil do // boucle pour chaque filtre contenu dans Filtre
  begin
       Ptr := StrScan (MaskPtr, ';');// adresse de la première occurence de ';'
       if Ptr <> nil then Ptr^ := #0; // on remplace le ; par un caractère de fin de chaine #0
       // ainsi, MaskPtr ne sera interprété que comme ayant un seul filtre
       Resultat:=FindFirst(Dossier+'\'+MaskPtr,Attributs,SearchRec);
       while (Resultat=0) and (not stop) do
       begin
            Application.ProcessMessages; // rend la main à windows pour qu'il traite les autres applications (évite que l'application garde trop longtemps la main
            if ((SearchRec.Attr and faDirectory)<=0) then // On a trouvé un Fichier (et non un dossier)
            begin
                 if Assigned(FOnFichier) then
                 begin
                      FichierTrouve:=Dossier+'\'+SearchRec.Name;
                      NomFichierComplet:=FichierTrouve;
                      TailleDuFichier:=SearchRec.Size;
                      DateHeureDuFichier:=SearchRec.Time;
                      FOnFichier(self,FichierTrouve);
                 end;
            end;
            Resultat:=FindNext(SearchRec);
       end;
       FindClose(SearchRec);// libération de la mémoire
       if Ptr <> nil then
       begin
            Ptr^ := ';';// on remet le ; à la place du #0
            Inc (Ptr); // on se décale dans la chaine de caractère pour se placer derrière le #0
       end;
       MaskPtr := Ptr;//on retire ainsi les filtres déjà vus
  end;
end;
 fin ancienne version}





Procedure TScruteDossier.ScruteFichier(Dossier:string;filtre:string;Attributs:integer);
var FichierTrouve:string;
    Resultat:Integer;
    SearchRec:TSearchRec;
    Mask:string;



begin
  If (Dossier<>'')
  //Si dossier fini par \ on l'enlève
    then if  (Dossier[length(Dossier)]='\')
      then Dossier:=copy(Dossier,1,length(Dossier)-1);



  while length(filtre)>0 do
  begin//On prend la première valeur dans le Filtre
    If Pos(';',filtre)>0 then
    begin
      mask:=copy(filtre,0,Pos(';',filtre)-1);
    end
    else
    begin
      mask:=filtre;
    end;
    Resultat:=FindFirst(Dossier+'\'+Mask,Attributs,SearchRec);
    while (Resultat=0) and (not stop) do
    begin
        Application.ProcessMessages; // rend la main à windows pour qu'il traite les autres applications (évite que l'application garde trop longtemps la main
        if ((SearchRec.Attr and faDirectory)<=0) then // On a trouvé un Fichier (et non un dossier)
        begin
             if Assigned(FOnFichier) then
             begin
                  FichierTrouve:=Dossier+'\'+SearchRec.Name;
                  NomFichierComplet:=FichierTrouve;
                  TailleDuFichier:=SearchRec.Size;
                  DateHeureDuFichier:=SearchRec.Time;
                  FOnFichier(self,FichierTrouve);
             end;
        end;
        Resultat:=FindNext(SearchRec);
    end;
    FindClose(SearchRec);// libération de la mémoire



//On enlève la première partie du filtre
    if Pos(';',filtre)>0 then
      filtre:=copy(filtre,Pos(';',filtre)+1,length(filtre)-Pos(';',filtre))
    else filtre:='';
  end;  //fin du while
end;





Procedure TScruteDossier.ScruteDossier(Penetration:integer;Dossier:string;filtre:string;attributs:integer;recursif:boolean);
var DossierTrouve:string;
    Resultat:Integer;
    SearchRec:TSearchRec;
begin
  If (Penetration>MaxPenetration) and (MaxPenetration > -1) then exit;// sort de la procédure si on est rentré trop profondément
  ValeurDePenetration:=Penetration;//afin de pouvoir être récupéré par GetPenetration
  if Dossier<>'' then
     If Dossier[length(Dossier)]='\' then Dossier:=copy(Dossier,1,length(Dossier)-1); // s'il y a un '\' à la fin, je le retire
  ScruteFichier(Dossier,filtre,attributs); //pour trouver les fichiers du dossier
  Resultat:=FindFirst(Dossier+'\'+'*.*',FaDirectory +faHidden + faSysFile ,SearchRec); //permet de trouver le premier sous dossier de Dossier
  while (Resultat=0) and (not stop)do                                           // SearchRec contient tous les renseignements concernant le dossier trouvé
  begin
    if (SearchRec.Name<>'.') and (SearchRec.Name<>'..')
         and ((SearchRec.Attr and faDirectory)>0) then // C'est comme cela que je teste si on a trouvé un Dossier et non un fichier
    begin
      DossierTrouve:=Dossier+'\'+SearchRec.Name; // pour avoir le nom du dossier avec le chemin complet
      NomDuDossier:=DossierTrouve;
      if Assigned(FOnDossier) then FOnDossier(self,DossierTrouve);
      //if stop then exit;
      if recursif and not stop then
      begin
        ScruteDossier(Penetration+1,DossierTrouve,filtre,attributs,recursif);// je relance la recherche mais cette fois à partir du dossier trouvé
        ValeurDePenetration:=Penetration;//afin de pouvoir être récupéré par GetPenetration
      end;
      Application.ProcessMessages; // rend la main à windows pour qu'il traite les autres applications (évite que l'application garde trop longtemps la main
    end;
    Resultat:=FindNext(SearchRec); // permet de trouver les sous dosssiers suivants
  end;
  FindClose(SearchRec);//libère la mémoire
end;





procedure Register;
begin
  RegisterComponents('Phidels', [TScruteDossier]);
end;



end.


@+,

Cincap

[url]mailto:/url
Messages postés
460
Date d'inscription
dimanche 5 décembre 2004
Statut
Membre
Dernière intervention
6 avril 2009
2
Ne reprendre qu'une partie du 1er code est aussi rapide avec un Tedit pour le chemin

procedure TForm1.Button1Click(Sender: TObject);
Var Chemin : String;
    Info   : TSearchRec;
begin
   ListBox1.Items.Clear;  { Pour être sur que la barre oblique finisse le nom du chemin }
  Chemin := IncludeTrailingPathDelimiter(Edit1.Text);

  { Recherche de la première entrée du répertoire }
  If FindFirst(Chemin+'*.*',faAnyFile,Info)=0 Then
  Begin
    Repeat
            { Les répertoires sont affichés dans ListBox1 }
      If Not((Info.Attr And faDirectory)=0)
        Then ListBox1.Items.Add(Info.FindData.cFileName)
            { Il faut ensuite rechercher l'entrée suivante }
    Until FindNext(Info)<>0;

    { Dans le cas ou une entrée au moins est trouvée il faut }
    { appeler FindClose pour libérer les ressources de la recherche }
    FindClose(Info);
  End;

end;

@+,

Cincap

[url]mailto:/url
Messages postés
436
Date d'inscription
jeudi 9 janvier 2003
Statut
Membre
Dernière intervention
5 février 2015

Salut tout le monde,

en fait il faudra trier quelque soit la méthode

le "Findfirst" de Delphi c'est le "Windows.FindfirstFile" mis dans une fonction

Delphi fait ainsi :





<hr />

function FindFirst(const Path: string; Attr: Integer;
  var F: TSearchRec): Integer;
const
  faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
begin
  F.ExcludeAttr := not Attr and faSpecial;
  F.FindHandle := FindFirstFile(PChar(Path), F.FindData);
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Result := FindMatchingFile(F);
    if Result <> 0 then FindClose(F);
  end else
    Result := GetLastError;
end;





<hr />
On ne peut avoir les dossiers exclusivement : 
      faDirectory n'est pas exclusif (à priori) même associé ou par soustraction d'une autre constante "fa####"

Donc il faut que vous triez : d'une manière ou une autre vous ferez votre propre "Findfirst"

sinon avec des Listbox ou Combobox : (j'en parlais là : http://www.phidels.com/php/forum/forum.php3?forumtable=posts&mode=showpost&postid=65734 ), on peut faire :





<hr />


procedure TForm1.Button1Click(Sender: TObject);
begin{répertoires seuls}
     Listbox1.Clear;
     sendmessage(listbox1.handle,LB_DIR,DDL_DIRECTORY or DDL_EXCLUSIVE,longint(pchar('C:\MonRépertoire\*.*')));
     listbox1.Items.Delete(  listbox1.Items.IndexOf('[..]'));// si besoin (et on peut enlever d'autres exceptions éventuellement)

end;

procedure TForm1.Button2Click(Sender: TObject);
begin{répertoires seuls 2° méthode}
     Listbox1.Clear;
     sendmessage(listbox1.handle,LB_DIR,DDL_DIRECTORY or DDL_EXCLUSIVE,longint(pchar('C:\MonRépertoire\*.*')));
     listbox1.Items.SetText(pchar(StringReplace(listbox1.Items.GetText,'[','',[rfReplaceAll])));
     listbox1.Items.SetText(pchar(StringReplace(listbox1.Items.GetText,']','',[rfReplaceAll])));
     listbox1.Items.Delete(  listbox1.Items.IndexOf('..'));// si besoin (et on peut enlever d'autres exceptions éventuellement)
end;




procedure TForm1.Button3Click(Sender: TObject);
begin{fichiers archives seuls, par exemple}
     Listbox1.Clear;
     sendmessage(listbox1.handle,LB_DIR,DDL_ARCHIVE,longint(pchar('C:\MonRépertoire\*.*')));
end;






<hr />



ça peut se faire aussi avec un Combobox : on met "CB_DIR" à la place de "LB_DIR"

Au total, je pense qu'il faut se faire son propre tri quelque soit la méthode

Si je me trompe dans ma théorie, vous me le direz

DrJerome
Messages postés
60
Date d'inscription
jeudi 8 mai 2003
Statut
Membre
Dernière intervention
18 février 2011

Merci pour toutes ces réponses !

Bon ben a priori ce n'est pas possible donc dans tout les cas les fichiers sont aussi listés et il faut trier après-coup.
Je pensais peut-être regarder dans le code des "TCustomShellTreeView" mais c'est un peu trop complexe pour moi...

C'est pas grâve c'était juste une idée comme ça pour optimiser un peu mon truc mais ça marche déjà bien c'est ça l'important.

En tout cas merci pour toutes vos réponses !
a+
fred
Messages postés
3818
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
18 septembre 2020
34
Salut,

que de complications ...

Procedure FindDirs(Directory: String; aList : TStrings; Const SubFolders : Boolean = True);
Var SearchRec : TSearchRec;
Begin
  If Directory[Length(Directory)] <> '\' Then Directory : = Directory + '\';
  If FindFirst(Directory + '*.', faDirectory, SearchRec) = 0 Then
    Begin
      aList.BeginUpdate;
      Repeat
        If (SearchRec.Attr And faDirectory = faDirectory) And (SearchRec.Name[1]
          <> '.') Then
          Begin
            aList.Add(SearchRec.Name);
            If (SearchRec.Attr And faDirectory > 0) and SubFolders Then
              FindDirs(Directory + SearchRec.Name, aList); // recherche récusive
          End;
      Until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);
      aList.EndUpdate;
    End;
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.Clear;
  ListBox2.Clear;
  FindDirs('c:\Program Files', ListBox1.Items, False);// sans les sous répertoires
  FindDirs('c:\Program Files', ListBox2.Items);// avec les sous répertoires
end;

Ou encore dans le style à DrJérome (mais qui ne renvoie que les répertoires )

procedure TForm1.Button2Click(Sender: TObject);
Var aDir : String;
begin
  ListBox1.Clear;

  ListBox2.Clear;
//Liste le tout ... ATTENTION ça peut être long
 
aDir : = 'c:\*.*';
 SendMessage(ListBox1.Handle,
 LB_DIR, DDL_ARCHIVE +
 DDL_DIRECTORY +
 DDL_DRIVES +
 DDL_EXCLUSIVE +
 DDL_HIDDEN +
 DDL_READONLY +
 DDL_READWRITE +
 DDL_SYSTEM,
 Integer(aDir));

// ne liste que les répertoires
 aDir := 'c:\*.';
 SendMessage(ListBox2.Handle,
 LB_DIR, DDL_DIRECTORY +
 DDL_SYSTEM,
 Integer(aDir));
end ;

au passage ... les amis ...
 pour lister les répertoire ce n'est ni "*
" ni "*.*
" mais "*."

 
@+
Cirec

<hr size ="2" />
Messages postés
3818
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
18 septembre 2020
34
petite correction :

// ne liste que les répertoires
 aDir := 'c:\*.';
 SendMessage(ListBox2.Handle,  LB_DIR, DDL_DIRECTORY , Integer(aDir)); // suffit amplement

et aussi que la Méthode de DrJérome fonctionne aussi avec DDL_EXCLUSIVE  (que j'avais pas vu)

 aDir : = 'c:\*.*';

 SendMessage(ListBox2.Handle,  LB_DIR, DDL_DIRECTORY OR DDL_EXCLUSIVE , Integer(aDir));

enfin il y a le choix et tout fonctionne parfaitement
 
@+
Cirec

<hr size="2" />
Messages postés
60
Date d'inscription
jeudi 8 mai 2003
Statut
Membre
Dernière intervention
18 février 2011

c'était juste *.
au lieu de *.*
!!!
trop bon !!!!
merci cirec, t'es un dieu
Messages postés
4297
Date d'inscription
samedi 19 janvier 2002
Statut
Modérateur
Dernière intervention
9 janvier 2013
29
Ben moi je suis moyennement d'accord dans la mesure où rien n'interdit de nommer un répertoire comme un fichier. En précisant seulement "*.", tu risques de passer à côté de certains dossiers.

May Delphi be with you !
<hr color="#008000" />
Pensez à cliquer sur Réponse acceptée lorsque la réponse vous convient.
http://www.afipa.net/
Messages postés
60
Date d'inscription
jeudi 8 mai 2003
Statut
Membre
Dernière intervention
18 février 2011

aïe effectivement je me suis emballé un poil vite (enfin respect quand même cirec hein )
mais avec "*.
" s'il y a un point dans un nom de dossier il n'est pas listé...

je vais voir avec la méthode DrJérome ce que ça donne (??? c'est qui DrJérome???)
Messages postés
60
Date d'inscription
jeudi 8 mai 2003
Statut
Membre
Dernière intervention
18 février 2011

Bon voilà ma fonction de listage des répertoires, si vous pensez que ça peut être amélioré n'hésitez pas
A propos comment on fait pour poster du code sur le forum ?

//============================================================================//
{             Ajoute un répertoire (et ses sous-rep) à la treeview             }
//----------------------------------------------------------------------------//
procedure TForm1.AjouteRep(const Rep: string);
var
    i,j   : Integer;
    BaseTreeNode, MyTreeNode: TTreeNode;
    DirListe : TListBox;
begin
            { Lecture des sous-répertoires du répertoire Rep et ajout dans la Treeview }
    DirListe := TListBox.CreateParented(Form1.Handle);
    with TreeView1.Items do begin
        BaseTreeNode := Add(nil, Rep);      // On Ajoute le répertoire de base à la TreeView
        i := Count - 1;                     // On indexe au dernier élément ajouté à la TreeView
        while i < Count do begin
            MyTreeNode := TreeView1.Items[i];
            With MyTreeNode Do begin
              if Level < 10 then begin
                                            // Liste les sous-répertoires et les ajoute à la TreeView
                DirListe.Clear;
                SendMessage(DirListe.Handle, LB_DIR, DDL_DIRECTORY OR DDL_EXCLUSIVE, Integer(ReconstruitRep(MyTreeNode) + '*.*'));
                for j := 1 to DirListe.Count - 1 do begin
                    AddChild(MyTreeNode, Copy(DirListe.Items[j], 2, Length(DirListe.Items[j]) - 2));
                end;
              end;
            end;
            Inc(i);                         // On avance d'un cran dans la TreeView
            Application.ProcessMessages;
        end;
    end;
    DirListe.Free;
    BaseTreeNode.AlphaSort(True);           // Trie par ordre alphabetique
    BaseTreeNode.Expand(False);             // Expand le noeud de base
end;
Messages postés
436
Date d'inscription
jeudi 9 janvier 2003
Statut
Membre
Dernière intervention
5 février 2015

salut

@flagada :
"je vais voir avec la méthode DrJérome ce que ça donne (??? c'est qui DrJérome???)"

drjerome c'est moi ! hi! hi!

oui j'avais proposé la solution (voir à la page n°1 du présent thread) :



sendmessage(listbox1.handle,LB_DIR,DDL_DIRECTORY or DDL_EXCLUSIVE,longint(pchar('C:\MonRépertoire\*.*')));

c'est ce que CIREC appellait la méthode drjerome (merci Cirec)






DrJerome
Messages postés
718
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
22 novembre 2016
3
Ce qui est long dans le traitement (et dans tout traitement d'ailleur) c'est l'affichage, pour ma part une recherche sans affichage est bcp plus rapide que l'on ne le pense.

Pour ma part, et comme d'habitude, je te propose l'API Windows pour la recherche.
Je sais pas si en terme de temps tu y gagnera mais çà t'evite de passer par la VCL de borland.

{ Recherche recursive à partir d'un chemin de départ }
procedure ElgScanFichier ( NomDossier : string );
var
  hFound    : Cardinal;
  sFileData : WIN32_FIND_DATA;
begin
  NomDossier := Slach( NomDossier );
  hFound     := FindFirstFile( PChar(NomDossier + '*.*'), sFileData );

  repeat
    if ( ( lstrcmpi( @sFileData.cFileName, '.' ) <> 0 ) and ( lstrcmpi ( @sFileData.cFileName, '..' ) <> 0 ) ) then
    begin
      // Là on se base sur l'attribut FILE_ATTRIBUTE_DIRECTORY pour differencier les Dossiers des fichiers
      if ( ( sFileData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY ) <> FILE_ATTRIBUTE_DIRECTORY ) then
      begin
        // Action à effectuer
        // ***********************

        //    Là tu as ton fichier = > ( NomDossier + sFileData.cFileName );

        // ***********************
      end else

      //        Si tu veux parcourir tout les sous repertoires tu peux ajouter la ligne en dessous
      //         ElgScanFichier( NomDossier + sFileData.cFileName );

    end;
  until ( not FindNextFile( hFound, sFileData ) );

  Windows.FindClose( hFound );
end;

Essai et dit moi.

Bon code, ++
Messages postés
460
Date d'inscription
dimanche 5 décembre 2004
Statut
Membre
Dernière intervention
6 avril 2009
2
Bonjour,

Le 1er code proposé ne convenait pas pour quelle raison puisque après test de toutes les solutions il est aussi rapide que les autres solutions ? (test avec le répertoire c:\Windows\System32).

procedure TForm1.Button1Click(Sender: TObject);
Var Chemin : String;
    Info   : TSearchRec;
begin
  ListBox1.Items.Clear;
  ListBox2.Items.Clear;  { Pour être sur que la barre oblique finisse le nom du chemin }
  Chemin := IncludeTrailingPathDelimiter(Edit1.Text);

  { Recherche de la première entrée du répertoire }
  If FindFirst(Chemin+'*.*',faAnyFile,Info)=0 Then
  Begin
    Repeat
// au choix
      { Les fichiers sont affichés dans ListBox1 }
      { Les répertoires sont affichés dans ListBox2 }
     
If Not((Info.Attr And faDirectory)=0)
   // au choix pour les répertoires     
    Then ListBox2.Items.Add(Info.FindData.cFileName)
 // au choix pour les fichiers 
      Else ListBox1.Items.Add(Info.FindData.cFileName)

      { Il faut ensuite rechercher l'entrée suivante }
    Until FindNext(Info)<>0;

    { Dans le cas ou une entrée au moins est trouvée il faut }
    { appeler FindClose pour libérer les ressources de la recherche }
    FindClose(Info);
  End;
end;

Question pour ne pas mourir idiot, les amis.

@+,

Cincap

[url]mailto:/url
Messages postés
718
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
22 novembre 2016
3
Oui c'est bizzard car tout ce que je peux dire c'est que j'ai lister (avec ma solution) tout le dossier "windows\system32" et çà été instantanné .. j'ai pas attendu 1 seule seconde. Et pour lister mon disque dur (avec recursivité) j'ai mis moin d'une minute. Sachant que la première fois est la plus longue, après c'est bcp plus rapide.
Messages postés
60
Date d'inscription
jeudi 8 mai 2003
Statut
Membre
Dernière intervention
18 février 2011

Ben oui au final j'ai commencé un petit prog pour tester les différentes méthodes de listage
Mais je n'ai pas encore eu le temps de faire les comparaisons (je vais redémarrer le PC entre chaque test pour être sûr)

Mais effectivement il ne semble pas y avoir d'énormes différences 

En revanche je pense que je vais bloquer l'affichage en utilisant BeginUpdate et EndUpdate de la Treeview et puis ça devrait le faire

Désolé d'avoir emm... tout le monde avec mes histoires, ça partait d'un bon sentiment a la base

Merci beaucoup en tout cas !