paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-14 14:29:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Demo for simple file server

Browse Source 
git-svn-id: trunk@35822 -
This commit is contained in:
michael 2017-04-17 11:35:34 +00:00
parent 5a7a05bd3f
commit 87b6646e02
6 changed files with 177 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitattributes vendored
View File

@ -3163,6 +3163,11 @@ packages/fcl-web/examples/session/sessiondemo.lpi svneol=native#text/plain
packages/fcl-web/examples/session/sessiondemo.lpr svneol=native#text/plain
packages/fcl-web/examples/session/wmsession.lfm svneol=native#text/plain
packages/fcl-web/examples/session/wmsession.pp svneol=native#text/plain
packages/fcl-web/examples/simpleserver/README.txt svneol=native#text/plain
packages/fcl-web/examples/simpleserver/index.css svneol=native#text/plain
packages/fcl-web/examples/simpleserver/index.html svneol=native#text/plain
packages/fcl-web/examples/simpleserver/simpleserver.lpi svneol=native#text/plain
packages/fcl-web/examples/simpleserver/simpleserver.pas svneol=native#text/plain
packages/fcl-web/examples/webdata/demo/createusers.lpi svneol=native#text/plain
packages/fcl-web/examples/webdata/demo/createusers.lpr svneol=native#text/plain
packages/fcl-web/examples/webdata/demo/extgrid-json.html svneol=native#text/plain

10
packages/fcl-web/examples/simpleserver/README.txt Normal file
View File

@ -0,0 +1,10 @@
Small demo for simple file module. The server will listen on a specified
port (default 3000) and will serve files starting from the current working
directory.
Just start the server, no options, and point your browser at
http://localhost:3000/
running simpleserver -h will provide some help.

3
packages/fcl-web/examples/simpleserver/index.css Normal file
View File

@ -0,0 +1,3 @@
.important {
color: red
}

10
packages/fcl-web/examples/simpleserver/index.html Normal file
View File

@ -0,0 +1,10 @@
<http>
<link rel="stylesheet" href="index.css">
<body>
<H1>Simple server demo</H1>
If you see this page, it demonstrates that the simple server demo serves the
<span class="important">index.html</span> page. <p>
If it shows index.html in a
different style, it means the css is loaded as well.
</body>
</http>

60
packages/fcl-web/examples/simpleserver/simpleserver.lpi Normal file
View File

@ -0,0 +1,60 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="simpleserver"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<Units Count="1">
<Unit0>
<Filename Value="simpleserver.pas"/>
<IsPartOfProject Value="True"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="simpleserver"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

89
packages/fcl-web/examples/simpleserver/simpleserver.pas Normal file
View File

@ -0,0 +1,89 @@
program simpleserver;
uses sysutils,custhttpapp, fpwebfile;
Type
{ THTTPApplication }
THTTPApplication = Class(TCustomHTTPApplication)
private
FQuiet: Boolean;
procedure Usage(Msg: String);
published
procedure DoLog(EventType: TEventType; const Msg: String); override;
Procedure DoRun; override;
property Quiet : Boolean read FQuiet Write FQuiet;
end;
Var
Application : THTTPApplication;
{ THTTPApplication }
procedure THTTPApplication.DoLog(EventType: TEventType; const Msg: String);
begin
if Quiet then
exit;
if IsConsole then
Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',Now),' [',EventType,'] ',Msg)
else
inherited DoLog(EventType, Msg);
end;
procedure THTTPApplication.Usage(Msg : String);
begin
if (Msg<>'') then
Writeln('Error: ',Msg);
Writeln('Usage ',ExtractFileName(ParamStr(0)),' [options] ');
Writeln('Where options is one or more of : ');
Writeln('-d --directory=dir Base directory from which to serve files.');
Writeln(' Default is current working directory: ',GetCurrentDir);
Writeln('-h --help This help text');
Writeln('-i --indexpage=name Directory index page to use (default: index.html)');
Writeln('-n --noindexpage Do not allow index page.');
Writeln('-p --port=NNNN TCP/IP port to listen on (default is 3000)');
Writeln('-q --quiet Do not write diagnostic messages');
Halt(Ord(Msg<>''));
end;
procedure THTTPApplication.DoRun;
Var
S,IndexPage,D : String;
begin
S:=Checkoptions('hqd:ni:p:',['help','quiet','noindexpage','directory:','port:','indexpage:']);
if (S<>'') or HasOption('h','help') then
usage(S);
Quiet:=HasOption('q','quiet');
Port:=StrToIntDef(GetOptionValue('p','port'),3000);
D:=GetOptionValue('d','directory');
if D='' then
D:=GetCurrentDir;
Log(etInfo,'Listening on port %d, serving files from directory: %s',[Port,D]);
{$ifdef unix}
MimeTypesFile:='/etc/mime.types';
{$endif}
TSimpleFileModule.BaseDir:=IncludeTrailingPathDelimiter(D);
TSimpleFileModule.OnLog:=@Log;
If not HasOption('n','noindexpage') then
begin
IndexPage:=GetOptionValue('i','indexpage');
if IndexPage='' then
IndexPage:='index.html';
Log(etInfo,'Using index page %s',[IndexPage]);
TSimpleFileModule.IndexPageName:=IndexPage;
end;
inherited;
end;
begin
TSimpleFileModule.RegisterDefaultRoute;
Application:=THTTPApplication.Create(Nil);
Application.Initialize;
Application.Run;
Application.Free;
end.