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).