- Timestamp:
- Jan 5, 2011, 1:16:30 PM (14 years ago)
- Location:
- Comm
- Files:
-
- 6 added
- 1 deleted
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
Comm
-
Property svn:ignore
set to
lib
-
Property svn:ignore
set to
-
Comm/UCommFrame.pas
r26 r119 6 6 7 7 uses 8 Classes, U MemoryStreamEx, Dialogs, SysUtils,9 Forms,UCommPin;8 Classes, UStreamHelper, Dialogs, SysUtils, 9 UCommPin; 10 10 11 11 const … … 22 22 private 23 23 LastCharIsSpecialChar: Boolean; 24 ReceiveBuffer: T MemoryStreamEx;24 ReceiveBuffer: TStreamHelper; 25 25 FrameState: TFrameState; 26 26 FFrameErrorCount: Integer; … … 31 31 FrameDataPin: TCommPin; 32 32 PacketLoss: Real; 33 procedure RawDataReceive(S tream: TStream);34 procedure FrameDataReceive(S tream: TStream);33 procedure RawDataReceive(Sender: TCommPin; Stream: TStream); 34 procedure FrameDataReceive(Sender: TCommPin; Stream: TStream); 35 35 constructor Create; 36 36 destructor Destroy; override; … … 46 46 constructor TCommFrame.Create; 47 47 begin 48 ReceiveBuffer := T MemoryStreamEx.Create;48 ReceiveBuffer := TStreamHelper.Create; 49 49 RawDataPin := TCommPin.Create; 50 50 RawDataPin.OnReceive := RawDataReceive; … … 62 62 end; 63 63 64 procedure TCommFrame.FrameDataReceive(S tream: TStream);64 procedure TCommFrame.FrameDataReceive(Sender: TCommPin; Stream: TStream); 65 65 var 66 RawData: T MemoryStreamEx;66 RawData: TStreamHelper; 67 67 I: Integer; 68 68 Character: Byte; … … 75 75 // Byte stuffing 76 76 Stream.Position := 0; 77 RawData := TMemoryStreamEx.Create; 78 RawData.WriteByte(SpecialChar); 79 RawData.WriteByte(ControlCodeFrameStart); 80 for I := 0 to Stream.Size - 1 do begin 81 Character := TMemoryStreamEx(Stream).ReadByte; 77 try 78 RawData := TStreamHelper.Create; 79 RawData.WriteByte(SpecialChar); 80 RawData.WriteByte(ControlCodeFrameStart); 81 for I := 0 to Stream.Size - 1 do begin 82 Character := Stream.ReadByte; 83 if Character = SpecialChar then begin 84 RawData.WriteByte(SpecialChar); 85 RawData.WriteByte(ControlCodeSpecialChar); 86 end else RawData.WriteByte(Character); 87 end; 88 89 Character := CRC; 82 90 if Character = SpecialChar then begin 83 91 RawData.WriteByte(SpecialChar); 84 92 RawData.WriteByte(ControlCodeSpecialChar); 85 93 end else RawData.WriteByte(Character); 94 95 RawData.WriteByte(SpecialChar); 96 RawData.WriteByte(ControlCodeFrameEnd); 97 //if Random >= PacketLoss then 98 RawDataPin.Send(RawData); 99 100 finally 101 RawData.Free; 86 102 end; 87 88 Character := CRC;89 if Character = SpecialChar then begin90 RawData.WriteByte(SpecialChar);91 RawData.WriteByte(ControlCodeSpecialChar);92 end else RawData.WriteByte(Character);93 94 RawData.WriteByte(SpecialChar);95 RawData.WriteByte(ControlCodeFrameEnd);96 //if Random >= PacketLoss then97 RawDataPin.Send(RawData);98 RawData.Free;99 103 end; 100 104 101 procedure TCommFrame.RawDataReceive(S tream: TStream);105 procedure TCommFrame.RawDataReceive(Sender: TCommPin; Stream: TStream); 102 106 var 103 107 Character: Byte; … … 107 111 begin 108 112 for I := 0 to Stream.Size - 1 do begin 109 Character := TMemoryStreamEx(Stream).ReadByte;113 Character := Stream.ReadByte; 110 114 if LastCharIsSpecialChar then begin 111 115 if Character = ControlCodeSpecialChar then begin … … 115 119 if FrameState = fsInside then 116 120 Inc(FFrameErrorCount); 117 ReceiveBuffer. Clear;121 ReceiveBuffer.Size := 0; 118 122 FrameState := fsInside; 119 123 end else … … 123 127 if ReceiveBuffer.Size > 0 then begin 124 128 ReceiveBuffer.Position := ReceiveBuffer.Size - 1; 125 CRC := TMemoryStreamEx(ReceiveBuffer).ReadByte;129 CRC := ReceiveBuffer.ReadByte; 126 130 ReceiveBuffer.Size := ReceiveBuffer.Size - 1; 127 131 ExpectedCRC := GetStreamCRC8(ReceiveBuffer); -
Comm/UCommPin.pas
r26 r119 9 9 10 10 type 11 TCommPin = class; 12 11 13 TDataDiretion = (ddReceive, ddSend); 12 14 TOnLogDataEvent = procedure (Stream: TStream; Direction: TDataDiretion) of object; 13 TOnStreamEvent = procedure (S tream: TStream) of object;15 TOnStreamEvent = procedure (Sender: TCommPin; Stream: TStream) of object; 14 16 15 17 { TCommPin } … … 19 21 FOnLogData: TOnLogDataEvent; 20 22 FOnReceive: TOnStreamEvent; 23 FDataTxCount: Integer; 24 FDataRxCount: Integer; 25 FFrameTxCount: Integer; 26 FFrameRxCount: Integer; 21 27 function GetConnected: Boolean; 22 28 public 23 29 RemotePin: TCommPin; 30 constructor Create; 24 31 destructor Destroy; override; 25 32 procedure Connect(Pin: TCommPin); … … 27 34 procedure Send(Stream: TStream); 28 35 procedure Receive(Stream: TStream); 36 procedure ResetCounters; 29 37 property OnReceive: TOnStreamEvent read FOnReceive write FOnReceive; 30 38 property Connected: Boolean read GetConnected; 31 39 property OnLogData: TOnLogDataEvent read FOnLogData write FOnLogData; 40 property DataTxCount: Integer read FDataTxCount; 41 property DataRxCount: Integer read FDataRxCount; 42 property FrameTxCount: Integer read FFrameTxCount; 43 property FrameRxCount: Integer read FFrameRxCount; 32 44 end; 33 45 … … 63 75 end; 64 76 77 constructor TCommPin.Create; 78 begin 79 RemotePin := nil; 80 end; 81 65 82 procedure TCommPin.Receive(Stream: TStream); 66 83 begin 84 Inc(FDataRxCount, Stream.Size); 85 Inc(FFrameRxCount); 67 86 if Assigned(FOnLogData) then FOnLogData(Stream, ddReceive); 68 87 Stream.Position := 0; 69 if Assigned(FOnReceive) then FOnReceive(Stream); 88 if Assigned(FOnReceive) then FOnReceive(Self, Stream); 89 end; 90 91 procedure TCommPin.ResetCounters; 92 begin 93 FDataTxCount := 0; 94 FDataRxCount := 0; 95 FFrameTxCount := 0; 96 FFrameRxCount := 0; 70 97 end; 71 98 72 99 procedure TCommPin.Send(Stream: TStream); 73 100 begin 101 Inc(FDataTxCount, Stream.Size); 102 Inc(FFrameTxCount); 74 103 if Assigned(FOnLogData) then FOnLogData(Stream, ddSend); 75 104 if Assigned(RemotePin) then RemotePin.Receive(Stream); -
Comm/UCommSerialPort.pas
r31 r119 11 11 TCommSerialPort = class(TSerialPort) 12 12 private 13 FTxCount: Integer; 14 FRxCount: Integer; 15 procedure Receive(Stream: TStream); 13 procedure Receive(Sender: TCommPin; Stream: TStream); 16 14 procedure ReceiveData(Stream: TMemoryStream); 17 15 public 18 DataPin: TCommPin;16 Pin: TCommPin; 19 17 destructor Destroy; override; 20 18 constructor Create; 21 property TxCount: Integer read FTxCount;22 property RxCount: Integer read FRxCount;23 19 end; 24 20 … … 31 27 procedure TCommSerialPort.ReceiveData(Stream: TMemoryStream); 32 28 begin 33 Inc(FRxCount, Stream.Size); 34 DataPin.Send(Stream); 29 Pin.Send(Stream); 35 30 end; 36 31 … … 38 33 begin 39 34 inherited; 40 DataPin := TCommPin.Create;41 DataPin.OnReceive := Receive;35 Pin := TCommPin.Create; 36 Pin.OnReceive := Receive; 42 37 OnReceiveData := ReceiveData; 43 38 end; … … 46 41 begin 47 42 OnReceiveData := nil; 48 DataPin.Destroy;43 Pin.Free; 49 44 inherited; 50 45 end; 51 46 52 procedure TCommSerialPort.Receive(S tream: TStream);47 procedure TCommSerialPort.Receive(Sender: TCommPin; Stream: TStream); 53 48 begin 54 Inc(FTxCount, Stream.Size);55 49 Stream.Position := 0; 56 50 repeat -
Comm/UPacketBurst.pas
r35 r119 1 1 unit UPacketBurst; 2 3 {$mode Delphi}{$H+} 2 4 3 5 interface 4 6 5 7 uses 6 Classes, CommPort, UPin, UMemoryStreamEx, SyncObjs;8 Classes, UCommPin, SyncObjs, UStreamHelper; 7 9 8 10 type … … 19 21 SendThread: TPacketBurstSendThread; 20 22 SendStreamLock: TCriticalSection; 21 SendStream: T MemoryStreamEx;22 ReceiveStream: T MemoryStreamEx;23 procedure PacketSingleReceive(S tream: TStream);24 procedure PacketBurstReceive(S tream: TStream);23 SendStream: TStreamHelper; 24 ReceiveStream: TStreamHelper; 25 procedure PacketSingleReceive(Sender: TCommPin; Stream: TStream); 26 procedure PacketBurstReceive(Sender: TCommPin; Stream: TStream); 25 27 public 26 28 SendPeriod: Integer; // ms 27 29 SendBurstSize: Integer; 28 PacketSinglePin: T Pin;29 PacketBurstPin: T Pin;30 PacketSinglePin: TCommPin; 31 PacketBurstPin: TCommPin; 30 32 destructor Destroy; override; 31 33 constructor Create; … … 38 40 constructor TPacketBurst.Create; 39 41 begin 40 PacketSinglePin := T Pin.Create;42 PacketSinglePin := TCommPin.Create; 41 43 PacketSinglePin.OnReceive := PacketSingleReceive; 42 PacketBurstPin := T Pin.Create;44 PacketBurstPin := TCommPin.Create; 43 45 PacketBurstPin.OnReceive := PacketBurstReceive; 44 46 SendThread := TPacketBurstSendThread.Create(True); 45 47 SendThread.PacketBurst := Self; 46 SendThread. Resume;48 SendThread.Start; 47 49 end; 48 50 … … 55 57 end; 56 58 57 procedure TPacketBurst.PacketBurstReceive(S tream: TStream);59 procedure TPacketBurst.PacketBurstReceive(Sender: TCommPin; Stream: TStream); 58 60 var 59 PacketStream: T MemoryStreamEx;61 PacketStream: TStreamHelper; 60 62 Size: Word; 61 63 begin 62 PacketStream := TMemoryStreamEx.Create; 63 ReceiveStream.Seek(0, soFromEnd); 64 ReceiveStream.WriteStream(Stream); 65 ReceiveStream.Position := 0; 66 Size := ReceiveStream.ReadWord; 67 while Size < ReceiveStream.Size do begin 68 PacketStream.Clear; 69 PacketStream.ReadStream(TStream(ReceiveStream), Size); 70 PacketSinglePin.Send(PacketStream); 64 try 65 PacketStream := TStreamHelper.Create; 66 ReceiveStream.Seek(0, soFromEnd); 67 ReceiveStream.WriteStream(Stream, Stream.Size); 68 ReceiveStream.Position := 0; 71 69 Size := ReceiveStream.ReadWord; 70 while Size < ReceiveStream.Size do begin 71 PacketStream.Stream.Size := 0; 72 PacketStream.ReadStream(TStream(ReceiveStream), Size); 73 PacketSinglePin.Send(PacketStream); 74 Size := ReceiveStream.ReadWord; 75 end; 76 finally 77 PacketStream.Free; 72 78 end; 73 PacketStream.Free;74 79 end; 75 80 76 procedure TPacketBurst.PacketSingleReceive(S tream: TStream);81 procedure TPacketBurst.PacketSingleReceive(Sender: TCommPin; Stream: TStream); 77 82 var 78 83 SignalEvent: Boolean; 79 84 begin 80 SendStreamLock.Acquire; 81 SendStream.WriteWord(Stream.Size); 82 Stream.Position := 0; 83 SendStream.WriteStream(Stream); 84 SignalEvent := SendStream.Size > SendBurstSize; 85 SendStreamLock.Release; 85 try 86 SendStreamLock.Acquire; 87 SendStream.WriteWord(Stream.Size); 88 Stream.Position := 0; 89 SendStream.WriteStream(Stream, Stream.Size); 90 SignalEvent := SendStream.Size > SendBurstSize; 91 finally 92 SendStreamLock.Release; 93 end; 86 94 if SignalEvent then SendThreadEvent.SetEvent; 87 95 end; … … 91 99 procedure TPacketBurstSendThread.Execute; 92 100 var 93 Stream: T MemoryStreamEx;101 Stream: TStreamHelper; 94 102 begin 95 103 inherited; 96 Stream := TMemoryStreamEx.Create; 97 with PacketBurst do 98 repeat 99 if SendThreadEvent.WaitFor(SendPeriod) = wrSignaled then begin 100 SendStreamLock.Acquire; 101 SendStream.Position := 0; 102 if SendStream.Size < SendBurstSize then begin 103 PacketBurstPin.Send(SendStream); 104 SendStream.Clear; 105 end else 106 while (SendStream.Size - SendStream.Position) > SendBurstSize do begin 107 Stream.Clear; 108 SendStream.ReadStream(TStream(Stream), SendBurstSize); 109 PacketBurstPin.Send(Stream); 104 try 105 Stream := TStreamHelper.Create; 106 with PacketBurst do 107 repeat 108 if SendThreadEvent.WaitFor(SendPeriod) = wrSignaled then 109 try 110 SendStreamLock.Acquire; 111 SendStream.Position := 0; 112 if SendStream.Size < SendBurstSize then begin 113 PacketBurstPin.Send(SendStream); 114 SendStream.Stream.Size := 0; 115 end else 116 while (SendStream.Size - SendStream.Position) > SendBurstSize do begin 117 Stream.Stream.Size := 0; 118 SendStream.ReadStream(TStream(Stream), SendBurstSize); 119 PacketBurstPin.Send(Stream); 120 end; 121 finally 122 SendStreamLock.Release; 110 123 end; 111 SendStreamLock.Release;112 end;113 until Terminated;114 Stream.Free;124 until Terminated; 125 finally 126 Stream.Free; 127 end; 115 128 end; 116 129 -
Comm/USerialPort.pas
r31 r119 6 6 7 7 uses 8 Classes, SysUtils, SynaSer, StdCtrls, Windows,Dialogs;8 Classes, SysUtils, SynaSer, StdCtrls, Dialogs; 9 9 10 10 type … … 24 24 TSerialPortReceiveThread = class(TThread) 25 25 Parent: TSerialPort; 26 Stream: TMemoryStream;27 26 procedure Execute; override; 28 constructor Create(CreateSuspended: Boolean;29 const StackSize: SizeUInt = DefaultStackSize);30 27 destructor Destroy; override; 31 28 end; … … 46 43 FStopBits: TStopBits; 47 44 FReceiveThread: TSerialPortReceiveThread; 45 FReceiveBuffer: TMemoryStream; 48 46 function GetBaudRateNumeric: Integer; 49 47 function GetName: string; 50 function GetReceiveBuffer:TMemoryStream;51 48 procedure SetBaudRate(const AValue: TBaudRate); 52 49 procedure SetBaudRateNumeric(const AValue: Integer); … … 71 68 property RTS: Boolean read FRTS write SetRTS; 72 69 property DTR: Boolean read FDTR write SetDTR; 73 property ReceiveBuffer: TMemoryStream read GetReceiveBuffer;70 property ReceiveBuffer: TMemoryStream read FReceiveBuffer; 74 71 75 72 property BaudRateNumeric: Integer read GetBaudRateNumeric write SetBaudRateNumeric; … … 88 85 implementation 89 86 87 resourcestring 88 SAssignmentError = 'Assignment error'; 89 SWrongNumericBaudRate = 'Wrong numeric baud rate %s'; 90 SWrongDataBitsNumber = 'Wrong data bits number %s'; 91 90 92 { TSerialPort } 91 93 … … 95 97 FActive := True; 96 98 Open; 97 FActive := FHandle <> INVALID_HANDLE_VALUE 99 FActive := FHandle <> INVALID_HANDLE_VALUE; 100 if not FActive then FreeAndNil(FReceiveThread); 98 101 end else 99 102 if FActive and not AValue then begin … … 137 140 begin 138 141 Connect(FName); 142 //set_fDtrControl(DCB, 1); 143 //DCB.flags := ; 139 144 SetBaudRate(FBaudRate); 140 145 SetParity(FParity); … … 144 149 SetDTR(FDTR); 145 150 SetRTS(FRTS); 151 152 FReceiveThread := TSerialPortReceiveThread.Create(True); 153 FReceiveThread.FreeOnTerminate := False; 154 FReceiveThread.Parent := Self; 155 FReceiveThread.Start; 146 156 end; 147 157 148 158 procedure TSerialPort.Close; 149 159 begin 160 FreeAndNil(FReceiveThread); 150 161 CloseSocket; 151 162 end; … … 154 165 begin 155 166 inherited Create; 167 FReceiveBuffer := TMemoryStream.Create; 156 168 FBaudRate := br9600; 157 169 FName := 'COM1'; … … 163 175 FRTS := False; 164 176 Active := False; 165 166 FReceiveThread := TSerialPortReceiveThread.Create(True);167 FReceiveThread.FreeOnTerminate := False;168 FReceiveThread.Parent := Self;169 FReceiveThread.Resume;170 177 end; 171 178 172 179 destructor TSerialPort.Destroy; 173 180 begin 174 FReceiveThread.Terminate;175 FReceiveThread. WaitFor;176 FReceiveThread.Destroy;181 Active := False; 182 FReceiveThread.Free; 183 ReceiveBuffer.Free; 177 184 inherited Destroy; 178 185 end; … … 189 196 DTR := TSerialPort(Source).DTR; 190 197 RTS := TSerialPort(Source).RTS; 191 end else raise Exception.Create( 'Assignment error');198 end else raise Exception.Create(SAssignmentError); 192 199 end; 193 200 … … 210 217 begin 211 218 Result := FName; 212 end;213 214 function TSerialPort.GetReceiveBuffer:TMemoryStream;215 begin216 Result := FReceiveThread.Stream;217 219 end; 218 220 … … 235 237 128000: BaudRate := br128000; 236 238 256000: BaudRate := br256000; 237 else raise Exception.Create ('Wrong numeric baud rate');239 else raise Exception.CreateFmt(SWrongNumericBaudRate, [AValue]); 238 240 end; 239 241 end; … … 242 244 begin 243 245 if (AValue >= 5) and (AValue <= 8) then FDataBits := AValue 244 else raise Exception.Create ('Wrong data bits number');246 else raise Exception.CreateFmt(SWrongDataBitsNumber, [IntToStr(AValue)]); 245 247 if FActive then begin 246 248 GetCommState; … … 253 255 begin 254 256 FDTR := AValue; 255 if FActive then SetDTRF(FDTR); 257 if FFlowControl = fcNone then 258 DCB.flags := DCB.flags and (not (dcb_DtrControlEnable * 3)) or 259 (dcb_DtrControlEnable * Byte(AValue)); 260 if FActive then begin 261 if FFlowControl = fcNone then SetCommState 262 else SetDTRF(FDTR); 263 end; 256 264 end; 257 265 … … 263 271 case AValue of 264 272 fcNone: DCB.flags := 0; 265 fcSoftware: DCB.flags := DCB.Flags or dcb_OutX or dcb_InX;266 fcHardware: DCB.flags := DCB.Flags267 ordcb_OutxCtsFlow or dcb_OutxDsrFlow268 or dcb_DtrControlHandshake 273 fcSoftware: DCB.flags := dcb_OutX or dcb_InX or 274 dcb_DtrControlEnable or dcb_RtsControlEnable; 275 fcHardware: DCB.flags := dcb_OutxCtsFlow or dcb_OutxDsrFlow 276 or dcb_DtrControlHandshake or dcb_RtsControlHandshake; 269 277 end; 270 278 SetCommState; … … 280 288 begin 281 289 InBufferUsed := 0; 282 with Parent do 283 repeat 284 if InBufferUsed = 0 then Sleep(1); 285 if Active then begin 286 InBufferUsed := WaitingData; 287 if InBufferUsed > 0 then begin 288 SetLength(Buffer, InBufferUsed); 289 RecvBuffer(Buffer, Length(Buffer)); 290 291 Stream.Size := Length(Buffer); 292 Stream.Position := 0; 293 Stream.Write(Buffer[0], Length(Buffer)); 294 if Assigned(Parent.FOnReceiveData) then 295 Parent.FOnReceiveData(Stream); 290 with Parent do repeat 291 try 292 if InBufferUsed = 0 then Sleep(1); 293 if Active then begin 294 InBufferUsed := WaitingData; 295 if InBufferUsed > 0 then begin 296 SetLength(Buffer, InBufferUsed); 297 RecvBuffer(Buffer, Length(Buffer)); 298 299 Parent.FReceiveBuffer.Size := Length(Buffer); 300 Parent.FReceiveBuffer.Position := 0; 301 Parent.FReceiveBuffer.Write(Buffer[0], Length(Buffer)); 302 if Assigned(Parent.FOnReceiveData) then 303 Parent.FOnReceiveData(Parent.FReceiveBuffer); 304 end else InBufferUsed := 0; 296 305 end else InBufferUsed := 0; 297 end else InBufferUsed := 0; 306 except 307 on E: Exception do 308 //MainForm.ExceptionLogger1.ThreadExceptionHandler(Self, E); 309 end; 298 310 until Terminated; 299 311 end; 300 312 301 constructor TSerialPortReceiveThread.Create(CreateSuspended: Boolean; 302 const StackSize: SizeUInt); 313 destructor TSerialPortReceiveThread.Destroy; 303 314 begin 304 315 inherited; 305 Stream := TMemoryStream.Create;306 end;307 308 destructor TSerialPortReceiveThread.Destroy;309 begin310 Stream.Destroy;311 inherited;312 316 end; 313 317
Note:
See TracChangeset
for help on using the changeset viewer.