Selaa lähdekoodia

* Checked and resolved most hints/warnings

git-svn-id: trunk@17662 -
michael 14 vuotta sitten
vanhempi
commit
c07ad8dd86

+ 2 - 1
packages/fcl-web/src/base/cgiapp.pp

@@ -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;

+ 2 - 1
packages/fcl-web/src/base/custcgi.pp

@@ -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;

+ 8 - 7
packages/fcl-web/src/base/custfcgi.pp

@@ -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;

+ 3 - 1
packages/fcl-web/src/base/custhttpapp.pp

@@ -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;

+ 3 - 3
packages/fcl-web/src/base/ezcgi.pp

@@ -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 - 0
packages/fcl-web/src/base/fcgigate.pp

@@ -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;

+ 5 - 3
packages/fcl-web/src/base/fpapache.pp

@@ -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;
 

+ 3 - 1
packages/fcl-web/src/base/fphtml.pp

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

+ 3 - 2
packages/fcl-web/src/base/fphttp.pp

@@ -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;

+ 2 - 1
packages/fcl-web/src/base/fphttpclient.pp

@@ -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 - 0
packages/fcl-web/src/base/fpweb.pp

@@ -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);

+ 4 - 5
packages/fcl-web/src/base/httpdefs.pp

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

+ 3 - 4
packages/fcl-web/src/base/iniwebsession.pp

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

+ 1 - 1
packages/fcl-web/src/base/webpage.pp

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