pavelmash/httpThreadAV.lpr

## httpThreadAV.lpr
program httpThreadAV;

{$I Synopse.inc}

uses
  Windows,
  Classes,
  SynCommons,
  SynCrtSock,
  SynLog;

const
  ROOT = '/';
  PORT = '8881';
  DOMAIN_NAME = '+';
  CLONES = 4;
  // duration of real work inside HTTPThreadTerminate event
  REAL_WORK_DURATION = 100;

type
  TAvTest = class
  private
    fHttpServer: THttpApiServer;
  protected
    procedure HttpThreadStart(Sender: TThread);
    procedure HttpThreadTerminate(Sender: TThread);
    function DoOnRequest(Ctxt: THttpServerRequest): cardinal;
  public
    constructor Create();
    destructor Destroy; override;
  end;

var
  tst: TAvTest;
  terminatedCount: integer;

procedure TAvTest.HttpThreadStart(Sender: TThread);
begin
  TSynLog.Add.Log(sllDebug, 'HttpThreadStart %', [Sender.threadID]);
end;

procedure TAvTest.HttpThreadTerminate(Sender: TThread);
begin
  TSynLog.Add.Log(sllDebug, 'HttpThreadTerminate % - begin', [Sender.threadID]);
  sleep(REAL_WORK_DURATION); // real work
  interlockedIncrement(terminatedCount);
  TSynLog.Add.Log(sllDebug, 'HttpThreadTerminate % - end', [Sender.threadID]);
end;

function TAvTest.DoOnRequest(Ctxt: THttpServerRequest): cardinal;
begin
  Ctxt.OutContent := '<html><body><h1>It''s works!</h1></body></html>';
  Ctxt.OutContentType := 'text/html';
  Result := 200;
end;

constructor TAvTest.Create();
begin
  fHttpServer := THttpApiServer.Create(True, '', HttpThreadStart, HttpThreadTerminate);
  if fHTTPServer.AddUrl(ROOT, PORT, false, DOMAIN_NAME) <> NO_ERROR then
    raise ESynException.CreateLastOSError('impossible to listen on %s (%s)', [PORT, DOMAIN_NAME]);
  fHttpServer.Suspended := False;
  fHttpServer.OnRequest := DoOnRequest;
  fHttpServer.OnHttpThreadStart := HttpThreadStart;
  fHttpServer.OnHttpThreadTerminate := HttpThreadTerminate;
  fHttpServer.Clone(CLONES-1);
end;

destructor TAvTest.Destroy;
begin
  fHttpServer.Free;
  inherited Destroy;
end;

begin
  TSynLog.Family.Level := SynLog.LOG_VERBOSE;
  TSynLog.Add.Log(sllDebug, 'Start app', []);
  tst := TAvTest.Create();
  HttpGet('http://localhost:' + PORT + ROOT, nil, true);
  TSynLog.Add.Log(sllDebug, 'Start free server', []);
  terminatedCount := 0;
  tst.Free;
  TSynLog.Add.Log(sllDebug, 'End free server', []);
  if terminatedCount <> CLONES then begin
    writeln('ERROR! Server destroyed before all threads done. Teminated/expected ', terminatedCount, '/', CLONES);
    writeln(' - in log files you can not see HttpThreadTerminate % - end lines for some of threads');
    writeln(' - in case REAL_WORK_DURATION constart is 0 everything is OK');
    writeln(' The reason is THttpApiServer.DestroyMainThread calls fClones[].free before all clones finish');
    ExitCode := 1;
  end;
  tst := nil;
  TSynLog.Add.Log(sllDebug, 'End app', []);
end.
	program httpThreadAV;

	{$I Synopse.inc}

	uses
	Windows,
	Classes,
	SynCommons,
	SynCrtSock,
	SynLog;

	const
	ROOT = '/';
	PORT = '8881';
	DOMAIN_NAME = '+';
	CLONES = 4;
	// duration of real work inside HTTPThreadTerminate event
	REAL_WORK_DURATION = 100;

	type
	TAvTest = class
	private
	fHttpServer: THttpApiServer;
	protected
	procedure HttpThreadStart(Sender: TThread);
	procedure HttpThreadTerminate(Sender: TThread);
	function DoOnRequest(Ctxt: THttpServerRequest): cardinal;
	public
	constructor Create();
	destructor Destroy; override;
	end;

	var
	tst: TAvTest;
	terminatedCount: integer;

	procedure TAvTest.HttpThreadStart(Sender: TThread);
	begin
	TSynLog.Add.Log(sllDebug, 'HttpThreadStart %', [Sender.threadID]);
	end;

	procedure TAvTest.HttpThreadTerminate(Sender: TThread);
	begin
	TSynLog.Add.Log(sllDebug, 'HttpThreadTerminate % - begin', [Sender.threadID]);
	sleep(REAL_WORK_DURATION); // real work
	interlockedIncrement(terminatedCount);
	TSynLog.Add.Log(sllDebug, 'HttpThreadTerminate % - end', [Sender.threadID]);
	end;

	function TAvTest.DoOnRequest(Ctxt: THttpServerRequest): cardinal;
	begin
	Ctxt.OutContent := '<html><body><h1>It''s works!</h1></body></html>';
	Ctxt.OutContentType := 'text/html';
	Result := 200;
	end;

	constructor TAvTest.Create();
	begin
	fHttpServer := THttpApiServer.Create(True, '', HttpThreadStart, HttpThreadTerminate);
	if fHTTPServer.AddUrl(ROOT, PORT, false, DOMAIN_NAME) <> NO_ERROR then
	raise ESynException.CreateLastOSError('impossible to listen on %s (%s)', [PORT, DOMAIN_NAME]);
	fHttpServer.Suspended := False;
	fHttpServer.OnRequest := DoOnRequest;
	fHttpServer.OnHttpThreadStart := HttpThreadStart;
	fHttpServer.OnHttpThreadTerminate := HttpThreadTerminate;
	fHttpServer.Clone(CLONES-1);
	end;

	destructor TAvTest.Destroy;
	begin
	fHttpServer.Free;
	inherited Destroy;
	end;

	begin
	TSynLog.Family.Level := SynLog.LOG_VERBOSE;
	TSynLog.Add.Log(sllDebug, 'Start app', []);
	tst := TAvTest.Create();
	HttpGet('http://localhost:' + PORT + ROOT, nil, true);
	TSynLog.Add.Log(sllDebug, 'Start free server', []);
	terminatedCount := 0;
	tst.Free;
	TSynLog.Add.Log(sllDebug, 'End free server', []);
	if terminatedCount <> CLONES then begin
	writeln('ERROR! Server destroyed before all threads done. Teminated/expected ', terminatedCount, '/', CLONES);
	writeln(' - in log files you can not see HttpThreadTerminate % - end lines for some of threads');
	writeln(' - in case REAL_WORK_DURATION constart is 0 everything is OK');
	writeln(' The reason is THttpApiServer.DestroyMainThread calls fClones[].free before all clones finish');
	ExitCode := 1;
	end;
	tst := nil;
	TSynLog.Add.Log(sllDebug, 'End app', []);
	end.