1 | unit UCommFrame;
|
---|
2 |
|
---|
3 | {$mode Delphi}{$H+}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, Dialogs, SysUtils, SpecializedList, UBinarySerializer,
|
---|
9 | UCommPin;
|
---|
10 |
|
---|
11 | type
|
---|
12 | TFrameState = (fsOutside, fsStart, fsInside, fsEnd);
|
---|
13 |
|
---|
14 | { TCommFrame }
|
---|
15 |
|
---|
16 | TCommFrame = class(TCommNode)
|
---|
17 | private
|
---|
18 | LastCharIsSpecialChar: Boolean;
|
---|
19 | ReceiveBuffer: TBinarySerializer;
|
---|
20 | FrameState: TFrameState;
|
---|
21 | FFrameErrorCount: Integer;
|
---|
22 | FCRCErrorCount: Integer;
|
---|
23 | function GetStreamCRC8(Stream: TListByte): Byte;
|
---|
24 | procedure RawDataReceive(Sender: TCommPin; Stream: TListByte);
|
---|
25 | procedure RawSetStatus(Sender: TCommPin; Status: Integer);
|
---|
26 | procedure FrameDataReceive(Sender: TCommPin; Stream: TListByte);
|
---|
27 | procedure FrameSetStatus(Sender: TCommPin; Status: Integer);
|
---|
28 | public
|
---|
29 | RawDataPin: TCommPin;
|
---|
30 | FrameDataPin: TCommPin;
|
---|
31 | PacketLoss: Real;
|
---|
32 | SpecialChar: Byte;
|
---|
33 | ControlCodeFrameStart: Byte;
|
---|
34 | ControlCodeFrameEnd: Byte;
|
---|
35 | ControlCodeSpecialChar: Byte;
|
---|
36 | function ComputeRawSize(DataStream: TListByte): Integer;
|
---|
37 | constructor Create(AOwner: TComponent); override;
|
---|
38 | destructor Destroy; override;
|
---|
39 | property FrameErrorCount: Integer read FFrameErrorCount;
|
---|
40 | property CRCErrorCount: Integer read FCRCErrorCount;
|
---|
41 | end;
|
---|
42 |
|
---|
43 |
|
---|
44 | implementation
|
---|
45 |
|
---|
46 | { TCommFrame }
|
---|
47 |
|
---|
48 | constructor TCommFrame.Create(AOwner: TComponent);
|
---|
49 | begin
|
---|
50 | inherited;
|
---|
51 | ReceiveBuffer := TBinarySerializer.Create;
|
---|
52 | ReceiveBuffer.List := TListByte.Create;
|
---|
53 | ReceiveBuffer.OwnsList := True;
|
---|
54 | RawDataPin := TCommPin.Create;
|
---|
55 | RawDataPin.OnReceive := RawDataReceive;
|
---|
56 | RawDataPin.Node := Self;
|
---|
57 | FrameDataPin := TCommPin.Create;
|
---|
58 | FrameDataPin.OnReceive := FrameDataReceive;
|
---|
59 | FrameDataPin.Node := Self;
|
---|
60 | PacketLoss := 0;
|
---|
61 | SpecialChar := $fe;
|
---|
62 | ControlCodeFrameStart := $fd;
|
---|
63 | ControlCodeFrameEnd := $fc;
|
---|
64 | ControlCodeSpecialChar := $fb;
|
---|
65 | end;
|
---|
66 |
|
---|
67 | destructor TCommFrame.Destroy;
|
---|
68 | begin
|
---|
69 | FreeAndNil(RawDataPin);
|
---|
70 | FreeAndNil(FrameDataPin);
|
---|
71 | ReceiveBuffer.Free;
|
---|
72 | inherited;
|
---|
73 | end;
|
---|
74 |
|
---|
75 | procedure TCommFrame.FrameDataReceive(Sender: TCommPin; Stream: TListByte);
|
---|
76 | var
|
---|
77 | RawData: TBinarySerializer;
|
---|
78 | I: Integer;
|
---|
79 | Character: Byte;
|
---|
80 | CRC: Byte;
|
---|
81 | begin
|
---|
82 | // Write CRC code to end of frame
|
---|
83 | CRC := GetStreamCRC8(Stream);
|
---|
84 |
|
---|
85 | // Byte stuffing
|
---|
86 | try
|
---|
87 | RawData := TBinarySerializer.Create;
|
---|
88 | RawData.List := TListByte.Create;
|
---|
89 | RawData.OwnsList := True;
|
---|
90 | RawData.WriteByte(SpecialChar);
|
---|
91 | RawData.WriteByte(ControlCodeFrameStart);
|
---|
92 | for I := 0 to Stream.Count - 1 do begin
|
---|
93 | Character := Stream[I];
|
---|
94 | if Character = SpecialChar then begin
|
---|
95 | RawData.WriteByte(SpecialChar);
|
---|
96 | RawData.WriteByte(ControlCodeSpecialChar);
|
---|
97 | end else RawData.WriteByte(Character);
|
---|
98 | end;
|
---|
99 |
|
---|
100 | Character := CRC;
|
---|
101 | if Character = SpecialChar then begin
|
---|
102 | RawData.WriteByte(SpecialChar);
|
---|
103 | RawData.WriteByte(ControlCodeSpecialChar);
|
---|
104 | end else RawData.WriteByte(Character);
|
---|
105 |
|
---|
106 | RawData.WriteByte(SpecialChar);
|
---|
107 | RawData.WriteByte(ControlCodeFrameEnd);
|
---|
108 | if Random >= PacketLoss then
|
---|
109 | RawDataPin.Send(RawData.List);
|
---|
110 | finally
|
---|
111 | RawData.Free;
|
---|
112 | end;
|
---|
113 | end;
|
---|
114 |
|
---|
115 | procedure TCommFrame.FrameSetStatus(Sender: TCommPin; Status: Integer);
|
---|
116 | begin
|
---|
117 | RawDataPin.Status := Status;
|
---|
118 | end;
|
---|
119 |
|
---|
120 | function TCommFrame.ComputeRawSize(DataStream: TListByte): Integer;
|
---|
121 | var
|
---|
122 | I: Integer;
|
---|
123 | begin
|
---|
124 | Result := 5; // FrameStart + CRC + FrameEnd
|
---|
125 | for I := 0 to DataStream.Count - 1 do
|
---|
126 | if DataStream[I] = SpecialChar then Inc(Result, 2)
|
---|
127 | else Inc(Result, 1);
|
---|
128 | end;
|
---|
129 |
|
---|
130 | procedure TCommFrame.RawDataReceive(Sender: TCommPin; Stream: TListByte);
|
---|
131 | var
|
---|
132 | Character: Byte;
|
---|
133 | CRC: Byte;
|
---|
134 | ExpectedCRC: Byte;
|
---|
135 | I: Integer;
|
---|
136 | begin
|
---|
137 | for I := 0 to Stream.Count - 1 do begin
|
---|
138 | Character := Stream[I];
|
---|
139 | if LastCharIsSpecialChar then begin
|
---|
140 | if Character = ControlCodeSpecialChar then begin
|
---|
141 | ReceiveBuffer.WriteByte(SpecialChar)
|
---|
142 | end else
|
---|
143 | if Character = ControlCodeFrameStart then begin
|
---|
144 | if FrameState = fsInside then
|
---|
145 | Inc(FFrameErrorCount);
|
---|
146 | ReceiveBuffer.List.Count := 0;
|
---|
147 | ReceiveBuffer.Position := 0;
|
---|
148 | FrameState := fsInside;
|
---|
149 | end else
|
---|
150 | if Character = ControlCodeFrameEnd then begin
|
---|
151 | if FrameState = fsInside then begin
|
---|
152 | // Check CRC
|
---|
153 | if ReceiveBuffer.List.Count > 0 then begin
|
---|
154 | ReceiveBuffer.Position := ReceiveBuffer.List.Count - 1;
|
---|
155 | CRC := ReceiveBuffer.ReadByte;
|
---|
156 | ReceiveBuffer.List.Count := ReceiveBuffer.List.Count - 1;
|
---|
157 | ExpectedCRC := GetStreamCRC8(ReceiveBuffer.List);
|
---|
158 |
|
---|
159 | if ExpectedCRC <> CRC then Inc(FCRCErrorCount)
|
---|
160 | else begin
|
---|
161 | //if Random >= PacketLoss then
|
---|
162 | FrameDataPin.Send(ReceiveBuffer.List);
|
---|
163 | end;
|
---|
164 | end else Inc(FCRCErrorCount);
|
---|
165 | end else Inc(FFrameErrorCount);
|
---|
166 | FrameState := fsOutside;
|
---|
167 | end;
|
---|
168 | LastCharIsSpecialChar := False;
|
---|
169 | end else begin
|
---|
170 | if Character = SpecialChar then LastCharIsSpecialChar := True
|
---|
171 | else ReceiveBuffer.WriteByte(Character);
|
---|
172 | end;
|
---|
173 | end;
|
---|
174 | end;
|
---|
175 |
|
---|
176 | procedure TCommFrame.RawSetStatus(Sender: TCommPin; Status: Integer);
|
---|
177 | begin
|
---|
178 | FrameDataPin.Status := Status;
|
---|
179 | end;
|
---|
180 |
|
---|
181 | function TCommFrame.GetStreamCRC8(Stream: TListByte): Byte;
|
---|
182 | var
|
---|
183 | I: Integer;
|
---|
184 | B: Integer;
|
---|
185 | Pom: Byte;
|
---|
186 | const
|
---|
187 | Polynom: Byte = $18;
|
---|
188 | begin
|
---|
189 | Pom := 0;
|
---|
190 | Result := 0;
|
---|
191 | for I := 0 to Stream.Count - 1 do begin
|
---|
192 | Pom := Stream[I];
|
---|
193 | for B := 0 to 7 do begin
|
---|
194 | if ((Result xor Pom) and 1) = 1 then
|
---|
195 | Result := ((Result xor Polynom) shr 1) or $80
|
---|
196 | else Result := Result shr 1;
|
---|
197 | Pom := (Pom shr 1) or ((Pom shl 7) and $80); // Rotace vpravo
|
---|
198 | end;
|
---|
199 | end;
|
---|
200 | end;
|
---|
201 |
|
---|
202 |
|
---|
203 | end.
|
---|