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
|
{
fpGUI - Free Pascal GUI Toolkit
Copyright (C) 2005 by Michael Van Canneyt, member of
the Free Pascal development team
Copyright (C) 2013 by Graeme Geldenhuys
See the file COPYING.modifiedLGPL, included in this distribution,
for details about redistributing fpGUI.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
Description:
Originally from the Free Pascal FCL. Since then the code has
diverged and was customised for fpGUI usage.
}
unit fpg_dbugmsg;
{$mode objfpc}{$h+}
interface
uses Classes;
Const
DebugServerID : String = 'fpgDebugServer';
Type
TDebugMessage = record
MsgType : Integer;
MsgTimeStamp : TDateTime;
MsgTitle : string;
Msg : string;
end;
Procedure ReadDebugMessageFromStream(AStream : TStream; Var Msg : TDebugMessage);
Procedure WriteDebugMessageToStream(AStream : TStream; Const Msg : TDebugMessage);
implementation
procedure ReadDebugMessageFromStream(AStream : TStream; Var Msg : TDebugMessage);
var
MsgSize: Integer;
begin
MsgSize := 0;
with AStream do
begin
ReadBuffer(Msg.MsgType, SizeOf(Integer));
ReadBuffer(Msg.MsgTimeStamp, SizeOf(TDateTime));
ReadBuffer(MsgSize, SizeOf(Integer));
SetLength(Msg.MsgTitle, MsgSize);
if (MsgSize<>0) then
ReadBuffer(Msg.MsgTitle[1], MsgSize);
ReadBuffer(MsgSize, SizeOf(Integer));
SetLength(Msg.Msg, MsgSize);
if (MsgSize<>0) then
ReadBuffer(Msg.Msg[1], MsgSize);
end;
end;
procedure WriteDebugMessageToStream(AStream : TStream; Const Msg : TDebugMessage);
var
MsgSize : Integer;
lTitle: string;
begin
with AStream do
begin
WriteBuffer(Msg.MsgType, SizeOf(Integer));
WriteBuffer(Msg.MsgTimeStamp, SizeOf(TDateTime));
MsgSize := Length(Msg.MsgTitle);
if MsgSize = 0 then // fake a title
begin
MsgSize := 1;
lTitle := ' ';
end
else
lTitle := Msg.MsgTitle;
WriteBuffer(MsgSize, SizeOf(Integer));
WriteBuffer(lTitle[1], MsgSize);
MsgSize := Length(Msg.Msg);
WriteBuffer(MsgSize, SizeOf(Integer));
WriteBuffer(Msg.Msg[1], MsgSize);
end;
end;
end.
|