FServer.Active := False - not working
lazarus / 38-Networking and Web Programming

----------------------------------------------------------------------
dogriz · 2021-10-08 19:49

Here's a very basic WebServerThread example (in GUI app):
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
unitMain; {$mode objfpc}{$H+} interface uses  Classes, SysUtils,
Forms, Controls, Graphics, Dialogs, StdCtrls, fphttpserver; type  {
TWebServerThread }  TWebServerThread = class(TThread)  private   
FServer: TFPHTTPServer;    msg: String;    procedure LogMessage; 
public    constructor Create(APort: String);    destructor Destroy;
override;    procedure Execute; override;    procedure DoTerminate;
override;    procedure DoHandleRequest(Sender: TObject; var ARequest:
TFPHTTPConnectionRequest; var AResponse: TFPHTTPConnectionResponse); 
 property Server: TFPHTTPServer Read FServer;  end; type   { TForm1
}   TForm1 = class(TForm)    CheckBox1: TCheckBox;    MemoLog: TMemo; 
  procedure CheckBox1Click(Sender: TObject);  private   
FServerThread: TWebServerThread;  public   end; var  Form1:
TForm1; implementation {$R *.lfm} { TForm1 } procedure
TForm1.CheckBox1Click(Sender: TObject);begin  if
not(Assigned(FServerThread)) then    FServerThread :=
TWebServerThread.Create('8080')  else   
FServerThread.Terminate;end; { TWebServerThread } procedure
TWebServerThread.LogMessage;begin 
Form1.MemoLog.Append(msg);end; constructor
TWebServerThread.Create(APort: String);begin  inherited
Create(False);  FServer := TFPHTTPServer.Create(nil);  FServer.Port :=
StrToInt(APort);  FServer.OnRequest := @DoHandleRequest; 
Self.FreeOnTerminate := True;end; destructor
TWebServerThread.Destroy;begin  FServer.Free;  inherited
Destroy;end; procedure TWebServerThread.Execute;begin  FServer.Active
:= True;end; procedure TWebServerThread.DoTerminate;begin 
FServer.Active := False; // <== this is not working...  inherited
DoTerminate;end; procedure TWebServerThread.DoHandleRequest(Sender:
TObject; var ARequest: TFPHTTPConnectionRequest; var AResponse:
TFPHTTPConnectionResponse);var  s: String;begin  s :=
ARequest.Content;  AResponse.Content := 'OK';  AResponse.Code := 200; 
AResponse.ContentType := 'text/plain';  AResponse.ContentLength :=
Length(AResponse.Content);  AResponse.SendContent;  msg := s; 
Synchronize(@LogMessage);end; end. 
For some reason, FServer.Active := False (procedure
TWebServerThread.DoTerminate) does not work and FServer can't be
deactivated. Has anyone idea, why?
Btw, tested on Linux (compiled with -dUseCThreads).

----------------------------------------------------------------------
Leledumbo · 2021-10-14 05:56

Your thread is already terminated as soon as Execute reaches the end
of the method. Add a blocking code such as:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i while not
Terminated do Sleep(1); before the method's end.

----------------------------------------------------------------------
dogriz · 2021-10-14 06:23

Hm, but the thing is that Execute method never ends...
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
TWebServerThread.Execute;begin  FServer.Active := True;  WriteLn('This
line never executes');end; And, also, looking at the number of app
threads in Linux OS, webServer thread is definately not terminated.