Recherche par extension avec jvcl

Télécharger le projet
Commenter

Description

Voici un programme qui permet la recherche de fichier suivant l'extension choisie en utilisant le composant JvSelectDirectory. C'est une application simple et qui permet de manipuler le composant JvSelectDirectory, la recherche récursive de fichiers et de dossiers et les TCheckListBox. Il est bien sûr à améliorer car il ne fait rien d'autre que l'affichage des fichiers contenus dans le dossier choisi. Il est assez commenté pour que vous puissiez le modifier facilement selon vos besoins.

Compatible Delphi 2009

Source / Exemple : 


unit U_main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, JvBaseDlg, JvSelectDirectory, StdCtrls, CheckLst,
  ExtCtrls;

type
  TForm1 = class(TForm)
    SD_Path: TJvSelectDirectory;
    GroupBox1: TGroupBox;
    CLB_Extension: TCheckListBox;
    Panel1: TPanel;
    Btn_Open: TButton;
    Txt_Path: TEdit;
    GroupBox2: TGroupBox;
    CLB_File: TCheckListBox;
    Panel2: TPanel;
    Btn_Quitter: TButton;
    Btn_Valider: TButton;
    procedure Btn_OpenClick(Sender: TObject);
    procedure Btn_ValiderClick(Sender: TObject);
    procedure Btn_QuitterClick(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure findExtension(sFolder : String; SL_Extension : TStringList);
var
  SR_Info : TSearchRec;
  iPos, iLength : Integer;
  sSubString : String;
begin
  sFolder := IncludeTrailingPathDelimiter(sFolder);

  if FindFirst(sFolder + '*.*', faAnyFile, SR_Info) = 0 then // Recherche de tous les fichiers
  begin
    repeat
      if (SR_Info.Name <> '.') and (SR_Info.Name <> '..') then // Pour éviter la boucle infinie
      begin
        if (SR_Info.Attr and faDirectory) <> 0 then // Si c'est un dossier
          findExtension(sFolder + SR_Info.Name, SL_Extension) // Alors on recherche le prochain fichier ou dossier
        else // Ici c'est forcément un fichier
        begin
          iPos := Pos('.', SR_Info.Name);
          if iPos <> 0 then // iPos = 0 quand pas trouvé de '.'
          begin
            iLength := Length(SR_Info.Name);
            sSubString := Copy(SR_Info.Name, iPos, (iLength - iPos) + 1); // Récupère l'extension
            if SL_Extension.IndexOf(sSubString) = -1 then // S'il n'existe pas déjà dans la collection
              SL_Extension.Add(sSubString);
          end;
        end;
      end;
    until FindNext(SR_Info) <> 0; // FindNext = 0 si trouvé
    FindClose(SR_Info);
  end;
end;

procedure findFile(sFolder : String; SL_Extension, SL_Fichier : TStringList);
var
  SR_Info : TSearchRec;
  i : Integer;
begin
  sFolder := IncludeTrailingPathDelimiter(sFolder);

  if FindFirst(sFolder + '*.*', faAnyFile, SR_Info) = 0 then // Recherche de tous les fichiers
  begin
    repeat
      if (SR_Info.Name <> '.') and (SR_Info.Name <> '..') then // Sinon boucle infinie
      begin
        if (SR_Info.Attr and faDirectory) <> 0 then // Si c'est un dossier
          findFile(sFolder + SR_Info.Name, SL_Extension, SL_Fichier) // On recherche l'entrée suivante
        else // Sinon c'est que c'est un fichier
        begin
          i := 0;
          while i < SL_Extension.Count do // Avec toutes les extensions qu'on a
          begin
            if FindFirst(sFolder + '*' + SL_Extension[i], faAnyFile, SR_Info) = 0 then // On effectue la recherche
              SL_Fichier.Add(SR_Info.Name); // Et on les ajoute à notre TStringList
            inc(i);
          end;
        end;
      end;
    until FindNext(SR_Info) <> 0; // = 0 si trouvé
    FindClose(SR_Info);
  end;
end;

procedure TForm1.Btn_OpenClick(Sender: TObject);
var
  SL_Extension : TStringList;
  i : Integer;
begin
  SD_Path.InitialDir := 'C:\'; // Chemin de départ
  if SD_Path.Execute then // Quand on clique sur le bouton "..."
  begin
    Txt_Path.Text := SD_Path.Directory;
    SL_Extension := TStringList.Create;
    CLB_Extension.Items.Clear;
    try
      findExtension(Txt_Path.Text, SL_Extension); // On récupère toutes les extensions trouvées dans SL_Extension

      i := 0;
      while i < SL_Extension.Count do // Pour toutes ces extensions
      begin
        CLB_Extension.Checked[CLB_Extension.Items.Add(SL_Extension[i])] := true; // On les ajoute à la CheckListBox en les cochant par défaut
        inc(i);
      end;
      Btn_Valider.Enabled := true; // Pour rendre cliquable le bouton "Valider"
      CLB_Extension.Sorted := true; // Pour trier la liste
    finally;
      SL_Extension.Free;
    end;
  end;
end;

procedure TForm1.Btn_QuitterClick(Sender: TObject);
begin
  self.Close;
end;

procedure TForm1.Btn_ValiderClick(Sender: TObject);
var
  SL_Extension, SL_Fichier : TStringList;
  i : Integer;
begin
  SL_Extension := TStringList.Create;
  SL_Fichier := TStringList.Create;
  try
    CLB_File.Clear;
    i := 0;
    while i < CLB_Extension.Count do // Pour toutes les extensions de la liste
    begin
      if CLB_Extension.Checked[i] then // On regarde si elles sont cochées
        SL_Extension.Add(CLB_Extension.Items.Strings[i]); // Si c'est le cas, on les mémorise dans SL_Extension
      inc(i);
    end;

    findFile(Txt_Path.Text, SL_Extension, SL_Fichier); // Et on effectue la recherche de fichier pour les extensions choisies

    i := 0;
    while i < SL_Fichier.Count do
    begin
      if CLB_File.Items.IndexOf(SL_Fichier[i]) = -1 then
        CLB_File.Checked[CLB_File.Items.Add(SL_Fichier[i])] := true;
      inc(i);
    end;

    CLB_File.Sorted := true;
  finally;
    SL_Extension.Free;
    SL_Fichier.Free;
  end;

end;

end.

Conclusion :


Laissez moi vos critiques en commentaires.
Télécharger le projet

Codes Sources

A voir également

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 (Weirdy)