浏览代码

Merged revisions 7434,7478 via svnmerge from
svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r7434 | joost | 2007-05-23 23:41:44 +0200 (Wed, 23 May 2007) | 1 line

* TCustomHTTPModule was not always created when needed.
........
r7478 | joost | 2007-05-25 23:02:05 +0200 (Fri, 25 May 2007) | 3 lines

* Added possibility to disable debugging
* Disable debugging if the server could not be found
* Catch exception if debugserver executable is not found
........

git-svn-id: branches/fixes_2_2@7993 -

joost 18 年之前
父节点
当前提交
206c702767
共有 2 个文件被更改,包括 33 次插入5 次删除
  1. 32 5
      packages/fcl-base/src/inc/dbugintf.pp
  2. 1 0
      packages/fcl-web/src/fpcgi.pp

+ 32 - 5
packages/fcl-base/src/inc/dbugintf.pp

@@ -34,10 +34,13 @@ procedure SendSeparator;
 procedure SendDebugFmt(const Msg: string; const Args: array of const);
 procedure SendDebugFmtEx(const Msg: string; const Args: array of const; MType: TDebugLevel);
 
+procedure SetDebuggingEnabled(const AValue : boolean);
+function GetDebuggingEnabled : Boolean;
+
 { low-level routines }
 
 Function  StartDebugServer : integer;
-Procedure InitDebugClient;
+Function InitDebugClient : Boolean;
 
 Const
   SendError       : String = '';
@@ -65,6 +68,7 @@ var
   DebugClient : TSimpleIPCClient = nil;
   MsgBuffer : TMemoryStream = Nil;
   ServerID : Integer;
+  DebugDisabled : Boolean;
   Indent : Integer = 0;
   
 Procedure WriteMessage(Const Msg : TDebugMessage);
@@ -79,6 +83,7 @@ end;
 procedure SendDebugMessage(Var Msg : TDebugMessage);
 
 begin
+  if DebugDisabled then exit;
   try
     If (DebugClient=Nil) then
       InitDebugClient;
@@ -190,16 +195,29 @@ begin
   SendDebugMessage(Mesg);
 end;
 
+procedure SetDebuggingEnabled(const AValue: boolean);
+begin
+  DebugDisabled := not AValue;
+end;
+
+function GetDebuggingEnabled: Boolean;
+begin
+  Result := not DebugDisabled;
+end;
+
 function StartDebugServer : Integer;
 
 begin
   With TProcess.Create(Nil) do
+    begin
     Try
       CommandLine:='debugserver';
       Execute;
       Result:=ProcessID;
-    Finally
-      Free;
+    Except
+      Result := 0;
+    end;
+    Free;
     end;
 end;
 
@@ -224,18 +242,26 @@ begin
   end;
 end;
 
-Procedure InitDebugClient;
+Function InitDebugClient : Boolean;
 
 Var
   msg : TDebugMessage;
   I : Integer;
   
 begin
+  Result := False;
   DebugClient:=TSimpleIPCClient.Create(Nil);
   DebugClient.ServerID:=DebugServerID;
   If not DebugClient.ServerRunning then
     begin
     ServerID:=StartDebugServer;
+    if ServerID = 0 then
+      begin
+      DebugDisabled := True;
+      Exit;
+      end
+    else
+      DebugDisabled := False;
     I:=0;
     While (I<10) and not DebugClient.ServerRunning do
       begin
@@ -249,10 +275,11 @@ begin
   Msg.MsgTimeStamp:=Now;
   Msg.Msg:=Format(SProcessID,[ApplicationName]);
   WriteMessage(Msg);
+  Result := True;
 end;
 
 Initialization
-
+  DebugDisabled := False;
 Finalization
   FreeDebugClient;
 end.

+ 1 - 0
packages/fcl-web/src/fpcgi.pp

@@ -121,6 +121,7 @@ Var
   
 begin
   MC:=Nil;
+  M:=Nil;
   If (OnGetModule<>Nil) then
     OnGetModule(Self,ARequest,MC);
   If (MC=Nil) then