paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 23:21:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Implement idle timeout demo

Browse Source 
git-svn-id: trunk@33730 -
This commit is contained in:
michael 2016-05-21 09:44:39 +00:00
parent e39a964239
commit 6a07c59280
1 changed files with 11 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
packages/fcl-web/examples/httpserver/simplehttpserver.pas
View File

@ -7,7 +7,7 @@ uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
sysutils, Classes, fphttpserver, fpmimetypes;
sysutils, Classes, fphttpserver, fpmimetypes, wmecho;
Type
@ -21,13 +21,16 @@ Type
FMimeTypesFile: String;
procedure SetBaseDir(const AValue: String);
Protected
Procedure DoIdle(Sender : TObject);
procedure CheckMimeLoaded;
Property MimeLoaded : Boolean Read FMimeLoaded;
public
procedure HandleRequest(Var ARequest: TFPHTTPConnectionRequest;
Var AResponse : TFPHTTPConnectionResponse); override;
Property BaseDir : String Read FBaseDir Write SetBaseDir;
Property MimeTypesFile : String Read FMimeTypesFile Write FMimeTypesFile;
end;
Var
@ -42,6 +45,11 @@ begin
FBaseDir:=IncludeTrailingPathDelimiter(FBaseDir);
end;
procedure TTestHTTPServer.DoIdle(Sender: TObject);
begin
Writeln('Idle, waiting for connections');
end;
procedure TTestHTTPServer.CheckMimeLoaded;
begin
If (Not MimeLoaded) and (MimeTypesFile<>'') then
@ -98,6 +106,8 @@ begin
{$endif}
Serv.Threaded:=False;
Serv.Port:=8080;
Serv.AcceptIdleTimeout:=1000;
Serv.OnAcceptIdle:=@Serv.DoIdle;
Serv.Active:=True;
finally
Serv.Free;