Link to home
Start Free TrialLog in
Avatar of mieow
mieow

asked on

How do I prevent to get stuck in an infinity loop.

I use a VCL that searches for files in a given folder + subfolders, TmFileScan by Mats Asplund, http://hem.passagen.se/matasp
The searchroutine creates and runs in it's own thread.
There's an event when the search is finished.

In my program, I want to launch the search, wait until it's finished and then continue. All in same procedure.

Code example:
begin

  do something here

  FileScan.start;  // Starts the searching

  // program should wait here until the searching is done

  continue to do something with the result.

end;

I could use a global boolean and set it to true in the event for when the search are finished and use it in a repeat - until.
But if something goes wrong with the search and never get done, the program will wait forever. (I guess)

What is the smartest way to prevent this to happen?

Avatar of Jacco
Jacco
Flag of Netherlands image

If you have access to the thread created you could issue a WaitFor in the main thread.

Regards Jacco
Avatar of shaneholmes
shaneholmes


It has its own thread, and you dont have control of that code....

how about using something you have control of

Shane


procedure FillFileList(Folder, Mask: String;  sl: TStrings);
var Rec : TSearchRec;
    FileName : String;
begin
 sl.Clear;
 if SysUtils.FindFirst(Folder + Mask, faAnyFile, Rec) = 0 then
  try
    repeat
      sl.Add(Folder + Rec.Name);
    until SysUtils.FindNext(Rec) <> 0;
  finally
    SysUtils.FindClose(Rec);
  end;
end;

procedure TForm1.FormActivate(Sender: TObject);
var
 FileList: TSTringList;
begin
  FileList:= TSTringList.Create;
  FillFileList('C:\', *.*, FIleList);
 //now the program will not continue on until the list is gererated
 ShowMessage(inttostr(FileList.Count));
  FileList.Create;
end;
Avatar of mieow

ASKER

shane:  problem with your solution is that it only search in one folder.  The structure can be deep with subfolders in subfolders and so on. Like searching and listing all files and folders in the Windows dir. :)

Jacco : I do have access to the source. Where /  how do I use WaitFor?

This is what I suppose the code that creates the thread:

constructor TSearchThread.Create(Owner: TmFileScan; SubDir, Started: Boolean;
  FilePaths, Filter: TStrings; fOnFileFound: TOnFileFoundEvent;
  fOnReady: TOnReadyEvent);
begin
  inherited Create(true);
  ffOwner:= Owner;
  ffPaths:= TStringList.Create;
  ffFilters:= TStringList.Create;
  ffSubDir:= SubDir;
  ffPaths.Text:= FilePaths.Text;
  ffFilters.Text:= Filter.Text;
  ffOnFileFound:= fOnFileFound;
  ffOnReady:= fOnReady;
  ffAbort:= false;
  FreeOnTerminate:= true;
  Resume;
end;
Ok, well if his solution dont work out, let me know, the code can be changed to a recursive function which can include subdirectories

Shane
Here is how you normally use it:

Code example:
begin

  do something here

  FileScan.start;  // Starts the searching

  // program should wait here until the searching is done
  FileScan.Thread.WaitFor; // <<<<

  continue to do something with the result.

end;

Regards Jacco
Avatar of mieow

ASKER

Jacco, you need to be more precisely.
I can't just add the the line FileScan.Thread.WaitFor;
I need more help here.
Try this one.......

Dont want any points..


Unit TreeScan;

{
Description:

Component to help with traversing folder structures
Will notify the owner when file or folder is found.

Note that files are scanned before sub-folders, and that
both file and folder scans are in alphabetical order

Revision history:

V1.0.0  1996 Dec 15  First version
V1.0.2  1997 Jan 12  Add file mask (e.g. *.exe)
V1.0.4  1997 Mar 28  Add event when leaving folder
                     Add BeginUpdate/EndUpdate around list updates
V1.0.6  1997 Apr 26  Add report of found object size (for files)
                     Add Recursive flag - normally True
                     (suggestions of Sean Mathews)
V1.1.0  1997 May 12  Version for Delphi 3.0
V1.2.0  1997 Sep 14  Version for Delphi 3.01
                     Add "hidden" properties - these will make the routine find
                     Hidden files or folders in addition to the normal ones
                     (suggestion from Paolo Faccini)
V1.2.2  1997 Oct 22  Add OnSearchDone event (suggestions of Ed Butler)
                     Allow for coding error in Borland's RTL in FindClose
V1.3.0  1998 Mar 15  Version for Delphi 3.02
                     Add CommaText for input file spec, allows multiple searches
                     The simple FileMask property overrides FileMaskCommaText
}

Interface

Uses
  SysUtils, Classes, Forms; // seems to be the minimum we need

Type
  TTreeScanner = Class( TComponent )
  Private
    { Private declarations }
    FOnFileFound: TNotifyEvent; // where to notify for file found
    FOnDirectoryFound: TNotifyEvent; // where to notify for start of folder
    FOnDirectoryDone: TNotifyEvent; // where to notify for end of folder
    FOnSearchDone: TNotifyEvent; // where to notify for end of search
    FFoundObject: String; // full file or folder name
    FFoundObjectSize: integer; // size of file found
    FInitialDirectory: String; // starting point in the tree
    FFileMask: String; // files to search for e.g. *.EXE
    FFileMaskList: TStringList; // files to search for e.g. *.EXE, *.DLL
    FSearchInProgress: boolean; // true whilst searching
    FRecursive: boolean;
    FFindHiddenFiles: boolean;
    FFindHiddenFolders: boolean;
  Protected
    { Protected declarations }
    Procedure scan_directory( Const dir: String );
    Function GetFileMask: String;
    Procedure SetFileMask( s: String );
    Function GetFileMaskCommaText: String;
    Procedure SetFileMaskCommaText( s: String );
  Public
    { Public declarations }
    Continue: Boolean; // caller sets the false to interrupt
    Constructor Create( AOwner: TComponent ); Override;
    Destructor Destroy; Override;
    Procedure ScanTree; // call here to scan tree
  Published
    { Published declarations }
    Property OnDirectoryFound: TNotifyEvent Read FOnDirectoryFound Write FOnDirectoryFound;
    Property OnDirectoryDone: TNotifyEvent Read FOnDirectoryDone Write FOnDirectoryDone;
    Property OnSearchDone: TNotifyEvent Read FOnSearchDone Write FOnSearchDone;
    Property OnFileFound: TNotifyEvent Read FOnFileFound Write FOnFileFound;
    Property FileFound: String Read FFoundObject;
    Property FileSize: integer Read FFoundObjectSize;
    Property SearchInProgress: boolean Read FSearchInProgress;
    Property InitialDirectory: String Read FInitialDirectory Write FInitialDirectory;
    Property FileMask: String Read GetFileMask Write SetFileMask;
    Property FileMaskCommaText: String Read GetFileMaskCommaText Write SetFileMaskCommaText;
    Property Recursive: boolean Read FRecursive Write FRecursive Default True;
    Property FindHiddenFiles: boolean Read FFindHiddenFiles Write FFindHiddenFiles Default False;
    Property FindHiddenFolders: boolean Read FFindHiddenFolders Write FFindHiddenFolders Default False;
  End;

Procedure Register;


Implementation

Uses
  Windows, Dialogs;

Procedure Register;
Begin
  RegisterComponents( 'Standard', [ TTreeScanner ] );
End;

Constructor TTreeScanner.Create( AOwner: TComponent );
Begin
  Inherited Create( AOwner );
  FOnDirectoryFound := Nil; // no callback pointer yet for folder start
  FOnDirectoryDone := Nil; // or for folder complete
  FOnSearchDone := Nil; // or for search complete
  FOnFileFound := Nil; // or for found file
  FSearchInProgress := False; // and we're not yet searching
  FRecursive := True; // normally, scan sub-folders as well
  FFindHiddenFiles := False; // normally, don't show hidden files
  FFindHiddenFolders := False; // normally, don't show hidden folders
  FFileMask := '';
  FFileMaskList := TStringList.Create;
  With FFileMaskList Do
    Begin
      Sorted := True;
      Duplicates := dupIgnore;
    End;
End;

Destructor TTreeScanner.Destroy;
Begin
  FFileMaskList.Free;
  Inherited;
End;

Procedure TTreeScanner.SetFileMask( s: String );
Begin
  If FSearchInProgress Then Exit;
  FFileMaskList.Clear;
  FFileMaskList.Add( s );
End;

Function TTreeScanner.GetFileMask: String;
Begin
  Result := '';
  If FFileMaskList.Count > 0 Then Result := FFileMaskList.Strings[ 0 ];
End;

Procedure TTreeScanner.SetFileMaskCommaText( s: String );
Begin
  If FSearchInProgress Then Exit;
  FFileMaskList.Clear;
  FFileMaskList.CommaText := s;
End;

Function TTreeScanner.GetFileMaskCommaText: String;
Begin
  Result := FFileMaskList.CommaText;
End;

Procedure TTreeScanner.ScanTree;
Begin
  FSearchInProgress := True; // now searching
  FFoundObject := ''; // nothing found as yet
  FFoundObjectSize := 0;

  // Try to get a valid folder string.  If the user hasn't
  // specified a folder, use the current directory...
  If FInitialDirectory = '' Then FInitialDirectory := GetCurrentDir;

  // ensure the folder ends in a '\'
  If FInitialDirectory[ Length( FInitialDirectory ) ] <> '\' Then
    FInitialDirectory := FInitialDirectory + '\';

  // now remove any file specification components...
  FInitialDirectory := ExtractFileDir( FInitialDirectory );
  // and again ensure that trailing backslash is present....
  If FInitialDirectory[ Length( FInitialDirectory ) ] <> '\' Then
    FInitialDirectory := FInitialDirectory + '\';
  // assume we wish to continue (at least to start with!)
  Continue := True;
  // and call the recursive scanning procedure
  scan_directory( FInitialDirectory );
  FSearchInProgress := False; // note we have finished searching
  If Assigned( FOnSearchDone ) // finished search
  Then FOnSearchDone( self );
End;

Procedure TTreeScanner.scan_directory( Const dir: String );
Var
  f            : TSearchRec; // used for scanning a folder
  status       : integer; // value returned from FindFirst/FindNext
  file_list    : TStringList; // sorted list of files in the folder
  dir_list     : TStringList; // sorted list of sub-folders
  i            : integer; // used to traverse the above lists
  attributes   : integer; // what sort of things to find
Begin
  Application.ProcessMessages; // allow the caller to do some work
  If Not Continue Then Exit; // interrupted? - simply return to caller

  // a folder doesn't actually have zero size - it's a file after all
  // but the size isn't reported by FindFirst so say it's zero.
  FFoundObjectSize := 0; // "a folder has zero size"
  FFoundObject := dir; // prepare to tell owner that we've
  If Assigned( FOnDirectoryFound ) // found a new folder
  Then FOnDirectoryFound( self );

  // Create the string lists which are used to store the names returned from
  // the folder scan.  By making the list sorted, the names returned to the
  // caller will be in alphabetic order.  Note one slight "trick"; the most
  // wanted characteristic of a file is its size.  We therefore store the
  // size in the string list by using its associated "objects" list.  In
  // reality, these are 32-bit pointers to objects.  So rather than storing
  // pointers, we can store and recover 32-bit integers by type-casting.
  // In Win32, a file size is actually a 64-bit field, although Borland only
  // store the low 32-bits.  Once file sizes exceed 2GB this code will break.

  file_list := TStringList.Create; // prepare list of files
  file_list.Sorted := True; // and note is is to be in sorted order
  dir_list := TStringList.Create; // prepare list of folders
  dir_list.Sorted := True; // also sorted

  // There's a fault in Borland's Run-Time Library under Windows NT where the
  // system function FindClose can get called with an invalid file handle if
  // the inital result is not zero, i.e. no files were found.
  // The try..finally blocks below was found on the DDJ to fix this problem

  dir_list.BeginUpdate; // probably not worth doing this, but...
  attributes := faDirectory;
  If FFindHiddenFolders Then attributes := attributes Or faHidden;
  // initialise the handle just in case of an exception
  f.FindHandle := INVALID_HANDLE_VALUE;
  Try
    status := FindFirst( dir + '*.*', attributes, f ); // try the first find call
    If status <> 0
      Then f.FindHandle := INVALID_HANDLE_VALUE
    Else
      While status = 0 Do With f Do // keep looping while more entries
          Begin
            If ( ( faDirectory And Attr ) <> 0 ) And // is this a folder?
            ( Name <> '.' ) And ( Name <> '..' ) // ignore backlinks
            Then dir_list.Add( dir + Name + '\' ); // add it to folder list
            status := FindNext( f ); // see if there's another folder entry
          End;
  Finally
    SysUtils.FindClose( f ); // all done, clean up from folder scan
  End;
  dir_list.EndUpdate;

  file_list.BeginUpdate;

  For i := 0 To FFileMaskList.Count - 1 Do
    Begin
      // initialise the handle just in case of an exception
      f.FindHandle := INVALID_HANDLE_VALUE;
      Try
        status := FindFirst( dir + FFileMaskList.Strings[ i ], faAnyFile, f ); // try the first find call
        If status <> 0
          Then f.FindHandle := INVALID_HANDLE_VALUE
        Else
          While status = 0 Do With f Do // keep looping while more entries
              Begin
                If ( ( faDirectory And Attr ) = 0 ) And // is this not a folder?
                ( ( faVolumeID And Attr ) = 0 ) Then // is this not a volume ID?
                  Begin
                    // don't add hidden files if we're not asked for them
                    If ( ( Attr And faHidden ) = faHidden ) And ( Not FFindHiddenFiles )
                      Then
                    Else file_list.AddObject( dir + Name, Pointer( Size ) ); // add to file list
                  End;
                status := FindNext( f ); // see if there's another entry
              End;
      Finally
        SysUtils.FindClose( f ); // all done, clean up from the scan
      End;
    End;

  file_list.EndUpdate;

  // scan the sorted list of files and call back the owner for each
  For i := 0 To file_list.Count - 1 Do
    Begin
      FFoundObject := file_list.Strings[ i ];
      // type cast the stored pointer into a 32-bit integer
      FFoundObjectSize := Integer( file_list.Objects[ i ] );
      If Assigned( FOnFileFound ) Then FOnFileFound( self );
    End;
  file_list.Free; // return memory owned by the list

  FFoundObjectSize := 0; // just to keep things clean.....
  // scan the sorted list of folders and scan each sub-folder
  For i := 0 To dir_list.Count - 1 Do
    If FRecursive
      Then
      scan_directory( dir_list.Strings[ i ] )
    Else
      Begin
        FFoundObject := dir_list.Strings[ i ];
        If Assigned( FOnDirectoryFound ) Then FOnDirectoryFound( self );
      End;

  dir_list.Free; // return memory owned by the list

  If Assigned( FOnDirectoryDone ) // finished this folder
  Then FOnDirectoryDone( self );
End;

End.
ASKER CERTIFIED SOLUTION
Avatar of Jacco
Jacco
Flag of Netherlands image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of mieow

ASKER

Jacco, your timeout works as it should. but when I use that code, FileScan returns only one file found, the first in the list.
It's like it get stucked in While-loop and doesn't process it's own evernts.
All files it finds should be stored in the stringlist SearchResult. When I run a test, it finds 186 files without your code and only one file when I use that timeout.
This is because the component uses Synchronize to report found files. (Synchronize puts a message on the message que of the main thread which will not be processed unless ProcessMessages is called).

Replace the Sleep(100) by

  Sleep(10);
  Application.ProcessMessages;

And it will work.

Make sure the "Start" button is disabled because ProcessMessages cause a new ButtonClick to be processed as well.

Regards Jacco
Avatar of mieow

ASKER

That works perfect.
Thanks to everyone who replied. You guys are the best, but I guess you already know that. :)

One more question: How important is the Sleep-statement? The code works without it, but is it unsafe not to use it?
The sleep is to make the main thread "sleep" so it frees up processor time for the scan-thread. A while-loop in the main thread without a sleep uses far more processor power and thus the scan-thread will take longen.

Regards Jacco