paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 06:10:38 +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} {$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads, cthreads,
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
sysutils, Classes, fphttpserver, fpmimetypes; sysutils, Classes, fphttpserver, fpmimetypes, wmecho;
Type Type
@ -21,13 +21,16 @@ Type
FMimeTypesFile: String; FMimeTypesFile: String;
procedure SetBaseDir(const AValue: String); procedure SetBaseDir(const AValue: String);
Protected Protected
Procedure DoIdle(Sender : TObject);
procedure CheckMimeLoaded; procedure CheckMimeLoaded;
Property MimeLoaded : Boolean Read FMimeLoaded; Property MimeLoaded : Boolean Read FMimeLoaded;
public public
procedure HandleRequest(Var ARequest: TFPHTTPConnectionRequest; procedure HandleRequest(Var ARequest: TFPHTTPConnectionRequest;
Var AResponse : TFPHTTPConnectionResponse); override; Var AResponse : TFPHTTPConnectionResponse); override;
Property BaseDir : String Read FBaseDir Write SetBaseDir; Property BaseDir : String Read FBaseDir Write SetBaseDir;
Property MimeTypesFile : String Read FMimeTypesFile Write FMimeTypesFile; Property MimeTypesFile : String Read FMimeTypesFile Write FMimeTypesFile;
end; end;
Var Var
@ -42,6 +45,11 @@ begin
FBaseDir:=IncludeTrailingPathDelimiter(FBaseDir); FBaseDir:=IncludeTrailingPathDelimiter(FBaseDir);
end; end;
procedure TTestHTTPServer.DoIdle(Sender: TObject);
begin
Writeln('Idle, waiting for connections');
end;
procedure TTestHTTPServer.CheckMimeLoaded; procedure TTestHTTPServer.CheckMimeLoaded;
begin begin
If (Not MimeLoaded) and (MimeTypesFile<>'') then If (Not MimeLoaded) and (MimeTypesFile<>'') then
@ -98,6 +106,8 @@ begin
{$endif} {$endif}
Serv.Threaded:=False; Serv.Threaded:=False;
Serv.Port:=8080; Serv.Port:=8080;
Serv.AcceptIdleTimeout:=1000;
Serv.OnAcceptIdle:=@Serv.DoIdle;
Serv.Active:=True; Serv.Active:=True;
finally finally
Serv.Free; Serv.Free;