Threads are not terminating in console application in delphi?

Question

Hello friends i have doubt writing multithreaded console application. When i write code for gui application it works perfectly. But same code does not work for console application.Why is it so?

program Project1;

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  Dialogs, StdCtrls,syncobjs,forms;
{$APPTYPE CONSOLE}

type
  TFileSearcher = class(TThread)
  private
    { Private declarations }
    FPath, FMask: string;
    FIncludeSubDir: boolean;
    Fcriticalsection: TCriticalSection;
    I : Int64;
    Size : int64;
    cnt : Longint;
    Procedure Add;
  public
    constructor Create(CreateSuspended: boolean; const Path, Mask: string; IncludeSubDir: boolean);
  protected
    procedure Execute; override;
  end;

type
 ScannerThread = class(TThread)   //main ScannerThread Declaration
Private
 ScannerChCount : Integer;                                               //Private variable to keep track of currently running threads
Protected
  Procedure ScanchildTerminated(Sender : TObject);                            //TNotifyEvent Procedure That Increment count on sub thread termination
  Procedure Execute(); Override;                                  //Excecute Procedure declaration
Public
End;

var
  Count,Tsize,FCount : Int64;

Procedure ListFolders(const DirName: string; FolderList : Tstringlist);
var
  Path: string;
  F: TSearchRec;
  SubDirName: string;

begin
  Path:= DirName + '\*.*';
  if FindFirst(Path, faAnyFile, F) = 0 then begin
    try
      repeat
        if (F.Attr and faDirectory <> 0) then begin
          if (F.Name <> '.') and (F.Name <> '..') then begin
            SubDirName:= IncludeTrailingPathDelimiter(DirName) + F.Name;
            FolderList.Add(SubdirName);
             ListFolders(SubDirName,FolderList);
          end;
        end;
      until FindNext(F) <> 0;
    finally
      FindClose(F);
    end;
  end;
end;

function GetDirSize(dir: string; subdir: Boolean): int64;
var
  rec: TSearchRec;
  found: Integer;
begin
  Result := 0;
  if dir[Length(dir)] <> '\' then dir := dir + '\';
  found := FindFirst(dir + '*.*', faAnyFile, rec);
  while found = 0 do
  begin
    Inc(Result, rec.Size);
    if (rec.Attr and faDirectory > 0) and (rec.Name[1] <> '.') and (subdir = True) then
      Inc(Result, GetDirSize(dir + rec.Name, True));
    found := FindNext(rec);
  end;
  FindClose(rec);
end;


procedure FindFiles(FilesList: TStringList;Subdir : Boolean; StartDir, FileMask: string);
var
  SR: TSearchRec;
  DirList,DirlistOnly: TStringList;
  IsFound: Boolean;
  i: integer;
begin
  If StartDir[length(StartDir)] <> '\' then
    StartDir := StartDir + '\';
  IsFound :=
    FindFirst(StartDir+FileMask, faAnyFile-faDirectory, SR) = 0;
  while IsFound do begin
   Begin
    FilesList.Add(StartDir + SR.Name);
    Count:= Count + Sr.Size;
   end;
    IsFound := FindNext(SR) = 0;
  end;
  FindClose(SR);

  // Build a list of subdirectories
  DirList := TStringList.Create;
  IsFound := FindFirst(StartDir+'*.*',
                        faAnyFile
                        , SR) = 0;
  while IsFound do begin
    if ((SR.Attr and faDirectory)<> 0) and
         (SR.Name <> '.') and   (subdir = true) and (sr.name <> '..') then
    Begin
      DirList.Add(StartDir + SR.Name);
    end;
    IsFound := FindNext(SR) = 0;
  end;
  FindClose(SR);

  // Scan the list of subdirectories
  for I := 0 to DirList.Count - 1 do
  Begin
    FindFiles(FilesList, SubDir,DirList[i], FileMask);
  end;
  DirList.Free;
end;

constructor TFileSearcher.Create(CreateSuspended: boolean; const Path, Mask: string;
  IncludeSubDir: boolean);
begin
  inherited Create(CreateSuspended);
  FPath := Path;
  FMask := Mask;
  FIncludeSubDir := IncludeSubDir;
  FreeOnTerminate:= true;
  //FcriticalSection:= Tcriticalsection.create;
end;

procedure TFileSearcher.Execute;
Var
 FilesList : TStringList;
begin
 Count:=0;
 FilesList:= TStringList.create;
 FindFiles(FilesList,false,fpath,fmask);
 cnt:= FilesList.count;
  I:= GetDirSize(fpath,false);
  Synchronize(Add);
end;

Procedure TFileSearcher.Add;
Begin
 size:=size + I ;
 Tsize:= Tsize + size;
 Fcount:= Fcount + cnt;
 //Form1.Memo2.Lines.add(inttostr(TSize));
 //Form1.Memo1.Lines.add(inttostr(Fcount));
End;

Procedure ScannerThread.Execute; // main ScannerCh Execute Procedure
Var
 Folderlist: Tstringlist;
 I: Integer;
 ScannerCh : array of TFileSearcher;
  Filelist : Tstringlist;
Begin
  ScannerChCount:=0;
  Tsize:=0;
  Fcount:=0;
  Folderlist:= TStringList.create;

  ListFolders('d:\tejas',Folderlist);
 //Memo2.lines.add(inttostr(Folderlist.count));
  SetLength(ScannerCh,Folderlist.count);
        I:=0;                                                            //initialising I
        Repeat
            ScannerCh[i]:=TFileSearcher.Create(true,Folderlist[i],'*.*',true);    //Creating New ScannerCh and assigning Ip to scan
            ScannerCh[I].FreeOnTerminate:=True;
            ScannerCh[I].OnTerminate:= ScanchildTerminated;     //Terminate ScannerCh after its work will finish
            ScannerCh[I].Resume;                            //ScannerCh Started
            //ScannerChCount:=ScannerChCount+1;
            InterlockedIncrement(ScannerChCount);
            I:=I+1;
            Sleep(5);                  //incrementing counter For next ScannerCh
        until I = Folderlist.Count;
        ScannerCh:=nil;

  Repeat                         //Main ScannerCh Waiting For Ip scan ScannerChs to finish
   Sleep(100);
  until ScannerChCount = 0;

  Count:=0;
  FileList:= TStringList.create;
  FindFiles(Filelist,false,'D:\tejas','*.*');
  Writeln(inttostr(fcount + Filelist.Count));
  Writeln(inttostr(GetDirSize('d:\tejas',False) + Tsize ));
  freeandnil(Filelist);
End;

Procedure ScannerThread.ScanchildTerminated(Sender: TObject);
Begin
  //ScannerChCount:=ScannerChCount-1;
  InterlockedDecrement(ScannerChCount); //Increment Count
End;

var
 Scanner : ScannerThread;
 Filelist : Tstringlist;
begin
  Scanner:=Scannerthread.Create(True);     //Creating thread
  Scanner.FreeOnTerminate:=True;
  Scanner.Resume;
  While GetTThreadsCount(GetCurrentProcessId) > 1 do
 begin
  Application.ProcessMessages;
  CheckSynchronize;
 end;

  Writeln;
  Readln;
end.

when i debugged my code I found threads which are getting created are not terminating.Why is it so?.. I kept freeonterminate as true.Can anyone tell me?

Answer 1

There are 2 problems with your code specific to console application:

1) direct call of Synchronize method; you should not call Synchronize in a console application (use other sync methods instead);

2) hidden call of Synchronize method in OnTerminate event; you should not use OnTerminate event in a console application (override DoTerminate method instead).

Answer 2

Always with free on terminate threads you need to ask yourself if the process ends before the threads do. Which would explain why they do not terminate.

However, in this case I think there is another explanation. Your use of Synchronize won't work in a console app unless you call CheckSynchronize. If you don't call CheckSynchronize from the main thread, and you don't, then your threads will block indefinitely when they call Synchronize. That call is needed to process the Synchronize queue. In a GUI app, the VCL framework takes are of calling CheckSynchronize for you. You are left to your own devices in a console app.

In any case the call to Synchronize is not needed. You can use InterlockedIncrement or AtomicIncrement which is faster than locking or invoking on a different thread. It will make your code much simpler too.

And even if you do need serialization, Synchronize is the wrong tool for the job. You use Synchronize primarily when you need code to execute on the main thread. Typically that's because it is GUI code. You have no GUI. If you need any serialization in your console app, use a lock. For instance a critical section. But don't call Synchronize.

---

To modify your code, remove the Add method and replace

Synchronize(Add);

with

inc(size, I);
InterlockedIncrement(Fcount, cnt);
InterlockedIncrement(Tsize, size);

Or if you want FCount and Tsize to be incremented atomically then you need a lock. Declare a global critical section and initialize it. Then wrap the increments of FCount and Tsize in that lock.

inc(size, I);
Lock.Acqure;
try
  inc(Fcount, cnt);
  inc(Tsize, size);
finally
  Lock.Release;
end;