Please advise why you would think is working with the FPC3.1.1 version?
I tested it and it worked
I do see some problems with your code.
DoTerminate is never executed for the thread. You might think that _t.Terminate will call _t.DoTerminate at some point but it doesn't (I'm not sure why but thread-expert might be able to explan that one).
I did the following to you code to get it working:
- move Server variable in thread to public (we need to call it directly to stop the server)
- you could also create a terminate method for that (but I did it this way)
- set FreeOnTerminate to true
- move Server.Free; to destroy of the thread. Not in the execute. You create it in create() so free it in destroy.
http_listen looks like this:
unit http_listen;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fphttpapp, fphttpserver;
type
THTTPServerThread = class(TThread)
private
_Error: string;
public
Server: TFPHTTPServer;
constructor Create(APort: word; const OnRequest: THTTPServerRequestHandler);
destructor Destroy; override;
procedure Execute; override;
property Error: string read _Error;
end;
implementation
constructor THTTPServerThread.Create(APort: word; const OnRequest: THTTPServerRequestHandler);
begin
Server := TFPHTTPServer.Create(nil);
Server.Port := APort;
Server.OnRequest := OnRequest;
_Error := 'nil';
Self.FreeOnTerminate := true;
inherited Create(False);
end;
destructor THTTPServerThread.Destroy;
begin
Server.Free;
end;
procedure THTTPServerThread.Execute;
begin
try
Server.Active := True;
except
on E: Exception do
begin
_Error := E.Message;
end;
end;
end;
end.
And main.pas looks like this:
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, http_listen, fphttpserver;
type
TForm1 = class(TForm)
stop: TButton;
start: TButton;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure startClick(Sender: TObject);
procedure stopClick(Sender: TObject);
procedure onRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest;
var AResponse: TFPHTTPConnectionResponse);
end;
var
Form1: TForm1;
_t: THTTPServerThread;
implementation
{$R *.lfm}
procedure TForm1.startClick(Sender: TObject);
begin
start.Enabled := False;
_t := THTTPServerThread.Create(8001, @onRequest);
stop.Enabled := True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
stop.Enabled := False;
end;
procedure TForm1.stopClick(Sender: TObject);
begin
stop.Enabled := False;
// _t.Terminate;
_t.Server.Active := False; // <-- _t is automatically freed
start.Enabled := True;
end;
procedure TForm1.onRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest;
var AResponse: TFPHTTPConnectionResponse);
begin
Memo1.Append('HTTP request');
end;
end.
This worked fine for me (Lazarus 18RC2 FPC 3.1.1).