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

* Checked and resolved most hints/warnings

Browse Source 
git-svn-id: trunk@17662 -
This commit is contained in:
michael 2011-06-05 10:21:42 +00:00
parent 4a06ad79c6
commit c07ad8dd86
14 changed files with 41 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
packages/fcl-web/src/base/cgiapp.pp
View File

@ -679,6 +679,7 @@ begin
end
else
begin
B:=0;
While (I.Read(B,1)>0) do
M.Write(B,1)
end;
@ -763,7 +764,7 @@ var
aLenSep := Length(aSepStr);
end;
function NextToken(var aToken : String; var aSepChar : Char) : Boolean;
function NextToken(var aToken : String; out aSepChar : Char) : Boolean;
var
i : Integer;

3
packages/fcl-web/src/base/custcgi.pp
View File

@ -309,6 +309,7 @@ begin
else
begin
FContent:='';
B:=0;
While (I.Read(B,1)>0) do
FContent:=FContent + chr(B);
end;
@ -407,7 +408,7 @@ end;
function TCustomCGIApplication.GetResponse: TCGIResponse;
begin
Result:=TCgiHandler(WebHandler).Response;
end;
function TCustomCGIApplication.InitializeWebHandler: TWebHandler;

15
packages/fcl-web/src/base/custfcgi.pp
View File

@ -23,7 +23,7 @@ Interface
uses
Classes,SysUtils, httpdefs,
{$ifdef unix}
BaseUnix, TermIO,
BaseUnix,
{$else}
winsock2, windows,
{$endif}
@ -498,12 +498,12 @@ begin
if not FlushFileBuffers(FHandle) then
begin
I:=GetLastError;
// Log(etError,Format('Failed to flush file buffers: %d ',[i]));
Log(etError,Format('Failed to flush file buffers: %d ',[i]));
end;
if not DisconnectNamedPipe(FHandle) then
begin
I:=GetLastError;
// Log(etError,Format('Failed to disconnect named pipe: %d ',[i]));
Log(etError,Format('Failed to disconnect named pipe: %d ',[i]));
end
end
else
@ -669,7 +669,8 @@ begin
l.l_onoff:=1;
l.l_linger:=1;
lr:=fpsetsockopt(Socket,SOL_SOCKET,SO_LINGER,@l,ll);
// Log(etDebug,Format('Set socket linger (%d, %d) : %d',[L.l_linger,L.l_onoff,lr]));
if (lr<>0) then
Log(etError,Format('Set socket linger failed : %d',[lr]));
end;
end;
end;
@ -716,10 +717,10 @@ function TFCgiHandler.DoFastCGIRead(AHandle: THandle; var ABuf; ACount: Integer)
begin
{$ifdef windows}
if FIsWinPipe then
Result:=FileRead(FHandle,ABuf,ACount)
Result:=FileRead(AHandle,ABuf,ACount)
else
{$endif}
Result:=sockets.fpRecv(FHandle, @Abuf, ACount, NoSignalAttr);
Result:=sockets.fpRecv(AHandle, @Abuf, ACount, NoSignalAttr);
end;
function TFCgiHandler.DoFastCGIWrite(AHandle: THandle; const ABuf;
@ -799,7 +800,7 @@ begin
if not SetNamedPipeHandleState(Result,@PipeMode,Nil,Nil) then
begin
I:=GetLastError;
// Log(etError,'Setting named pipe handle state failed : '+intToStr(i));
Log(etError,'Setting named pipe handle state failed : '+intToStr(i));
end;
FIsWinPipe:=True;
end;

4
packages/fcl-web/src/base/custhttpapp.pp
View File

@ -218,7 +218,9 @@ end;
function TFPHTTPServerHandler.WaitForRequest(out ARequest: TRequest;
out AResponse: TResponse): boolean;
begin
// Result:=inherited WaitForRequest(ARequest, AResponse);
Result:=False;
ARequest:=Nil;
AResponse:=Nil;
end;
function TFPHTTPServerHandler.CreateServer: TEmbeddedHttpServer;

6
packages/fcl-web/src/base/ezcgi.pp
View File

@ -17,7 +17,7 @@ unit ezcgi;
interface
uses classes, strings, sysutils;
uses classes, sysutils;
const
hexTable = '0123456789ABCDEF';
@ -41,7 +41,7 @@ type
aLenSep : Integer;
procedure InitToken(aStr, aSep : String);
function NextToken(var aToken : String; var aSepChar : Char) : Boolean;
function NextToken(var aToken : String; out aSepChar : Char) : Boolean;
procedure GetQueryItems;
procedure ProcessRequest;
@ -338,7 +338,7 @@ begin
aLenSep := Length(aSepStr);
end;
function TEZcgi.NextToken(var aToken : String; var aSepChar : Char) : Boolean;
function TEZcgi.NextToken(var aToken : String; out aSepChar : Char) : Boolean;
var
i : Integer;
j : Integer;

1
packages/fcl-web/src/base/fcgigate.pp
View File

@ -482,6 +482,7 @@ Procedure TFastCGIGatewayHandler.ProcessUnknownRecord(Const Rec : PFCGI_Header;
begin
{$IFDEF CGIGDEBUG}SendMethodEnter('ProcessUnknownRecord');{$ENDIF}
{$IFDEF CGIGDEBUG}SendDebugFMT('Unknown record encountered : %d',[Rec^.ReqType]);{$ENDIF}
EOR:=False;
// Do nothing.
{$IFDEF CGIGDEBUG}SendMethodEnter('ProcessUnknownRecord');{$ENDIF}
end;

8
packages/fcl-web/src/base/fpapache.pp
View File

@ -125,7 +125,7 @@ Type
procedure SetPriority(const AValue: THandlerPriority);
public
function InitializeWebHandler: TWebHandler; override;
Procedure Initialize;
Procedure Initialize;override;
procedure ShowException(E: Exception); override;
Function ProcessRequest(P : PRequest_Rec) : Integer; virtual;
Function AllowRequest(P : PRequest_Rec) : Boolean; virtual;
@ -277,7 +277,9 @@ end;
function TApacheHandler.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
begin
// Do nothing. Requests are triggered by Apache
Result:=False;
ARequest:=Nil;
AResponse:=Nil;
end;
function TApacheHandler.AllowRequest(P: PRequest_Rec): Boolean;
@ -454,7 +456,6 @@ function TApacheRequest.GetFieldValue(Index: Integer): String;
end;
var
P : Pchar;
FN : String;
I : Integer;
@ -728,6 +729,7 @@ end;
procedure TCustomApacheApplication.Initialize;
begin
Inherited;
TApacheHandler(WebHandler).Initialize;
end;

4
packages/fcl-web/src/base/fphtml.pp
View File

@ -1118,6 +1118,7 @@ end;
Function TCustomHTMLModule.CreateDocument : THTMLDocument;
begin
Result:=Nil;
If Assigned(FOnCreateDocument) then
FOnCreateDocument(Self,Result);
If (Result=Nil) then
@ -1132,12 +1133,13 @@ end;
procedure TCustomHTMLModule.SetActions(const AValue: THTMLContentActions);
begin
FActions.Assign(AValue);
end;
Function TCustomHTMLModule.CreateWriter(ADocument : THTMLDocument) : THTMLWriter;
begin
Result:=Nil;
If Assigned(FOnCreateWriter) then
FOnCreateWriter(Self,ADocument,Result);
if (Result=Nil) then

5
packages/fcl-web/src/base/fphttp.pp
View File

@ -63,10 +63,11 @@ Type
Protected
procedure SetContentProducer(const AValue: THTTPContentProducer);virtual;
Function GetDisplayName : String; override;
Function GetNamePath : String; override;
Procedure SetDisplayName(const AValue : String); override;
Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse; Var Handled : Boolean);
Procedure DoHandleRequest(ARequest : TRequest; AResponse : TResponse; Var Handled : Boolean); virtual;
Public
Function GetNamePath : String; override;
published
Property Name : String Read GetDisplayName Write SetDisplayName;
Property ContentProducer : THTTPContentProducer Read FContentproducer Write SetContentProducer;
@ -317,7 +318,7 @@ end;
procedure RegisterHTTPModule(ModuleClass: TCustomHTTPModuleClass; SkipStreaming : Boolean = False);
begin
RegisterHTTPModule(ModuleClass.ClassName,ModuleClass);
RegisterHTTPModule(ModuleClass.ClassName,ModuleClass,SkipStreaming);
end;
procedure RegisterHTTPModule(const ModuleName: String;

3
packages/fcl-web/src/base/fphttpclient.pp
View File

@ -511,7 +511,7 @@ begin
I:=Low(AllowedResponseCodes);
While (Not Result) and (I<=High(AllowedResponseCodes)) do
begin
Result:=(AllowedResponseCodes[i]=FResponseStatusCode);
Result:=(AllowedResponseCodes[i]=ACode);
Inc(I);
end
end;
@ -741,6 +741,7 @@ Var
S,N,V : String;
begin
S:='';
For I:=0 to FormData.Count-1 do
begin
If (S<>'') then

1
packages/fcl-web/src/base/fpweb.pp
View File

@ -407,6 +407,7 @@ Var
begin
S:=TStringStream.Create('');
Try
B:=False;
FActions.GetContent(TFPWebTemplate(FTemplate).Request,S,B);
If Not B then
Raise EFPWebError.Create(SErrNoContentProduced);

9
packages/fcl-web/src/base/httpdefs.pp
View File

@ -274,11 +274,11 @@ type
FReturnedPathInfo : String;
FLocalPathPrefix : string;
function GetLocalPathPrefix: string;
procedure ParseFirstHeaderLine(const line: String);override;
function GetFirstHeaderLine: String;
Protected
FContentRead : Boolean;
FContent : String;
procedure ParseFirstHeaderLine(const line: String);override;
procedure ReadContent; virtual;
Function GetFieldValue(AIndex : Integer) : String; override;
Procedure SetFieldValue(Index : Integer; Value : String); override;
@ -330,7 +330,7 @@ type
Procedure DoSendContent; virtual; abstract;
Procedure CollectHeaders(Headers : TStrings); virtual;
public
constructor Create(ARequest : TRequest);
constructor Create(ARequest : TRequest); overload;
destructor destroy; override;
Procedure SendContent;
Procedure SendHeaders;
@ -1095,7 +1095,7 @@ var
aLenSep := Length(aSepStr);
end;
function NextToken(var aToken : String; out aSepChar : Char) : Boolean;
function NextToken(out aToken : String; out aSepChar : Char) : Boolean;
var
i : Integer;
@ -1222,7 +1222,6 @@ procedure TRequest.InitPostVars;
Var
M : TCapacityStream;
Cl : Integer;
B : Byte;
CT : String;
begin
@ -1252,7 +1251,7 @@ begin
{$ifdef CGIDEBUG}
SendMethodExit('InitPostVars');
{$endif}
end;
end;
procedure TRequest.InitGetVars;
Var

7
packages/fcl-web/src/base/iniwebsession.pp
View File

@ -190,10 +190,11 @@ begin
Repeat
if (Info.Attr and faDirectory=0) then
begin
Ini:=TMeminiFile.Create(SessionDir+Info.Name);
FN:=SessionDir+Info.Name;
Ini:=TMeminiFile.Create(FN);
try
If SessionExpired(Ini) then
DeleteSessionFile(SessionDir+Info.Name);
DeleteSessionFile(FN);
finally
Ini.Free;
end;
@ -278,8 +279,6 @@ end;
procedure TIniWebSession.InitSession(ARequest: TRequest; OnNewSession,OnExpired: TNotifyEvent);
Var
L,D : TDateTime;
T : Integer;
S : String;
begin

2
packages/fcl-web/src/base/webpage.pp
View File

@ -128,7 +128,7 @@ type
implementation
uses rtlconsts, typinfo, XMLWrite, strutils;
uses typinfo, strutils;
var RegisteredScriptList : TStrings;