Changeset 119 for Comm/USerialPort.pas
- Timestamp:
- Jan 5, 2011, 1:16:30 PM (14 years ago)
- Location:
- Comm
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
Comm
-
Property svn:ignore
set to
lib
-
Property svn:ignore
set to
-
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.