unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, StdCtrls, fphttpserver;
type
TForm1 = class(TForm)
btnStart: TButton;
btnStop: TButton;
Memo1: TMemo;
procedure btnStartClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FThread: TThread;
procedure ThreadTerminated(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
type
THTTPServerThread = class(TThread)
strict private
FServer: TFPHTTPServer;
FRequest: TFPHTTPConnectionRequest;
procedure DoHandleRequest(Sender: TObject;
var ARequest: TFPHTTPConnectionRequest;
var AResponse: TFPHTTPConnectionResponse);
procedure ShowRequest;
protected
procedure Execute; override;
public
constructor Create(APort: Word);
destructor Destroy; override;
procedure StopServer;
end;
{ THTTPServerThread }
constructor THTTPServerThread.Create(APort: Word);
begin
inherited Create(True);
FServer := TFPHttpServer.Create(nil);
FServer.Port := APort;
FServer.OnRequest := @DoHandleRequest;
FreeOnTerminate := True;
end;
destructor THTTPServerThread.Destroy;
begin
FServer.Free;
inherited;
end;
procedure THTTPServerThread.DoHandleRequest(Sender: TObject;
var ARequest: TFPHTTPConnectionRequest;
var AResponse: TFPHTTPConnectionResponse);
begin
FRequest := ARequest;
Synchronize(@ShowRequest);
FRequest := nil;
end;
procedure THTTPServerThread.Execute;
begin
FServer.Active := True;
end;
procedure THTTPServerThread.ShowRequest;
begin
if Assigned(Form1) and Assigned(FRequest) then
Form1.Memo1.Append(FRequest.URI);
end;
procedure THTTPServerThread.StopServer;
begin
FServer.Active := False;
end;
{ TForm1 }
procedure TForm1.btnStartClick(Sender: TObject);
begin
if Assigned(FThread) then
Exit;
btnStart.Enabled := False;
FThread := THTTPServerThread.Create(7777);
FThread.OnTerminate := @ThreadTerminated;
Memo1.Append('Server thread started');
FThread.Start;
btnStop.Enabled := True;
end;
procedure TForm1.ThreadTerminated(Sender: TObject);
begin
FThread := nil;
Memo1.Append('Server thread stopped');
btnStart.Enabled := True;
btnStop.Enabled := False;
end;
procedure TForm1.btnStopClick(Sender: TObject);
begin
if Assigned(FThread) then
(FThread as THTTPServerThread).StopServer;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
btnStop.Enabled := False;
end;
end.