fil recherche de fichier récursive

Question

j'ai une routine qui recherche les fichiers:

procedure RecSearch(const sPathName, sFile : String; const subDir : Boolean); 
var 
    sr : TSearchRec; 
    sPath : String; 
begin 
    Application.ProcessMessages; 
    sPath:=IncludeTrailingBackslash(sPathName); 
    if FindFirst(sPath + sFile, faAnyFile - faDirectory, sr) = 0 then 
    repeat 
     lstBox.Items.Add(sPath + sr.Name); // send files into a ListBox 
    until FindNext(sr) <> 0; 
    FindClose(sr); 

    If not subDir then Exit; 

    if FindFirst(sPath + '*.*', faDirectory, sr) = 0 then 
    repeat 
     if ((sr.Attr and faDirectory) <> 0) and (sr.Name<>'.') and (sr.Name<>'..') then 
     RecSearch(sPath + sr.Name, sFile, True); 
    until FindNext(sr) <> 0; 
    FindClose(sr); 
end; 

mon problème est que je veux utiliser un fil qui fait tout le travail et je ne peux pas l'obtenir fait

i tryed cela et il recherche que dans le répertoire, pas subdirs

const 
    WM_ThreadDoneMsg = WM_User + 8; 

type TfrmSearch = class; 

CSearchThread = class(TThread) 
    private 
     OwnerForm  : TfrmSearch; 
     cntFFound  : Integer; 
     inPath, inFile : String; 
     inFileAttr  : Integer; 
     inFileSize  : LongInt; 
     procedure RecSearch(const sPath, sFile : String; const subDir : Boolean); 
     procedure AddFile; 
    protected 
     procedure Execute; override; 
    published 
     constructor Create(owner : TfrmSearch); 
     destructor Destroy; override; 
end; 

TfrmSearch = class(TForm) 
... 
    edPath: TEdit; 
    edSearchFor: TEdit; 
    chkSubfolders: TCheckBox; 
    lvFiles: TListView; 
... 
    private 
    public 
     srcThread : CSearchThread; 
     procedure SearchThreadDone(var msg : TMessage); message WM_ThreadDoneMsg; 
end; 

var 
    frmSearch: TfrmSearch; 

implementation 

{$R *.dfm} 

constructor CSearchThread.Create(owner : TfrmSearch); 
begin 
    inherited Create(True); 
    OwnerForm:=owner; 
    FreeOnTerminate:=True; 
    Suspended:=False; 
    Priority:=tpHigher; 
    cntFFound:=0; 
    // clear previous entryes 
    ownerForm.lvFiles.Clear; 
    ownerForm.StatusBar.Panels[0].Text:=''; 
end; 

destructor CSearchThread.Destroy; 
begin 
    PostMessage(OwnerForm.Handle, WM_ThreadDoneMsg, Self.ThreadID, 0); 
    inherited destroy; 
end; 

procedure CSearchThread.AddFile; 
var 
    li : TListItem; 
begin 
    li:=OwnerForm.lvFiles.Items.Add; 
    li.Caption:=inFile; 
    li.SubItems.Add(inPath); 
    OwnerForm.StatusBar.Panels[0].Text:=IntToStr(cntFFound)+' files found'; 
end; 

procedure CSearchThread.RecSearch(const sPath, sFile : String; const subDir : Boolean); 
var 
    sr : TSearchRec; 
    attr : Integer; 
begin 
    OwnerForm.StatusBar.Panels[1].Text:=IntToStr(1+StrToInt(OwnerForm.StatusBar.Panels[1].Text)); 
    if FindFirst(IncludeTrailingBackslash(sPath)+sFile, faAnyFile - faDirectory, sr) = 0 then 
    repeat 
     inPath:=sPath; 
     inFile:=sr.Name; 
     inFileAttr:=sr.Attr; 
     inFileSize:=sr.Size; 
     Synchronize(AddFile); 
    until FindNext(sr) <> 0; 
    FindClose(sr); 

    if not subDir then Exit; 

    if FindFirst(sPath + '*.*', faDirectory, sr) = 0 then 
    repeat 
     if ((sr.Attr and faDirectory) <> 0) and (sr.Name<>'.') and (sr.Name<>'..') then 
     RecSearch(sPath + sr.Name, sFile, True); 
    until FindNext(sr) <> 0; 
    FindClose(sr); 
end; 

procedure CSearchThread.Execute; 
begin 
    if DirectoryExists(ownerForm.edPath.Text) then 
    begin 
     RecSearch(ownerForm.edPath.Text, OwnerForm.edSearchFor.Text, OwnerForm.chkSubfolders.Checked); 
    end 
    else 
     ShowMessage('Path not found'); 
end; 

procedure TfrmSearch.SearchThreadDone(var msg : TMessage); 
begin 
    bbtnPause.Enabled:=False; 
end; 

Answer 1

j'ai trouvé ce que je cherchais @pascal newsletter # 01 je vais regarder à nouveau mon code et la recherche de mon erreur

Unit1.dfm:

object Form1: TForm1 
    Left = 468 
    Top = 177 
    Width = 467 
    Height = 354 
    Caption = 'File Search' 
    Color = clBtnFace 
    Font.Charset = DEFAULT_CHARSET 
    Font.Color = clWindowText 
    Font.Height = -11 
    Font.Name = 'MS Sans Serif' 
    Font.Style = [] 
    OldCreateOrder = False 
    OnClose = FormClose 
    OnCreate = FormCreate 
    DesignSize = (
    459 
    320) 
    PixelsPerInch = 96 
    TextHeight = 13 
    object Label1: TLabel 
    Left = 17 
    Top = 13 
    Width = 55 
    Height = 13 
    Alignment = taRightJustify 
    Caption = 'File &Names:' 
    FocusControl = Edit1 
    end 
    object Label2: TLabel 
    Left = 19 
    Top = 42 
    Width = 53 
    Height = 13 
    Alignment = taRightJustify 
    Caption = '&Containing:' 
    FocusControl = Edit2 
    end 
    object Label3: TLabel 
    Left = 31 
    Top = 72 
    Width = 41 
    Height = 13 
    Alignment = taRightJustify 
    Caption = 'In f&older:' 
    FocusControl = Edit3 
    end 
    object Button1: TButton 
    Left = 376 
    Top = 6 
    Width = 78 
    Height = 24 
    Anchors = [akTop, akRight] 
    Caption = '&Find' 
    Default = True 
    TabOrder = 0 
    OnClick = Button1Click 
    end 
    object Button2: TButton 
    Left = 376 
    Top = 38 
    Width = 78 
    Height = 24 
    Anchors = [akTop, akRight] 
    Cancel = True 
    Caption = '&Cancel' 
    Enabled = False 
    TabOrder = 1 
    OnClick = Button2Click 
    end 
    object StatusBar1: TStatusBar 
    Left = 0 
    Top = 301 
    Width = 459 
    Height = 19 
    Panels = <> 
    SimplePanel = True 
    end 
    object Edit1: TEdit 
    Left = 74 
    Top = 8 
    Width = 291 
    Height = 21 
    Anchors = [akLeft, akTop, akRight] 
    TabOrder = 3 
    Text = '*.ini' 
    end 
    object Edit2: TEdit 
    Left = 74 
    Top = 37 
    Width = 291 
    Height = 21 
    Anchors = [akLeft, akTop, akRight] 
    TabOrder = 4 
    Text = 'General' 
    end 
    object Edit3: TEdit 
    Left = 75 
    Top = 67 
    Width = 290 
    Height = 21 
    Anchors = [akLeft, akTop, akRight] 
    TabOrder = 5 
    Text = 'C:\Windows' 
    end 
    object CheckBox1: TCheckBox 
    Left = 76 
    Top = 97 
    Width = 111 
    Height = 13 
    Caption = '&Include subfolders' 
    TabOrder = 6 
    end 
    object ListView1: VListView 
    Left = 0 
    Top = 120 
    Width = 459 
    Height = 188 
    Anchors = [akLeft, akTop, akRight, akBottom] 
    Columns = < 
     item 
     Caption = 'Name' 
     Width = 150 
     end 
     item 
     Caption = 'Folder' 
     Width = 300 
     end> 
    TabOrder = 7 
    ViewStyle = vsReport 
    OnDblClick = ListView1DblClick 
    OnMouseDown = ListView1MouseDown 
    end 
    object Animate1: TAnimate 
    Left = 393 
    Top = 66 
    Width = 48 
    Height = 50 
    Anchors = [akTop, akRight] 
    FileName = 'C:\LatiumSoft\Pascal#001\findfile.avi' 
    StopFrame = 23 
    end 
end 

unit1.pas:

unit Unit1; 

    //{$DEFINE Spanish} 

    { 
    Copyright (c) 2001 Ernesto De Spirito 
    Latium Software http://www.latiumsoftware.com/ 
    Email: edespirito @ latiumsoftware.com 

    To try this example you first have to install the ListViewX component 
    and set a correct value for the FileName property of the Animate1 
    control (the full path name of an AVI file). 

    Para probar este ejemplo primero debe instalar el componente ListViewX y 
    establecer un valor correcto para la propiedad FileName del control 
    Animate1 (la ruta y nombre completo de un archivo AVI). 
    } 

    interface 

    uses 
     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
     Dialogs, ComCtrls, StdCtrls, ShellAPI, ListView; 

    const 
     WM_ThreadDoneMsg = WM_User + 8; 

    {$IFDEF Spanish} 
     cstrCouldNotExecApp = 'No se pudo ejecutar la aplicaci≤n'; 
     cstrSearchEnded = 'B·squeda finalizada (%d ficheros encontrados).'; 
     cstrSearchCancelled = 
     'B·squeda cancelada (%d ficheros encontrados).'; 
     cstrSearching = 'Buscando... (%d ficheros encontrados)'; 
     cstrEnterFileSpec = 'Especifique el nombre de archivo'; 
     cstrEnterKeywords = 'Especifique el texto de b·squeda'; 
     cstrEnterFolder = 'Especifique la carpeta inicial'; 
    {$ELSE} 
     cstrCouldNotExecApp = 'Couldn''t execute the application'; 
     cstrSearchEnded = 'Search ended (%d files found).'; 
     cstrSearchCancelled = 'Search cancelled (%d files found).'; 
     cstrSearching = 'Searching... (%d files found)'; 
     cstrEnterFileSpec = 'Enter file spec'; 
     cstrEnterKeywords = 'Enter keywords'; 
     cstrEnterFolder = 'Enter folder'; 
    {$ENDIF} 

    {$IFDEF WIN32} 
     PathSeparator: char = '\'; 
     DriveSeparator: char = ':'; 
    {$ELSE} 
     PathSeparator: char = '/'; 
     // DriveSeparator: char = ' '; 
    {$ENDIF} 


    type 
     TForm1 = class; 

     TThread1 = class(TThread) 
     private 
     OwnerForm: TForm1; 
     Location: string; 
     FileName: string; 
     Count: cardinal; 
     procedure Initialize; 
     procedure AddFileName; 
     procedure Finalize; 
     protected 
     procedure Execute; override; 
     published 
     constructor Create(Owner: TForm1); 
     destructor Destroy; override; 
     end; 

     TForm1 = class(TForm) 
     Button1: TButton; 
     Button2: TButton; 
     StatusBar1: TStatusBar; 
     Edit1: TEdit; 
     Label1: TLabel; 
     Edit2: TEdit; 
     Label2: TLabel; 
     Edit3: TEdit; 
     Label3: TLabel; 
     CheckBox1: TCheckBox; 
     ListView1: VListView; 
     Animate1: TAnimate; 
     procedure Button1Click(Sender: TObject); 
     procedure Button2Click(Sender: TObject); 
     procedure FormClose(Sender: TObject; var Action: TCloseAction); 
     procedure ListView1DblClick(Sender: TObject); 
     procedure FormCreate(Sender: TObject); 
     procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
     private 
     { Private declarations } 
     Last: TPoint; 
     Thread1: TThread1; 
     procedure Thread1Done(var AMessage: TMessage); message WM_ThreadDoneMsg; 
     public 
     { Public declarations } 
     end; 

    var 
     Form1: TForm1; 

    implementation 

    {$R *.DFM} 

    //--------------------------------------------------------------- 

    procedure TForm1.Button1Click(Sender: TObject); 
    var 
     c: char; 
    begin 
     if Edit1.Text = '' then begin 
     MessageDlg(cstrEnterFileSpec, mtWarning, [mbOK], 0); 
     Edit1.SetFocus; 
     end else if Edit2.Text = '' then begin 
     MessageDlg(cstrEnterKeywords, mtWarning, [mbOK], 0); 
     Edit2.SetFocus; 
     end else if Edit3.Text = '' then begin 
     MessageDlg(cstrEnterFolder, mtWarning, [mbOK], 0); 
     Edit3.SetFocus; 
     end else begin 
     c := Edit3.Text[Length(Edit3.Text)]; 
     if (c <> PathSeparator) and (c <> DriveSeparator) then 
      Edit3.Text := Edit3.Text + PathSeparator; 
     Button1.Enabled := False; 
     Edit1.Enabled := False; 
     Edit2.Enabled := False; 
     Edit3.Enabled := False; 
     Checkbox1.Enabled := False; 
     Button2.Enabled := True; 
     Thread1 := TThread1.Create(Self); 
    // Animate1.Active := True; 
     end;//if 
    end; 

    procedure TForm1.Button2Click(Sender: TObject); 
    begin 
     Thread1.Terminate; 
    end; 

    procedure TForm1.Thread1Done(var AMessage: TMessage); 
    begin 
    // Animate1.Active := False; 
     Button1.Enabled := True; 
     Edit1.Enabled := True; 
     Edit2.Enabled := True; 
     Edit3.Enabled := True; 
     Checkbox1.Enabled := True; 
     Button2.Enabled := False; 
    end; 

    procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); 
    begin 
     if Button2.Enabled then begin 
     Thread1.Terminate; 
     Thread1.WaitFor; 
     end; // if 
     Action := caFree; 
    end; 

    // --------------------------------------------------------------- 

    constructor TThread1.Create(Owner: TForm1); 
    begin 
     inherited Create(True); 
     OwnerForm := Owner; 
     Priority := tpHigher; 
     FreeOnTerminate := True; 
     Suspended := False; 
    end; 

    destructor TThread1.Destroy; 
    begin 
     PostMessage(OwnerForm.Handle, 
     WM_ThreadDoneMsg, Self.ThreadID, 0); 
     inherited destroy; 
    end; 

    procedure TThread1.Execute; 
    var 
     Content: TStringList; 
     Keywords: string; 

    procedure ScanFolder(const folder: string); 
    var 
     SearchRec: TSearchRec; 
    begin 
     if FindFirst(folder + OwnerForm.Edit1.Text, 
      faReadOnly Or faHidden Or faSysFile Or faArchive, 
      SearchRec) = 0 then begin 
     repeat 
      try 
      FileName := SearchRec.Name; 
      Content.LoadFromFile(folder + FileName); 
      if AnsiPos(Keywords, AnsiUpperCase(Content.Text)) 
       <> 0 then begin 
       Inc(Count); 
       Location := folder; 
       Synchronize(AddFileName); 
      end; // if 
      except 
      end; // try 
     until Terminated Or (FindNext(SearchRec) <> 0); 
     end; // if 
     FindClose(SearchRec); 
     if (not Terminated) and OwnerForm.Checkbox1.Checked then begin 
     if FindFirst(folder + '*', faReadOnly Or faHidden 
      Or faSysFile Or faArchive Or faDirectory, 
      SearchRec) = 0 then begin 
      repeat 
      try 
       if ((SearchRec.Attr and faDirectory) <> 0) 
        and (SearchRec.Name <> '.') 
        and (SearchRec.Name <> '..') then 
       ScanFolder(folder + SearchRec.Name + PathSeparator); 
      except 
      end; // try 
      until Terminated Or (FindNext(SearchRec) <> 0); 
     end; // if 
     FindClose(SearchRec); 
     end; // if 
    end; 

    begin // procedure TThread1.Execute; 
     Count := 0; 
     Synchronize(Initialize); 
     Content := TStringList.Create(); 
     Keywords := AnsiUpperCase(OwnerForm.Edit2.Text); 
     ScanFolder(OwnerForm.Edit3.Text); 
     Content.Free; 
     Synchronize(Finalize); 
    end; 

    procedure TThread1.Initialize; 
    begin 
     OwnerForm.StatusBar1.SimpleText := 
     Format(cstrSearching, [Count]); 
     OwnerForm.ListView1.Items.Clear; 
    end; 

    procedure TThread1.AddFileName; 
    var 
     ListItem: TListItem; 
    begin 
     OwnerForm.StatusBar1.SimpleText := Format(cstrSearching, [Count]); 
     ListItem := OwnerForm.ListView1.Items.Add(); 
     ListItem.Caption := FileName; 
     ListItem.SubItems.Add(Location); 
    end; 

    procedure TThread1.Finalize; 
    begin 
     if Terminated then 
     OwnerForm.StatusBar1.SimpleText := 
      Format(cstrSearchCancelled, [Count]) 
     else 
     OwnerForm.StatusBar1.SimpleText := 
      Format(cstrSearchEnded, [Count]); 
    end; 

    procedure TForm1.ListView1DblClick(Sender: TObject); 
    var 
     Col: Integer; 
     ListItem: TListItem; 
    begin 
     ListItem := ListView1.GetItemAtX(Last.X, Last.Y, Col); 
     if ListItem <> nil then begin 
     if Col = 0 then begin 
      if ShellExecute(Self.Handle, nil, 
       PChar(ListItem.SubItems.Strings[0] + ListItem.Caption), 
       nil, nil, SW_SHOWMAXIMIZED) <= 32 then begin 
      Application.MessageBox(cstrCouldNotExecApp, 
       'Error', MB_ICONEXCLAMATION); 
      end;//if 
     end else if Col = 1 then begin 
      if ShellExecute(Self.Handle, 'explore', 
       PChar(ListItem.SubItems.Strings[0]), 
       nil, nil, SW_SHOWMAXIMIZED) <= 32 then begin 
      Application.MessageBox(cstrCouldNotExecApp, 
       'Error', MB_ICONEXCLAMATION); 
      end; // if 
     end; // if 
     end; // if 
    end; 

    procedure TForm1.FormCreate(Sender: TObject); 
    begin 
    {$IFDEF Spanish} 
     Button1.Caption := '&Buscar'; 
     Button2.Caption := '&Detener'; 
     Label1.Caption := 'No&mbre:'; 
     Label2.Caption := 'Con el &texto:'; 
     Label3.Caption := 'B&uscar en:'; 
     CheckBox1.Caption := '&Incluir subcarpetas:'; 
     ListView1.Columns[0].Caption := 'Nombre'; 
     ListView1.Columns[1].Caption := 'Ubicaci≤n'; 
    {$ENDIF} 
    end; 

    procedure TForm1.ListView1MouseDown(Sender: TObject; 
     Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
    begin 
     Last.X := X; 
     Last.Y := Y; 
    end; 

    end. 

Answer 2

courant/sélectionné dans la première procédure, il semble que vous ajoutez un séparateur de chemin jusqu'à la fin de sPath:

sPath:=IncludeTrailingBackslash(sPathName); 

Alors que dans le second, vous ajoutez que le séparateur dans l'appel à FindFirst

if FindFirst(IncludeTrailingBackslash(sPath)+sFile, faAnyFile - faDirectory, sr) = 0 then 

Lorsque vous ajoutez plus tard, un composant de chemin à sPath, il n'y a donc pas de séparation entre le nouveau composant et le reste le chemin

if FindFirst(sPath + '*.*', faDirectory, sr) = 0 then 
    ... 
     RecSearch(sPath + sr.Name, sFile, True); 

Answer 3

Vous pouvez essayer le composant FindFile, qui peut rechercher un chemin donné dans un thread séparé.

Answer 4

Je vois deux cas de thread accédant aux composants VCL - un gros no-no. Construire votre liste de fichiers dans une liste qui ne fait pas partie d'un composant visuel et n'est pas touché par autre chose pendant que le thread est en cours d'exécution.

De même, affichez un message indiquant le nombre de fichiers trouvés, ne le mettez pas à jour directement.

Enfin, ne mettez pas à jour le nombre de fichiers trouvés pour chaque fichier. J'ai vu un programme devenir complètement insensible à l'entrée de l'utilisateur à cause de cette mise à jour excessive. Je ferais quelque chose comme mettre à jour après chaque répertoire et tous les 100 fichiers dans un répertoire ou quelque chose comme ça.