通过在等待链部分中给出消息来阻止线程 "在线程xxxxx拥有的关键部分被阻止" 如果我在创建线程后休眠,它们运行正常。 不确定为什么他们被关键部分阻止 关键部分没有太多代码。任何人都可以帮助解决这个问题。
我的线程执行方法,它具有一个全局变量,该变量位于关键部分,如下所示
procedure TMyThread.Execute();
Var
Filename : String;
FIleDone : Boolean;
begin
inherited;
FIleDone := False;
while not FIleDone do //while there are still files
begin
try
EnterCriticalSection(CriticalSection); //Try to catch the critical section
//Access the shared variables
//Are there still files available
if FileList.Count = 0 then
begin
//Leave the critical section, when there are no files left
LeaveCriticalSection(CriticalSection);
//Leave the while loop
FIleDone := true;
self.Terminate;
break;
end
else
begin
//Read the filename
Filename := FileList.Strings[0];
//Delete the file from the list
FileList.Delete(0);
//Leave the critical section
LeaveCriticalSection(CriticalSection);
CopyTable(ChangeFileExt(filename,''),Form1.TargetDir.Text);
end;
except
LeaveCriticalSection(CriticalSection);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15 : TMythread;
TimeThen: TDateTime;
TimeNow: TDateTime;
Counter,id1,id2 : Integer;
begin
TimeThen := now;
FileList := TStringList.create();
if Length(TargetDir.Text) > 1 then
if TargetDir.Text[Length(TargetDir.Text)] <> '\' then
TargetDir.Text := TargetDir.Text + '\';
GetFileStringList(TargetDir.Text + '*.db', FileList);
ProgressBar.Max := FileList.Count;
t1 := TMyThread.create(false);
//sleep(1000);
t2 := TMyThread.create(false);
//sleep(1000);
t3 := TMyThread.create(false);
//sleep(1000);
t4 := TMyThread.create(false);
//sleep(1000);
t5 := TMyThread.create(false);
//sleep(1000);
t6 := TMyThread.create(false);
//sleep(1000);
t7 := TMyThread.create(false);
//sleep(1000);
t8 := TMyThread.create(false);
//sleep(1000);
t9 := TMyThread.create(false);
//sleep(1000);
t10 := TMyThread.create(false);
//sleep(1000);
t11 := TMyThread.create(false);
//sleep(1000);
t12 := TMyThread.create(false);
//sleep(1000);
t13 := TMyThread.create(false);
//sleep(1000);
t14 := TMyThread.create(false);
//sleep(1000);
//t15 := TMyThread.create(false);
// sleep(1000);
//mythread.Execute;
while Done < 14 do
begin
progressBar.Position := ProgressBar.Max - FileList.Count;
Application.ProcessMessages;
end;
// end;
//ProgressBar.Position := ProgressBar.Position + 1;
//end;
//ChangeCOCompanyLegalName();
TimeNow := Now;
if ((TimeNow - TimeThen) * 24 * 60 * 60) < 60 then
ShowMessage('done in ' + FormatFloat('###',((Now - TimeThen) * 24 * 60 * 60)) + ' seconds')
else
if ((TimeNow - TimeThen) * 24 * 60) < 60 then
ShowMessage('done in ' + FormatFloat('###.00',((Now - TimeThen) * 24 * 60)) + ' minutes')
else
ShowMessage('done in ' + FormatFloat('###.00',((Now - TimeThen) * 24)) + ' hours');
//FileList.Free;
end;
答案 0 :(得分:0)
您没有正确管理关键部分(甚至在更新进度条时甚至根本不使用它)。您的代码还存在其他问题,例如在Form1.TargetDir.Text
内使用TMyThread.Execute()
不是线程安全的,因此您需要摆脱它。
尝试更像这样的东西:
type
TMyThread = class(TThread)
private
FTargetDir: string;
...
protected
procedure Execute; override;
public
constructor Create(const ATargetDir: String); reintroduce;
end;
var
CriticalSection: TRTLCriticalSection;
FileList: TStringList;
constructor TMyThread.Create(const ATargetDir: String);
begin
inherited Create(False);
FTargetDir := ATargetDir;
end;
procedure TMyThread.Execute;
var
Filename : String;
begin
while not Terminated do
begin
EnterCriticalSection(CriticalSection);
try
if FileList.Count = 0 then Exit;
Filename := FileList.Strings[0];
FileList.Delete(0);
finally
LeaveCriticalSection(CriticalSection);
end;
if not Terminated then
CopyTable(ChangeFileExt(FileName, ''), FTargetDir);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
MaxThreads = 15;
var
Idx, NumThreads: Integer;
Threads: array[0..MaxThreads-1] of TMyThread;
Handles: array[0..MaxThreads-1] of THandle;
TimeStart, TimeElapsed, Ret: DWORD;
Dir: string;
begin
TimeStart := GetTickCount;
FileList := TStringList.Create;
try
Dir := TargetDir.Text;
if Dir <> '' then Dir := IncludeTrailingPathDelimiter(Dir);
GetFileStringList(Dir + '*.db', FileList);
ProgressBar.Max := FileList.Count;
if FileList.Count = 0 then Exit;
NumThreads := 0;
try
for Idx := 1 to MaxThreads do
begin
Threads[NumThreads] := TMyThread.Create(Dir);
Handles[NumThreads] := Threads[NumThreads].Handle;
Inc(NumThreads);
end;
Timer1.Enabled := True;
try
repeat
Ret := WaitForMultipleObjects(NumThreads, PWOHandleArray(@Handles), False, INFINITE);
if Ret := WAIT_FAILED then RaiseLastOSError;
if (Ret >= WAIT_OBJECT_0) and (Ret < (WAIT_OBJECT_0+NumThreads)) then
begin
Idx := Integer(Ret - WAIT_OBJECT_0);
Threads[Idx].Free;
if Idx < (NumThreads-1) then
begin
Move(Threads[Idx+1], Threads[idx], (NumThreads-(Idx+1)) * SizeOf(TMyThread));
Move(Handles[Idx+1], Handles[Idx], (NumThreads-(Idx+1)) * SizeOf(THandle));
end;
Dec(NumThreads);
end
else if Ret = (WAIT_OBJECT_0+NumThreads) then
begin
Application.ProcessMessages;
end;
until NumThreads = 0;
finally
Timer1.Enabled := False;
end;
finally
for Idx := 0 to NumThreads-1 do
begin
Threads[Idx].Terminate;
Threads[Idx].WaitFor;
Threads[Idx].Free;
end;
end;
finally
FileList.Free;
end;
TimeElapsed := GetTickCount - TimeStart;
if TimeElapsed < 1000 then
ShowMessage('done in ' + FormatFloat('###', TimeElapsed) + ' milliseconds')
else if TimeElapsed < (1000 * 60) then
ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60)) + ' seconds')
else if TimeElapsed < (1000 * 60 * 60) then
ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60 * 60)) + ' minutes')
else
ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60 * 60 * 24)) + ' hours');
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
Cnt: Integer;
begin
EnterCriticalSection(CriticalSection);
try
Cnt := FileList.Count;
finally
LeaveCriticalSection(CriticalSection);
end;
ProgressBar.Position := ProgressBar.Max - Cnt;
end;
或者,将UI代码更改为根本不使用等待循环:
type
TMyThread = class(TThread)
private
FTargetDir: string;
...
protected
procedure Execute; override;
public
constructor Create(const ATargetDir: String); reintroduce;
end;
var
CriticalSection: TRTLCriticalSection;
FileList: TStringList;
constructor TMyThread.Create(const ATargetDir: String);
begin
inherited Create(True);
FreeOnTerminate := True;
FTargetDir := ATargetDir;
end;
procedure TMyThread.Execute;
var
Filename : String;
begin
while not Terminated do
begin
EnterCriticalSection(CriticalSection);
try
if FileList.Count = 0 then Exit;
Filename := FileList.Strings[0];
FileList.Delete(0);
finally
LeaveCriticalSection(CriticalSection);
end;
if not Terminated then
CopyTable(ChangeFileExt(FileName, ''), FTargetDir);
end;
end;
const
MaxThreads = 15;
var
Threads: TList;
TimeStart: DWORD;
procedure TForm1.Button1Click(Sender: TObject);
var
Idx: Integer;
Thread: TMyThread;
Dir: string;
begin
if Threads <> nil then
begin
while Threads.Count > 0 do
begin
with TMyThread(Threads[0]) do
begin
OnTerminate := nil;
Terminate;
end;
Threads.Delete(0);
end;
end;
if FileList = nil then
FileList := TStringList.Create;
Dir := TargetDir.Text;
if Dir <> '' then Dir := IncludeTrailingPathDelimiter(Dir);
TimeStart := GetTickCount;
GetFileStringList(Dir + '*.db', FileList);
ProgressBar.Max := FileList.Count;
if FileList.Count = 0 then Exit;
if Threads = nil then
Threads := TList.Create;
for Idx := 1 to MaxThreads do
begin
Thread := TMyThread.Create(Dir);
Thread.OnTerminate := ThreadTerminated;
try
Threads.Add(Thread);
try
Thread.Resume;
except
Threads.Remove(Thread);
raise;
end;
except
Thread.Free;
raise;
end;
end;
Timer1.Enabled := True;
end;
procedure TForm1.ThreadTerminated(Sender: TObject);
var
TimeElapsed: DWORD;
begin
Threads.Remove(TMyThread(Sender));
if Threads.Count > 0 then Exit;
Timer1.Enabled := False;
FreeAndNil(Threads);
FreeAndNil(FileList);
TimeElapsed := GetTickCount - TimeStart;
if TimeElapsed < 1000 then
ShowMessage('done in ' + FormatFloat('###', TimeElapsed) + ' milliseconds')
else if TimeElapsed < (1000 * 60) then
ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60)) + ' seconds')
else if TimeElapsed < (1000 * 60 * 60) then
ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60 * 60)) + ' minutes')
else
ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60 * 60 * 24)) + ' hours');
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
Cnt: Integer;
begin
EnterCriticalSection(CriticalSection);
try
Cnt := FileList.Count;
finally
LeaveCriticalSection(CriticalSection);
end;
ProgressBar.Position := ProgressBar.Max - Cnt;
end;