Browse Source

* Merging revisions r46301 from trunk:
------------------------------------------------------------------------
r46301 | michael | 2020-08-06 23:16:21 +0200 (Thu, 06 Aug 2020) | 1 line

* Fix bug ID #37504: allow to send processID in messages
------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@46611 -

michael 5 years ago
parent
commit
ed27ad4438
1 changed files with 28 additions and 8 deletions
  1. 28 8
      packages/fcl-process/src/dbugintf.pp

+ 28 - 8
packages/fcl-process/src/dbugintf.pp

@@ -41,13 +41,14 @@ function GetDebuggingEnabled : Boolean;
 
 
 Function  StartDebugServer : integer;
 Function  StartDebugServer : integer;
 Function InitDebugClient : Boolean;
 Function InitDebugClient : Boolean;
+Function InitDebugClient(const ShowOrNotPID: Boolean) : Boolean; overload;
 
 
 Const
 Const
   SendError       : String = '';
   SendError       : String = '';
   DefaultDebugServer = 'debugserver';
   DefaultDebugServer = 'debugserver';
  
  
 ResourceString
 ResourceString
-  SProcessID = 'Process %s';
+  SProcessID = 'Process %s (PID=%d)';
   SEntering = '> Entering ';
   SEntering = '> Entering ';
   SExiting  = '< Exiting ';
   SExiting  = '< Exiting ';
   SSeparator = '>-=-=-=-=-=-=-=-=-=-=-=-=-=-=-<';
   SSeparator = '>-=-=-=-=-=-=-=-=-=-=-=-=-=-=-<';
@@ -72,6 +73,7 @@ Const
 var
 var
   DebugClient : TSimpleIPCClient = nil;
   DebugClient : TSimpleIPCClient = nil;
   MsgBuffer : TMemoryStream = Nil;
   MsgBuffer : TMemoryStream = Nil;
+  AlwaysDisplayPID : Boolean = False;
   ServerID : Integer;
   ServerID : Integer;
   DebugDisabled : Boolean = False;
   DebugDisabled : Boolean = False;
   Indent : Integer = 0;
   Indent : Integer = 0;
@@ -139,7 +141,10 @@ Var
 begin
 begin
   Mesg.MsgTimeStamp:=Now;
   Mesg.MsgTimeStamp:=Now;
   Mesg.MsgType:=ErrorLevel[MTYpe];
   Mesg.MsgType:=ErrorLevel[MTYpe];
-  Mesg.Msg:=Msg;
+  if AlwaysDisplayPID then
+    Mesg.Msg:=IntToStr(GetProcessID)+' '+Msg
+  else
+    Mesg.Msg:=Msg;
   SendDebugMessage(Mesg);
   SendDebugMessage(Mesg);
 end;
 end;
 
 
@@ -150,7 +155,10 @@ Var
 begin
 begin
   Mesg.MsgTimeStamp:=Now;
   Mesg.MsgTimeStamp:=Now;
   Mesg.MsgType:=dmtInformation;
   Mesg.MsgType:=dmtInformation;
-  Mesg.Msg:=Msg;
+  if AlwaysDisplayPID then
+    Mesg.Msg:=IntToStr(GetProcessID)+' '+Msg
+  else
+    Mesg.Msg:=Msg;
   SendDebugMessage(Mesg);
   SendDebugMessage(Mesg);
 end;
 end;
 
 
@@ -184,7 +192,10 @@ Var
 begin
 begin
   Mesg.MsgTimeStamp:=Now;
   Mesg.MsgTimeStamp:=Now;
   Mesg.MsgType:=dmtInformation;
   Mesg.MsgType:=dmtInformation;
-  Mesg.Msg:=Format(Msg,Args);
+  if AlwaysDisplayPID then
+    Mesg.Msg:=IntToStr(GetProcessID)+' '+Format(Msg,Args)
+  else
+    Mesg.Msg:=Format(Msg,Args);
   SendDebugMessage(Mesg);
   SendDebugMessage(Mesg);
 end;
 end;
 
 
@@ -196,7 +207,10 @@ Var
 begin
 begin
   Mesg.MsgTimeStamp:=Now;
   Mesg.MsgTimeStamp:=Now;
   Mesg.MsgType:=ErrorLevel[mType];
   Mesg.MsgType:=ErrorLevel[mType];
-  Mesg.Msg:=Format(Msg,Args);
+  if AlwaysDisplayPID then
+    Mesg.Msg:=IntToStr(GetProcessID)+' '+Format(Msg,Args)
+  else
+    Mesg.Msg:=Format(Msg,Args);
   SendDebugMessage(Mesg);
   SendDebugMessage(Mesg);
 end;
 end;
 
 
@@ -247,7 +261,7 @@ begin
       begin
       begin
       Msg.MsgType:=lctStop;
       Msg.MsgType:=lctStop;
       Msg.MsgTimeStamp:=Now;
       Msg.MsgTimeStamp:=Now;
-      Msg.Msg:=Format(SProcessID,[ApplicationName]);
+      Msg.Msg:=Format(SProcessID,[ApplicationName, GetProcessID]);
       WriteMessage(Msg);
       WriteMessage(Msg);
       end;
       end;
     if assigned(MsgBuffer) then FreeAndNil(MsgBuffer);
     if assigned(MsgBuffer) then FreeAndNil(MsgBuffer);
@@ -261,7 +275,7 @@ Function InitDebugClient : Boolean;
 Var
 Var
   msg : TDebugMessage;
   msg : TDebugMessage;
   I : Integer;
   I : Integer;
-  
+
 begin
 begin
   Result := False;
   Result := False;
   DebugClient:=TSimpleIPCClient.Create(Nil);
   DebugClient:=TSimpleIPCClient.Create(Nil);
@@ -294,11 +308,17 @@ begin
   MsgBuffer:=TMemoryStream.Create;
   MsgBuffer:=TMemoryStream.Create;
   Msg.MsgType:=lctIdentify;
   Msg.MsgType:=lctIdentify;
   Msg.MsgTimeStamp:=Now;
   Msg.MsgTimeStamp:=Now;
-  Msg.Msg:=Format(SProcessID,[ApplicationName]);
+  Msg.Msg:=Format(SProcessID,[ApplicationName, GetProcessID]);
   WriteMessage(Msg);
   WriteMessage(Msg);
   Result := True;
   Result := True;
 end;
 end;
 
 
+function InitDebugClient(const ShowOrNotPID: Boolean): Boolean;
+begin
+  AlwaysDisplayPID:= ShowOrNotPID;
+  Result:= InitDebugClient;
+end;
+
 Finalization
 Finalization
   FreeDebugClient;
   FreeDebugClient;
 end.
 end.