朋友您好我怀疑编写多线程控制台应用程序。当我为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.
当我调试我的代码时，我发现正在创建的线程没有终止。为什么会这样呢？..我保持freeonterminate为真。谁能告诉我？
答案 0 :(得分：4)
您的代码特定于控制台应用程序有两个问题：
1）直接调用Synchronize方法;你不应该在控制台应用程序中调用Synchronize（而是使用其他同步方法）;
2）在Synchronize事件中隐藏OnTerminate方法;您不应在控制台应用程序中使用OnTerminate事件（改为覆盖DoTerminate方法）。
答案 1 :(得分：3)
总是使用免费的终止线程，您需要问自己该进程是否在线程之前结束。这可以解释为什么他们不会终止。
然而，在这种情况下，我认为还有另一种解释。除非您致电Synchronize，否则您对CheckSynchronize的使用不会在控制台应用中发挥作用。如果您没有从主要主题中调用CheckSynchronize，并且您没有，那么当您致电Synchronize时，您的主题将无限期阻止。需要该调用来处理Synchronize队列。在GUI应用程序中，VCL框架需要为您调用CheckSynchronize。您可以在控制台应用中使用自己的设备。
无论如何，不需要调用Synchronize。您可以使用InterlockedIncrement或AtomicIncrement，这比在其他线程上锁定或调用更快。它也会使你的代码更简单。
即使您确实需要序列化，Synchronize也是错误的工具。当您需要在主线程上执行代码时，主要使用Synchronize。通常这是因为它是GUI代码。你没有GUI。如果您需要在控制台应用程序中进行任何序列化，请使用锁定。例如一个关键部分。但请勿拨打Synchronize。
要修改代码，请移除Add方法并替换
Synchronize(Add);
与
inc(size, I);
InterlockedIncrement(Fcount, cnt);
InterlockedIncrement(Tsize, size);
或者，如果您希望FCount和Tsize以原子方式递增，则需要锁定。声明一个全局关键部分并对其进行初始化。然后将FCount和Tsize的增量包装在该锁中。
inc(size, I);
Lock.Acqure;
try
inc(Fcount, cnt);
inc(Tsize, size);
finally
Lock.Release;
end;