filefind.pas

ComPort Library 是一组通信组件。它包括：TComPort、TComData- Packet、TComComboBox、TComRadioGroup、TComLed、TComTermin

{*********************************************************************}
{ procedure TFileFind.SetFilePattern                                  }
{*********************************************************************}
procedure TFileFind.SetFilePattern(AFilePattern: String);
begin
  FConvert.BaseString := AFilePattern;
  FConvert.BreakApart;
  FFilePattern.Assign(FConvert.StringList);
end; {TFileFind.SetFilePattern}

{*********************************************************************}
{ procedure TFileFind.SetFilesFound                                   }
{*********************************************************************}
procedure TFileFind.SetFilesFound(AFilesFound: TStringList);
begin
  FFilesFound.Assign(AFilesFound);
end; {TFileFind.SetFilesFound}

{*********************************************************************}
{ function TFileFind.GetStartDir                                      }
{*********************************************************************}
function TFileFind.GetStartDir: String;
begin
  FConvert.StringList.Assign(FStartDir);
  FConvert.ReverseBreakApart;
  Result := FConvert.BaseString;
end; {TFileFind.GetStartDir}

{*********************************************************************}
{ procedure TFileFind.SetStartDir                                     }
{*********************************************************************}
procedure TFileFind.SetStartDir(AStartDir: String);
var
  i: Integer;
begin
  FConvert.BaseString := AStartDir;
  FConvert.BreakApart;
  FStartDir.Assign(FConvert.StringList);
  for i := 0 to FStartDir.Count - 1 do
    FStartDir[i] := CheckDir(FStartDir[i]);
end; {TFileFind.SetStartDir}

{*********************************************************************}
{ function TFileFind.CheckDir                                         }
{*********************************************************************}
function TFileFind.CheckDir(ADir: String): String;
var
  TempDir: String; { est-ce bien necessaire ??? }
begin
    TempDir := ADir;
    if ((TempDir <> '\') and
        (TempDir[Length(TempDir)] = '\') and
        (not ((Length(TempDir)=3) and (TempDir[2]=':') and (TempDir[3]='\')))
        ) then
      TempDir := Copy(TempDir, 1, Length(TempDir) - 1);
    Result := TempDir;
end; {TFileFind.CheckDir}

{*********************************************************************}
{ procedure TFileFind.FindThreadDone                                  }
{*********************************************************************}
procedure TFileFind.FindThreadDone(Sender: TObject);
begin
  if Assigned(FOnTerminated) then FOnTerminated(Self);
end; {TFileFind.FindThreadDone}

{*********************************************************************}
{ procedure TFileFind.Execute                                         }
{*********************************************************************}
procedure TFileFind.Execute;

  procedure SearchTree(AFilePattern: String);
  var
    SearchRec: TSearchRec;
    DosError: integer;
    dir: string;
  begin
    GetDir(0, dir);
    if dir[length(dir)] <> '\' then dir := dir + '\';
    DosError := FindFirst(AFilePattern, FFileTypeWord, SearchRec);
    while DosError = 0 do begin
      try
       if (FMatchEnabled = true) and (FMatchString <> '') then
        begin
         FMatch.source := dir + SearchRec.name;
         if FMatch.match then FFilesFound.add(dir + SearchRec.name);
        end
       else
        FFilesFound.add(dir + SearchRec.name);
      except
        on EOutOfResources do begin
          raise EFileFindOutOfResources.Create(MSG_TOO_MUCH_FILES);
          abort;
        end;
      end;
      DosError := FindNext(SearchRec);
    end;
    SysUtils.FindClose(SearchRec);

    {Now that we have all the files we need, lets go to a subdirectory.}
    if FRecursive = true then
     begin
      //DosError := FindFirst('*.*', FDirTypeWord, SearchRec);
      DosError := FindFirst('*.*', faDirectory, SearchRec);
      while DosError = 0 do begin
       {If there is one, go there and search.}
       if ((SearchRec.attr and faDirectory = faDirectory) and
        (SearchRec.name <> '.') and (SearchRec.name <> '..')) then begin

        ChDir(SearchRec.name);
        SearchTree(AFilePattern); {Time for the recursion!}
        ChDir('..'); {Down one level.}
      end;
      DosError := FindNext(SearchRec); {Look for another subdirectory}
     end;
     SysUtils.FindClose(SearchRec);

    end;
  end; {SearchTree}

var
  iDir, iFP: Integer;
begin
  FFilesFound.clear;
  FMatch.CaseSensitive := FMatchCaseSensitive;
  FMatch.Pattern := FMatchString;
  for iDir := 0 to FStartDir.Count - 1 do begin
    try
      ChDir(FStartDir[iDir]);
    except
      on E:Exception do raise EFileFindChDir.Create(E.Message);
    end;
    for iFP := 0 to FFilePattern.Count - 1 do begin
      SearchTree(FFilePattern[iFP]);
    end;
  end;
end; {TFileFind.Execute}

{*********************************************************************}
{ procedure TFileFind.ThreadExecute                                   }
{*********************************************************************}
procedure TFileFind.ThreadExecute;
begin
  with TFindThread.Create(FStartDir, FFilePattern, FFilesFound, FRecursive, FMatch, FMatchCaseSensitive, FMatchEnabled, FMatchString, FFileTypeWord, FdirTypeWord) do begin
    OnTerminate := FindThreadDone;
    Priority := FThreadPriority;
  end;
end; {TFileFind.ThreadExecute}


{*********************************************************************}
{ Objet TFindThread                                                   }
{*********************************************************************}

{*********************************************************************}
{ constructor TFindThread.Create                                      }
{*********************************************************************}
constructor TFindThread.Create(AStartDir: TStringList; AFilePattern: TStringList;
                               AFilesFound: TStringList; ARecursive: Boolean;AMatch: TMatch;
                               AMatchCaseSensitive: Boolean;AMatchEnabled: Boolean;
                               AMatchString: String;AFileTypeWord: Word;ADirTypeWord: Word);
begin
  inherited Create(False);
  FStartDir := AStartDir;
  FFilePattern := AFilePattern;
  FFilesFound := AFilesFound;
  FRecursive := ARecursive;
  FMatchCaseSensitive := AMatchCaseSensitive;
  FMatchEnabled := AMatchEnabled;
  FMatchString := AMatchString;
  FMatch := AMatch;
  FFileTypeWord := AFileTypeWord;
  FDirTypeWord := ADirTypeWord;
  FreeOnTerminate := True;
end; {TFindThread.Create}

{*********************************************************************}
{ procedure TFindThread.Execute                                       }
{*********************************************************************}
procedure TFindThread.Execute;
var
  iDir, iFP: Integer;
begin
  FFilesFound.clear;
  FMatch.CaseSensitive := FMatchCaseSensitive;
  FMatch.Pattern := FMatchString;
  for iDir := 0 to FStartDir.Count - 1 do begin
    try
      ChDir(FStartDir[iDir]);
    except
      on E:Exception do raise EFileFindChDir.Create(E.Message);
    end;
    for iFP := 0 to FFilePattern.Count - 1 do begin
      SearchTree(FFilePattern[iFP]);
    end;
  end;
end; {TFindThread.Execute}

{*********************************************************************}
{ procedure TFindThread.SearchTree                                    }
{*********************************************************************}
procedure TFindThread.SearchTree(AFilePattern: String);
var
  SearchRec: TSearchRec;
  DosError: integer;
  dir: string;
begin
  GetDir(0, dir);
  if dir[length(dir)] <> '\' then dir := dir + '\';
  DosError := FindFirst(AFilePattern, FFileTypeWord, SearchRec);
  while DosError = 0 do begin
    try
     if (FMatchEnabled = true) and (FMatchString <> '') then
      begin
       FMatch.source := dir + SearchRec.name;
       if FMatch.match then FFilesFound.add(dir + SearchRec.name);
      end
     else
      FFilesFound.add(dir + SearchRec.name);

    except
      on EOutOfResources do begin
        raise EFileFindOutOfResources.Create(MSG_TOO_MUCH_FILES);
        abort;
      end;
    end;
    if Terminated then Exit;
    DosError := FindNext(SearchRec);
  end;
  {Now that we have all the files we need, lets go to a subdirectory.}
  if FRecursive = true then
   begin
    //DosError := FindFirst('*.*', FDirTypeWord, SearchRec);
    DosError := FindFirst('*.*', faDirectory, SearchRec);
    while DosError = 0 do begin
    {If there is one, go there and search.}
     if ((SearchRec.attr and faDirectory = faDirectory) and
      (SearchRec.name <> '.') and (SearchRec.name <> '..')) then begin

      ChDir(SearchRec.name);
      SearchTree(AFilePattern); {Time for the recursion!}
      ChDir('..'); {Down one level.}
    end;
    DosError := FindNext(SearchRec); {Look for another subdirectory}
   end;
  end;
end; {TFindThread.SearchTree}

end.