From 1cfa5058fe2d85d6bb4ebd873a9726af2f21b9a9 Mon Sep 17 00:00:00 2001 From: michael Date: Sun, 15 May 2011 12:39:26 +0000 Subject: [PATCH] * Initial implementation of HTTP Server component git-svn-id: trunk@17465 - --- .gitattributes | 3 + .../examples/httpserver/simplehttpserver.lpi | 71 +++ .../examples/httpserver/simplehttpserver.pas | 106 ++++ packages/fcl-web/src/base/fphttpserver.pp | 587 ++++++++++++++++++ packages/fcl-web/src/base/fpweb.pp | 2 +- packages/fcl-web/src/base/httpdefs.pp | 3 + 6 files changed, 771 insertions(+), 1 deletion(-) create mode 100644 packages/fcl-web/examples/httpserver/simplehttpserver.lpi create mode 100644 packages/fcl-web/examples/httpserver/simplehttpserver.pas create mode 100644 packages/fcl-web/src/base/fphttpserver.pp diff --git a/.gitattributes b/.gitattributes index 8963d032dc..c477724297 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2370,6 +2370,8 @@ packages/fcl-web/examples/combined/wmlogin.pp svneol=native#text/plain packages/fcl-web/examples/combined/wmusers.lfm svneol=native#text/plain packages/fcl-web/examples/combined/wmusers.lrs svneol=native#text/plain packages/fcl-web/examples/combined/wmusers.pp svneol=native#text/plain +packages/fcl-web/examples/httpserver/simplehttpserver.lpi svneol=native#text/plain +packages/fcl-web/examples/httpserver/simplehttpserver.pas svneol=native#text/plain packages/fcl-web/examples/jsonrpc/demo1/README.txt svneol=native#text/plain packages/fcl-web/examples/jsonrpc/demo1/demo.lpi svneol=native#text/plain packages/fcl-web/examples/jsonrpc/demo1/demo.lpr svneol=native#text/plain @@ -2474,6 +2476,7 @@ packages/fcl-web/src/base/fpdatasetform.pp svneol=native#text/plain packages/fcl-web/src/base/fpfcgi.pp svneol=native#text/plain packages/fcl-web/src/base/fphtml.pp svneol=native#text/plain packages/fcl-web/src/base/fphttp.pp svneol=native#text/plain +packages/fcl-web/src/base/fphttpserver.pp svneol=native#text/plain packages/fcl-web/src/base/fpweb.pp svneol=native#text/plain packages/fcl-web/src/base/httpdefs.pp svneol=native#text/plain packages/fcl-web/src/base/iniwebsession.pp svneol=native#text/plain diff --git a/packages/fcl-web/examples/httpserver/simplehttpserver.lpi b/packages/fcl-web/examples/httpserver/simplehttpserver.lpi new file mode 100644 index 0000000000..77428146d8 --- /dev/null +++ b/packages/fcl-web/examples/httpserver/simplehttpserver.lpi @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <Icon Value="0"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <Units Count="1"> + <Unit0> + <Filename Value="simplehttpserver.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="simplehttpserver"/> + </Unit0> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="10"/> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + </SearchPaths> + <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/packages/fcl-web/examples/httpserver/simplehttpserver.pas b/packages/fcl-web/examples/httpserver/simplehttpserver.pas new file mode 100644 index 0000000000..23d20d3625 --- /dev/null +++ b/packages/fcl-web/examples/httpserver/simplehttpserver.pas @@ -0,0 +1,106 @@ +program simplehttpserver; + +{$mode objfpc}{$H+} +{$define UseCThreads} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + sysutils, Classes, fphttpserver, fpmimetypes; + +Type + + { TTestHTTPServer } + + TTestHTTPServer = Class(TFPHTTPServer) + private + FBaseDir : String; + FCount : Integer; + FMimeLoaded : Boolean; + FMimeTypesFile: String; + procedure SetBaseDir(const AValue: String); + Protected + 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.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.Active:=True; + finally + Serv.Free; + end; +end. + diff --git a/packages/fcl-web/src/base/fphttpserver.pp b/packages/fcl-web/src/base/fphttpserver.pp new file mode 100644 index 0000000000..d9d9501672 --- /dev/null +++ b/packages/fcl-web/src/base/fphttpserver.pp @@ -0,0 +1,587 @@ +{ + $Id: header,v 1.1 2000/07/13 06:33:45 michael Exp $ + This file is part of the Free Component Library (FCL) + Copyright (c) 2011- by the Free Pascal development team + + Simple HTTP server component. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +unit fphttpserver; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, ssockets, httpdefs; + +Const + ReadBufLen = 4096; + +Type + TFPHTTPConnection = Class; + TFPHTTPConnectionThread = Class; + TFPCustomHttpServer = Class; + + { TFPHTTPConnectionRequest } + + TFPHTTPConnectionRequest = Class(TRequest) + private + FConnection: TFPHTTPConnection; + protected + Property Connection : TFPHTTPConnection Read FConnection; + end; + + { TFPHTTPConnectionResponse } + + TFPHTTPConnectionResponse = Class(TResponse) + private + FConnection: TFPHTTPConnection; + Protected + Procedure DoSendHeaders(Headers : TStrings); override; + Procedure DoSendContent; override; + Property Connection : TFPHTTPConnection Read FConnection; + end; + + + { TFPHTTPConnection } + + TFPHTTPConnection = Class(TObject) + private + FServer: TFPCustomHTTPServer; + FSocket: TSocketStream; + FBuffer : Ansistring; + procedure InterPretHeader(ARequest: TFPHTTPConnectionRequest; const AHeader: String); + function ReadString: String; + Protected + procedure ReadRequestContent(ARequest: TFPHTTPConnectionRequest); virtual; + procedure UnknownHeader(ARequest: TFPHTTPConnectionRequest; const AHeader: String); virtual; + Function ReadRequestHeaders : TFPHTTPConnectionRequest; + Public + Constructor Create(AServer : TFPCustomHTTPServer; ASocket : TSocketStream); + Destructor Destroy; override; + Procedure HandleRequest; virtual; + Property Socket : TSocketStream Read FSocket; + Property Server : TFPCustomHTTPServer Read FServer; + end; + + { TFPHTTPConnectionThread } + + TFPHTTPConnectionThread = Class(TThread) + private + FConnection: TFPHTTPConnection; + Public + Constructor CreateConnection(AConnection : TFPHTTPConnection); virtual; + Procedure Execute; override; + Property Connection : TFPHTTPConnection Read FConnection; + end; + + { TFPHttpServer } + THTTPServerRequestHandler = Procedure (Sender: TObject; + Var ARequest: TFPHTTPConnectionRequest; + Var AResponse : TFPHTTPConnectionResponse) of object; + + { TFPCustomHttpServer } + + TFPCustomHttpServer = Class(TComponent) + Private + FOnAllowConnect: TConnectQuery; + FOnRequest: THTTPServerRequestHandler; + FPort: Word; + FQueueSize: Word; + FServer : TInetServer; + FLoadActivate : Boolean; + FThreaded: Boolean; + function GetActive: Boolean; + procedure SetActive(const AValue: Boolean); + procedure SetOnAllowConnect(const AValue: TConnectQuery); + procedure SetPort(const AValue: Word); + procedure SetQueueSize(const AValue: Word); + procedure SetThreaded(const AValue: Boolean); + Protected + // Create a connection handling object. + function CreateConnection(Data : TSocketStream) : TFPHTTPConnection; virtual; + // Create a connection handling thread. + Function CreateConnectionThread(Conn : TFPHTTPConnection) : TFPHTTPConnectionThread; virtual; + // Check if server is inactive + Procedure CheckInactive; + // Called by TInetServer when a new connection is accepted. + Procedure DoConnect(Sender : TObject; Data : TSocketStream); virtual; + // Create and configure TInetServer + Procedure CreateServerSocket; virtual; + // Stop and free TInetServer + Procedure FreeServerSocket; virtual; + // Handle request. This calls OnRequest. It can be overridden by descendants to provide standard handling. + procedure HandleRequest(Var ARequest: TFPHTTPConnectionRequest; + Var AResponse : TFPHTTPConnectionResponse); virtual; + public + Constructor Create(AOwner : TComponent); override; + Destructor Destroy; override; + protected + // Set to true to start listening. + Property Active : Boolean Read GetActive Write SetActive Default false; + // Port to listen on. + Property Port : Word Read FPort Write SetPort Default 80; + // Max connections on queue (for Listen call) + Property QueueSize : Word Read FQueueSize Write SetQueueSize Default 5; + // Called when deciding whether to accept a connection. + Property OnAllowConnect : TConnectQuery Read FOnAllowConnect Write SetOnAllowConnect; + // Use a thread to handle a connection ? + property Threaded : Boolean read FThreaded Write SetThreaded; + // Called to handle the request. If Threaded=True, it is called in a the connection thread. + Property OnRequest : THTTPServerRequestHandler Read FOnRequest Write FOnRequest; + end; + + TFPHttpServer = Class(TFPCustomHttpServer) + Published + Property Active; + Property Port; + Property QueueSize; + Property OnAllowConnect; + property Threaded; + Property OnRequest; + end; + + EHTTPServer = Class(Exception); + +implementation + +resourcestring + SErrSocketActive = 'Operation not allowed while server is active'; + SErrReadingSocket = 'Error reading data from the socket'; + SErrMissingProtocol = 'Missing HTTP protocol version in request'; + +{ TFPHTTPConnectionRequest } +Function GetStatusCode (ACode: Integer) : String; + +begin + Case ACode of + 100 : Result:='Continue'; + 101 : Result:='Switching Protocols'; + 200 : Result:='OK'; + 201 : Result:='Created'; + 202 : Result:='Accepted'; + 203 : Result:='Non-Authoritative Information'; + 204 : Result:='No Content'; + 205 : Result:='Reset Content'; + 206 : Result:='Partial Content'; + 300 : Result:='Multiple Choices'; + 301 : Result:='Moved Permanently'; + 302 : Result:='Found'; + 303 : Result:='See Other'; + 304 : Result:='Not Modified'; + 305 : Result:='Use Proxy'; + 307 : Result:='Temporary Redirect'; + 400 : Result:='Bad Request'; + 401 : Result:='Unauthorized'; + 402 : Result:='Payment Required'; + 403 : Result:='Forbidden'; + 404 : Result:='Not Found'; + 405 : Result:='Method Not Allowed'; + 406 : Result:='Not Acceptable'; + 407 : Result:='Proxy Authentication Required'; + 408 : Result:='Request Time-out'; + 409 : Result:='Conflict'; + 410 : Result:='Gone'; + 411 : Result:='Length Required'; + 412 : Result:='Precondition Failed'; + 413 : Result:='Request Entity Too Large'; + 414 : Result:='Request-URI Too Large'; + 415 : Result:='Unsupported Media Type'; + 416 : Result:='Requested range not satisfiable'; + 417 : Result:='Expectation Failed'; + 500 : Result:='Internal Server Error'; + 501 : Result:='Not Implemented'; + 502 : Result:='Bad Gateway'; + 503 : Result:='Service Unavailable'; + 504 : Result:='Gateway Time-out'; + 505 : Result:='HTTP Version not supported'; + else + Result:='Unknown status'; + end; +end; + +procedure TFPHTTPConnectionResponse.DoSendHeaders(Headers: TStrings); + +Var + S : String; + I : Integer; +begin + S:=Format('HTTP/1.1 %3d %s'#13#10,[Code,GetStatusCode(Code)]); + For I:=0 to Headers.Count-1 do + S:=S+Headers[i]+#13#10; + // Last line in headers is empty. + Connection.Socket.WriteBuffer(S[1],Length(S)); +end; + +procedure TFPHTTPConnectionResponse.DoSendContent; +begin + If Assigned(ContentStream) then + Connection.Socket.CopyFrom(ContentStream,0) + else + Contents.SaveToStream(Connection.Socket); +end; + +{ TFPHTTPConnection } + +function TFPHTTPConnection.ReadString : String; + + Procedure FillBuffer; + + Var + R : Integer; + + begin + SetLength(FBuffer,ReadBufLen); + r:=FSocket.Read(FBuffer[1],ReadBufLen); + If r<0 then + Raise EHTTPServer.Create(SErrReadingSocket); + if (r<ReadBuflen) then + SetLength(FBuffer,r); + end; + +Var + CheckLF,Done : Boolean; + P,L : integer; + +begin + Result:=''; + Done:=False; + CheckLF:=False; + Repeat + if Length(FBuffer)=0 then + FillBuffer; + if Length(FBuffer)=0 then + Done:=True + else if CheckLF then + begin + If (FBuffer[1]<>#10) then + Result:=Result+#13 + else + begin + Delete(FBuffer,1,1); + Done:=True; + end; + end; + if not Done then + begin + P:=Pos(#13#10,FBuffer); + If P=0 then + begin + L:=Length(FBuffer); + CheckLF:=FBuffer[L]=#13; + if CheckLF then + Result:=Result+Copy(FBuffer,1,L-1) + else + Result:=Result+FBuffer; + FBuffer:=''; + end + else + begin + Result:=Result+Copy(FBuffer,1,P-1); + Delete(FBuffer,1,P+1); + Done:=True; + end; + end; + until Done; +end; + +procedure TFPHTTPConnection.UnknownHeader(ARequest: TFPHTTPConnectionRequest; + const AHeader: String); +begin + // Do nothing +end; + +Procedure TFPHTTPConnection.InterPretHeader(ARequest : TFPHTTPConnectionRequest; Const AHeader : String); + +Var + P : Integer; + N,V : String; + +begin + V:=AHeader; + P:=Pos(':',V); + if (P=0) then + begin + UnknownHeader(ARequest,Aheader); + Exit; + end; + N:=Copy(V,1,P-1); + Delete(V,1,P+1); + V:=Trim(V); + ARequest.SetFieldByName(N,V); +end; + +procedure ParseStartLine(Request : TFPHTTPConnectionRequest; AStartLine : String); + + Function GetNextWord(Var S : String) : string; + + Var + P : Integer; + + begin + P:=Pos(' ',S); + If (P=0) then + P:=Length(S)+1; + Result:=Copy(S,1,P-1); + Delete(S,1,P); + end; + +Var + S : String; + +begin + Request.Method:=GetNextWord(AStartLine); + Request.URL:=GetNextWord(AStartLine); + S:=GetNextWord(AStartLine); + If (Pos('HTTP/',S)<>1) then + Raise Exception.Create(SErrMissingProtocol); + Delete(S,1,5); + Request.ProtocolVersion:=trim(S); +end; + +Procedure TFPHTTPConnection.ReadRequestContent(ARequest : TFPHTTPConnectionRequest); + +Var + P,L,R : integer; + S : String; + +begin + L:=ARequest.ContentLength; + If (L>0) then + begin + SetLength(S,L); + P:=Length(FBuffer); + if (P>0) then + Move(FBuffer[1],S,P); + P:=P+1; + Repeat + R:=FSocket.Read(S[p],L); + If R<0 then + Raise EHTTPServer.Create(SErrReadingSocket); + if (R>0) then + begin + P:=P+R; + L:=L-R; + end; + until (L=0) or (R=0); + end; + ARequest.Content:=S; +end; + +function TFPHTTPConnection.ReadRequestHeaders: TFPHTTPConnectionRequest; + +Var + StartLine,S : String; +begin + Result:=TFPHTTPConnectionRequest.Create; + Result.FConnection:=Self; + StartLine:=ReadString; + ParseStartLine(Result,StartLine); + Repeat + S:=ReadString; + if (S<>'') then + InterPretHeader(Result,S); + Until (S=''); +end; + +constructor TFPHTTPConnection.Create(AServer: TFPCustomHttpServer; ASocket: TSocketStream + ); +begin + FSocket:=ASocket; + FServer:=AServer; +end; + +destructor TFPHTTPConnection.Destroy; +begin + FreeAndNil(FSocket); + Inherited; +end; + +procedure TFPHTTPConnection.HandleRequest; + +Var + Req : TFPHTTPConnectionRequest; + Resp : TFPHTTPConnectionResponse; + +begin + // Read headers. + Req:=ReadRequestHeaders; + try + // Read content, if any + If Req.ContentLength>0 then + ReadRequestContent(Req); + // Create Response + Resp:= TFPHTTPConnectionResponse.Create(Req); + try + Resp.FConnection:=Self; + // And dispatch + if Server.Active then + Server.HandleRequest(Req,Resp); + if Assigned(Resp) and (not Resp.ContentSent) then + Resp.SendContent; + finally + FreeAndNil(Resp); + end; + Finally + FreeAndNil(Req); + end; +end; + +{ TFPHTTPConnectionThread } + +constructor TFPHTTPConnectionThread.CreateConnection(AConnection: TFPHTTPConnection + ); +begin + FConnection:=AConnection; + FreeOnTerminate:=True; + Inherited Create(False); +end; + +procedure TFPHTTPConnectionThread.Execute; +begin + try + try + FConnection.HandleRequest; + finally + FreeAndNil(FConnection); + end; + except + // Silently ignore errors. + end; +end; + +{ TFPCustomHttpServer } + +function TFPCustomHttpServer.GetActive: Boolean; +begin + if (csDesigning in ComponentState) then + Result:=FLoadActivate + else + Result:=Assigned(FServer); +end; + +procedure TFPCustomHttpServer.SetActive(const AValue: Boolean); +begin + If AValue=GetActive then exit; + FLoadActivate:=AValue; + if not (csDesigning in Componentstate) then + if AValue then + CreateServerSocket + else + FreeServerSocket; +end; + +procedure TFPCustomHttpServer.SetOnAllowConnect(const AValue: TConnectQuery); +begin + if FOnAllowConnect=AValue then exit; + CheckInactive; + FOnAllowConnect:=AValue; +end; + +procedure TFPCustomHttpServer.SetPort(const AValue: Word); +begin + if FPort=AValue then exit; + CheckInactive; + FPort:=AValue; +end; + +procedure TFPCustomHttpServer.SetQueueSize(const AValue: Word); +begin + if FQueueSize=AValue then exit; + CheckInactive; + FQueueSize:=AValue; +end; + +procedure TFPCustomHttpServer.SetThreaded(const AValue: Boolean); +begin + if FThreaded=AValue then exit; + CheckInactive; + FThreaded:=AValue; +end; + +function TFPCustomHttpServer.CreateConnection(Data: TSocketStream): TFPHTTPConnection; +begin + Result:=TFPHTTPConnection.Create(Self,Data); +end; + +function TFPCustomHttpServer.CreateConnectionThread(Conn: TFPHTTPConnection + ): TFPHTTPConnectionThread; +begin + Result:=TFPHTTPConnectionThread.CreateConnection(Conn); +end; + +procedure TFPCustomHttpServer.CheckInactive; +begin + If GetActive then + Raise EHTTPServer.Create(SErrSocketActive); +end; + +procedure TFPCustomHttpServer.DoConnect(Sender: TObject; Data: TSocketStream); + +Var + Con : TFPHTTPConnection; + +begin + Con:=CreateConnection(Data); + try + Con.FServer:=Self; + if Threaded then + CreateConnectionThread(Con) + else + begin + Con.HandleRequest; + end; + finally + if not Threaded then + Con.Free; + end; +end; + +procedure TFPCustomHttpServer.CreateServerSocket; +begin + FServer:=TInetServer.Create(FPort); + FServer.MaxConnections:=-1; + FServer.OnConnectQuery:=OnAllowConnect; + FServer.OnConnect:=@DOConnect; + FServer.QueueSize:=Self.QueueSize; + FServer.Bind; + FServer.Listen; + FServer.StartAccepting; +end; + +procedure TFPCustomHttpServer.FreeServerSocket; +begin + FServer.StopAccepting; + FreeAndNil(FServer); +end; + +procedure TFPCustomHttpServer.HandleRequest(var ARequest: TFPHTTPConnectionRequest; + var AResponse: TFPHTTPConnectionResponse); +begin + If Assigned(FOnRequest) then + FonRequest(Self,ARequest,AResponse); +end; + +constructor TFPCustomHttpServer.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FPort:=80; + FQueueSize:=5; +end; + +destructor TFPCustomHttpServer.Destroy; +begin + Active:=False; + inherited Destroy; +end; + +end. + diff --git a/packages/fcl-web/src/base/fpweb.pp b/packages/fcl-web/src/base/fpweb.pp index 6a3a70e2ad..0ae8288d77 100644 --- a/packages/fcl-web/src/base/fpweb.pp +++ b/packages/fcl-web/src/base/fpweb.pp @@ -127,7 +127,7 @@ Type Property AfterResponse : TResponseEvent Read FAfterResponse Write FAfterResponse; Property OnGetAction : TGetActionEvent Read GetOnGetAction Write SetOnGetAction; Property DefActionWhenUnknown : Boolean read GetDefActionWhenUnknown write SetDefActionWhenUnknown default true; - Property Template : TFPTemplate Read FTemplate Write SetTemplate; + Property ModuleTemplate : TFPTemplate Read FTemplate Write SetTemplate; Property OnGetParam : TGetParamEvent Read FOnGetParam Write FOnGetParam; Property OnTemplateContent : TGetParamEvent Read FOnGetParam Write FOnGetParam; Property Request: TRequest Read FRequest; diff --git a/packages/fcl-web/src/base/httpdefs.pp b/packages/fcl-web/src/base/httpdefs.pp index 7a01039d96..2ac19e36c2 100644 --- a/packages/fcl-web/src/base/httpdefs.pp +++ b/packages/fcl-web/src/base/httpdefs.pp @@ -175,6 +175,7 @@ type FHTTPXRequestedWith: String; FFields : THttpFields; FQueryFields: TStrings; + FURL : String; function GetSetField(AIndex: Integer): String; function GetSetFieldName(AIndex: Integer): String; procedure SetCookieFields(const AValue: TStrings); @@ -624,6 +625,7 @@ begin else case Index of 0 : Result:=FHTTPVersion; + 32 : Result:=FURL; 36 : Result:=FHTTPXRequestedWith; else Result := ''; @@ -654,6 +656,7 @@ begin 28 : ; // Property RemoteHost : String Index 28 read GetFieldValue Write SetFieldValue; 29 : ; // Property ScriptName : String Index 29 read GetFieldValue Write SetFieldValue; 30 : ; // Property ServerPort : Word Read GetServerPort; // Index 30 + 32 : FURL:=Value; 36 : FHTTPXRequestedWith:=Value; end; end;