1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
{
Make sure to set your project's options with, CompilerOptions --> Target "-o" -->Filename Value="fpcdebugserver",
i.e. the executable name must be the same as the client's const named dbugmsg.DebugServerID.
}
program dbugsrv;
{$MODE OBJFPC}
{$H+}
{$APPTYPE CONSOLE}
uses
classes,SysUtils,simpleipc,dbugmsg,strutils;
Type
{ THelperToWrite }
THelperToWrite = class
private
Class var StrLogFilename: string;
Class procedure WriteLnAllParams;
Class procedure InitParamsDependencies;
{ methods which override standard Write and WriteLn of the console output }
Class procedure DoWrite(const aBuffer: string);
Class procedure DoWrite(var aBuffer: string; const aMinimumFieldWidthIndent: integer); overload;
Class procedure DoWriteLn(const aBuffer: string);
{ methods which write in a log file, too }
Class procedure WriteNowThisLineInLog(aBuffer: string);
Class procedure WriteLnNowThisLineInLog(aBuffer: string);
Class function ReplaceSpecialCharsInLog(const aBuffer: string): string;
public
end;
Var
Srv : TSimpleIPCServer;
Msg : TDebugMessage;
StrBuffer : string = '';
ObjFileStream : TFileStream = Nil;
class procedure THelperToWrite.WriteLnAllParams;
Var
iNumParam: integer;
sBuffer: string;
begin
sBuffer := 'ParamCount='+IntToStr(ParamCount)+LineEnding;
for iNumParam := 0 to ParamCount do
sBuffer := IfThen(iNumParam<>ParamCount, sBuffer+'ParamStr('+IntToStr(iNumParam)+') = "'+ParamStr(iNumParam)+'"'+LineEnding, sBuffer+'ParamStr('+IntToStr(iNumParam)+') = "'+ParamStr(iNumParam)+'"');
THelperToWrite.DoWriteLn(sBuffer);
end;
class procedure THelperToWrite.InitParamsDependencies;
begin
If (ParamCount<>0) then
if ParamStr(1)<>'' then begin {ord. params: 1st is a log filename}
THelperToWrite.StrLogFilename:= ParamStr(1);
ObjFileStream:= TFileStream.Create(THelperToWrite.StrLogFilename, fmCreate or fmOpenWrite or fmShareDenyWrite);
ObjFileStream.Position:= 0;
end;
end;
class procedure THelperToWrite.DoWrite(const aBuffer: string);
begin
Write(aBuffer);
if Assigned(ObjFileStream) then THelperToWrite.WriteNowThisLineInLog(StrBuffer);
end;
class procedure THelperToWrite.DoWrite(var aBuffer: string; const aMinimumFieldWidthIndent: integer);
begin
Write(aBuffer:aMinimumFieldWidthIndent,' ');
if Assigned(ObjFileStream) then THelperToWrite.WriteNowThisLineInLog(StrBuffer);
end;
class procedure THelperToWrite.DoWriteLn(const aBuffer: string);
begin
WriteLn(aBuffer);
if Assigned(ObjFileStream) then THelperToWrite.WriteLnNowThisLineInLog(aBuffer+LineEnding)
end;
class procedure THelperToWrite.WriteNowThisLineInLog(aBuffer: string);
var
sBuffer: string;
begin
sBuffer:= THelperToWrite.ReplaceSpecialCharsInLog(aBuffer);
ObjFileStream.Write(sBuffer[1],length(sBuffer));
end;
class procedure THelperToWrite.WriteLnNowThisLineInLog(aBuffer: string);
var
sBuffer: string;
begin
aBuffer:= ' '{sep. each field of the msg-record}+aBuffer+LineEnding;
sBuffer:= THelperToWrite.ReplaceSpecialCharsInLog(aBuffer);
ObjFileStream.Write(sBuffer[1],length(sBuffer));
end;
class function THelperToWrite.ReplaceSpecialCharsInLog(const aBuffer: string): string;
begin
Result := StringsReplace(aBuffer, [LineEnding+LineEnding], [LineEnding], [rfReplaceAll]);
end;
ResourceString
SWelcomeOnSrv = 'IPC server started. Listening for debug messages:';
begin
Srv:=TSimpleIPCServer.Create(Nil);
Try
Srv.ServerID:=DebugServerID;
Srv.Global:=True;
Srv.Active:=True;
Srv.StartServer;
THelperToWrite.InitParamsDependencies;
THelperToWrite.WriteLnAllParams;
StrBuffer:=SWelcomeOnSrv;
THelperToWrite.DoWriteLn(StrBuffer);
Repeat
If Srv.PeekMessage(1,True) then
begin
Srv.MsgData.Seek(0,soFrombeginning);
ReadDebugMessageFromStream(Srv.MsgData,MSg);
StrBuffer:=FormatDateTime('hh:nn:ss.zzz',Msg.MsgTimeStamp)+': ';
THelperToWrite.DoWrite(StrBuffer);
StrBuffer:=DebugMessageName(MSg.MsgType);
THelperToWrite.DoWrite(StrBuffer,12);
StrBuffer:=Msg.Msg;
THelperToWrite.DoWriteLn(StrBuffer);
end
else
Sleep(10);
Until False;
Finally
if Assigned(ObjFileStream) then
ObjFileStream.Free;
Srv.Free;
end;
end.
|
