{$MODE OBJFPC}
{$APPTYPE CONSOLE}
program Project1;
uses Classes;
type
TSimpleThread = class(TThread)
private
FWaitEvent: PRTLEvent;
FCounter: PLongInt;
protected
procedure Execute; override;
public
constructor Create(AWaitEvent: PRTLEvent; ACounter: PLongInt);
end;
constructor TSimpleThread.Create(AWaitEvent: PRTLEvent; ACounter: PLongInt);
begin
inherited Create(False);
FreeOnTerminate := True;
FWaitEvent := AWaitEvent;
FCounter := ACounter;
end;
procedure TSimpleThread.Execute;
begin
if Assigned(FCounter) then
InterLockedIncrement(FCounter^);
if Assigned(FWaitEvent) then
begin
RTLeventWaitFor(FWaitEvent);
RTLeventSetEvent(FWaitEvent);
end;
if Assigned(FCounter) then
InterLockedDecrement(FCounter^);
end;
const
CMaxThreads = 5000;
var
WaitEvent: PRTLEvent;
i: Integer;
Counter: LongInt = 0;
begin
WaitEvent := RTLEventCreate;
for i := 1 to CMaxThreads do
begin
TSimpleThread.Create(WaitEvent, @Counter);
Write('.');
end;
Writeln;
Writeln(CMaxThreads, ' threads added. Press Enter to close this threads');
Readln;
RTLEventSetEvent(WaitEvent);
while Counter > 0 do
Writeln(Counter, ' treads left');
Writeln('All added threads are closed. Press Enter to exit');
RTLEventDestroy(WaitEvent);
Readln;
end.