線程不在delphi的控制檯應用程序中終止？

Question

你好朋友，我懷疑編寫多線程控制檯應用程序。當我爲gui應用程序編寫代碼時，它完美地工作。但相同的代碼不適用於控制檯應用程序。爲什麼？

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. 

當我調試我的代碼，我發現這是越來越創建的線程不terminating.Why會這樣？我一直freeonterminate作爲true.Can誰能告訴我？

Answer 1

有2個問題，你的代碼具體到控制檯應用程序：

1）Synchronize方法的直接調用;您不應該在控制檯應用程序中調用Synchronize（請改用其他同步方法）;

2）隱含調用Synchronize方法OnTerminate事件;您不應在控制檯應用程序中使用OnTerminate事件（改爲覆蓋DoTerminate方法）。

Answer 2

總是在釋放終止線程時，您需要問問自己在線程執行之前該進程是否結束。這將解釋爲什麼他們不終止。

但是，在這種情況下，我認爲還有另一種解釋。除非您致電CheckSynchronize，否則Synchronize的使用將無法在控制檯應用中使用。如果你不從主線程調用CheckSynchronize，而你不這樣做，那麼當你的線程調用Synchronize時，線程將無限期地阻塞。該調用需要處理Synchronize隊列。在GUI應用程序中，VCL框架需要爲您調用CheckSynchronize。您在控制檯應用程序中留給自己的設備。

在任何情況下，不需要致電Synchronize。您可以使用InterlockedIncrement或AtomicIncrement，這比在另一個線程上鎖定或調用要快。它會使你的代碼更簡單。

即使您確實需要序列化，Synchronize也是這項工作的錯誤工具。當您需要在主線程上執行代碼時，主要使用Synchronize。通常這是因爲它是GUI代碼。你沒有GUI。如果您在控制檯應用程序中需要任何序列化，請使用鎖定。例如關鍵部分。但不要撥打Synchronize。

---

修改代碼，去掉Add方法及

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

更換

Synchronize(Add); 

或者，如果你想FCount和Tsize將要增加原子，那麼你需要的鎖。聲明一個全局臨界區並初始化它。然後在該鎖中包含FCount和Tsize的增量。

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