Etusivu Tutki Apua
Kirjaudu sisään
pascal
/
freepascal.compiler
peilaus alkaen https://gitlab.com/freepascal.org/fpc/source.git
2
0
Fork 0
Tiedostot Ongelmat 0 Wiki
Selaa lähdekoodia

* Demo for simple file server

git-svn-id: trunk@35822 -
michael 8 vuotta sitten
vanhempi
5a7a05bd3f
commit
87b6646e02
6 muutettua tiedostoa jossa 177 lisäystä ja 0 poistoa
Yhdistetty näkymä Näytä diff tilastot
  1. 5 0
      .gitattributes
  2. 10 0
      packages/fcl-web/examples/simpleserver/README.txt
  3. 3 0
      packages/fcl-web/examples/simpleserver/index.css
  4. 10 0
      packages/fcl-web/examples/simpleserver/index.html
  5. 60 0
      packages/fcl-web/examples/simpleserver/simpleserver.lpi
  6. 89 0
      packages/fcl-web/examples/simpleserver/simpleserver.pas

+ 5 - 0
.gitattributes
Näytä tiedosto 

@@ -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/sessiondemo.lpr svneol=native#text/plain
 
 packages/fcl-web/examples/session/wmsession.lfm 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/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.lpi svneol=native#text/plain
 
 packages/fcl-web/examples/webdata/demo/createusers.lpr 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
 
 packages/fcl-web/examples/webdata/demo/extgrid-json.html svneol=native#text/plain

+ 10 - 0
packages/fcl-web/examples/simpleserver/README.txt
Näytä tiedosto 

@@ -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 - 0
packages/fcl-web/examples/simpleserver/index.css
Näytä tiedosto 

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

+ 10 - 0
packages/fcl-web/examples/simpleserver/index.html
Näytä tiedosto 

@@ -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 - 0
packages/fcl-web/examples/simpleserver/simpleserver.lpi
Näytä tiedosto 

@@ -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 - 0
packages/fcl-web/examples/simpleserver/simpleserver.pas
Näytä tiedosto 

@@ -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.
 
+