Skip to content

Commit 846bff7

Browse files
author
Grahame Grieve
committed
Add http server
1 parent c6604ca commit 846bff7

9 files changed

Lines changed: 4410 additions & 0 deletions

library/http/http_router.pas

Lines changed: 646 additions & 0 deletions
Large diffs are not rendered by default.

library/http/http_server.pas

Lines changed: 1041 additions & 0 deletions
Large diffs are not rendered by default.

library/http/http_server_demo

4.42 MB
Binary file not shown.

library/http/http_server_demo.lpi

Lines changed: 62 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,62 @@
1+
<?xml version="1.0" encoding="UTF-8"?>
2+
<CONFIG>
3+
<ProjectOptions>
4+
<Version Value="12"/>
5+
<General>
6+
<Flags>
7+
<MainUnitHasCreateFormStatements Value="False"/>
8+
<MainUnitHasTitleStatement Value="False"/>
9+
<MainUnitHasScaledStatement Value="False"/>
10+
</Flags>
11+
<SessionStorage Value="InProjectDir"/>
12+
<Title Value="Demonstration HTTP Server"/>
13+
<UseAppBundle Value="False"/>
14+
<ResourceType Value="res"/>
15+
</General>
16+
<BuildModes>
17+
<Item Name="Default" Default="True"/>
18+
</BuildModes>
19+
<PublishOptions>
20+
<Version Value="2"/>
21+
<UseFileFilters Value="True"/>
22+
</PublishOptions>
23+
<RunParams>
24+
<FormatVersion Value="2"/>
25+
</RunParams>
26+
<Units>
27+
<Unit>
28+
<Filename Value="http_server_demo.lpr"/>
29+
<IsPartOfProject Value="True"/>
30+
</Unit>
31+
</Units>
32+
</ProjectOptions>
33+
<CompilerOptions>
34+
<Version Value="11"/>
35+
<Target>
36+
<Filename Value="http_server_demo"/>
37+
</Target>
38+
<SearchPaths>
39+
<IncludeFiles Value="$(ProjOutDir);.."/>
40+
<Libraries Value=".."/>
41+
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
42+
</SearchPaths>
43+
<Linking>
44+
<Debugging>
45+
<DebugInfoType Value="dsDwarf3"/>
46+
</Debugging>
47+
</Linking>
48+
</CompilerOptions>
49+
<Debugging>
50+
<Exceptions>
51+
<Item>
52+
<Name Value="EAbort"/>
53+
</Item>
54+
<Item>
55+
<Name Value="ECodetoolError"/>
56+
</Item>
57+
<Item>
58+
<Name Value="EFOpenError"/>
59+
</Item>
60+
</Exceptions>
61+
</Debugging>
62+
</CONFIG>

library/http/http_server_demo.lpr

Lines changed: 108 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,108 @@
1+
program http_server_demo;
2+
3+
{$mode objfpc}{$H+}
4+
5+
uses
6+
{$IFDEF UNIX}
7+
cthreads,
8+
{$ENDIF}
9+
Classes, SysUtils, CustApp,
10+
{ you can add units after this }
11+
http_server_example;
12+
13+
type
14+
15+
{ THTTPServerDemo }
16+
17+
THTTPServerDemo = class(TCustomApplication)
18+
private
19+
procedure RunServer(port : integer);
20+
protected
21+
procedure DoRun; override;
22+
public
23+
constructor Create(TheOwner: TComponent); override;
24+
destructor Destroy; override;
25+
procedure WriteHelp; virtual;
26+
end;
27+
28+
{ THTTPServerDemo }
29+
30+
procedure THTTPServerDemo.RunServer(port: integer);
31+
var
32+
WebServer : TMyWebServer;
33+
begin
34+
WebServer := TMyWebServer.Create;
35+
try
36+
WebServer.Start(Port);
37+
try
38+
writeLn('Server running on port '+inttostr(port)+'. Press Enter to stop');
39+
ReadLn; // Wait for user input
40+
finally
41+
end;
42+
finally
43+
WebServer.Free;
44+
end;
45+
end;
46+
47+
procedure THTTPServerDemo.DoRun;
48+
var
49+
ErrorMsg: String;
50+
Port : integer;
51+
begin
52+
// quick check parameters
53+
ErrorMsg := CheckOptions('h', 'help');
54+
if ErrorMsg <> '' then
55+
begin
56+
ShowException(Exception.Create(ErrorMsg));
57+
Terminate;
58+
Exit;
59+
end;
60+
61+
// parse parameters
62+
if HasOption('h', 'help') then begin
63+
WriteHelp;
64+
Terminate;
65+
Exit;
66+
end;
67+
68+
try
69+
Port := 7180;
70+
if ParamCount > 0 then
71+
Port := StrToIntDef(ParamStr(1), 7180);
72+
RunServer(port);
73+
except
74+
on E: Exception do
75+
begin
76+
WriteLn('Error: ', E.Message);
77+
ReadLn;
78+
end;
79+
end;
80+
81+
Terminate;
82+
end;
83+
84+
constructor THTTPServerDemo.Create(TheOwner: TComponent);
85+
begin
86+
inherited Create(TheOwner);
87+
StopOnException:=True;
88+
end;
89+
90+
destructor THTTPServerDemo.Destroy;
91+
begin
92+
inherited Destroy;
93+
end;
94+
95+
procedure THTTPServerDemo.WriteHelp;
96+
begin
97+
writeln('Usage: ', ExeName, ' -h');
98+
end;
99+
100+
var
101+
Application: THTTPServerDemo;
102+
begin
103+
Application:=THTTPServerDemo.Create(nil);
104+
Application.Title:='Demonstration HTTP Server';
105+
Application.Run;
106+
Application.Free;
107+
end.
108+

0 commit comments

Comments
 (0)