1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
program simplehttpserver;
{$mode objfpc}{$H+}
{$define UseCThreads}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
sysutils, Classes, fphttpserver, fpmimetypes, wmecho;
Type
{ TTestHTTPServer }
TTestHTTPServer = Class(TFPHTTPServer)
private
FBaseDir : String;
FCount : Integer;
FMimeLoaded : Boolean;
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
Serv : TTestHTTPServer;
{ TTestHTTPServer }
procedure TTestHTTPServer.SetBaseDir(const AValue: String);
begin
if FBaseDir=AValue then exit;
FBaseDir:=AValue;
If (FBaseDir<>'') then
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
begin
MimeTypes.LoadFromFile(MimeTypesFile);
FMimeLoaded:=true;
end;
end;
procedure TTestHTTPServer.HandleRequest(var ARequest: TFPHTTPConnectionRequest;
var AResponse: TFPHTTPConnectionResponse);
Var
F : TFileStream;
FN : String;
begin
FN:=ARequest.Url;
If (length(FN)>0) and (FN[1]='/') then
Delete(FN,1,1);
DoDirSeparators(FN);
FN:=BaseDir+FN;
if FileExists(FN) then
begin
F:=TFileStream.Create(FN,fmOpenRead);
try
CheckMimeLoaded;
AResponse.ContentType:=MimeTypes.GetMimeType(ExtractFileExt(FN));
Writeln('Serving file: "',Fn,'". Reported Mime type: ',AResponse.ContentType);
AResponse.ContentLength:=F.Size;
AResponse.ContentStream:=F;
AResponse.SendContent;
AResponse.ContentStream:=Nil;
finally
F.Free;
end;
end
else
begin
AResponse.Code:=404;
AResponse.SendContent;
end;
Inc(FCount);
If FCount>=5 then
Active:=False;
end;
begin
Serv:=TTestHTTPServer.Create(Nil);
try
Serv.BaseDir:=ExtractFilePath(ParamStr(0));
{$ifdef unix}
Serv.MimeTypesFile:='/etc/mime.types';
{$endif}
Serv.Threaded:=False;
Serv.Port:=8080;
Serv.AcceptIdleTimeout:=1000;
Serv.OnAcceptIdle:=@Serv.DoIdle;
Serv.Active:=True;
finally
Serv.Free;
end;
end.
|
