1 unit uSerialPort;
2
3 { 串口
4 ---------
5 NOTE
6 从行为上来看, 这个串口类的读写貌似是阻塞的, 所以使用 Overlapped 有必要么,
7 如果需要非阻塞的行为, 需要怎样组织呢
8
9 没有对 C# 中的 Handshake 作处理, 所有注意到的与 Handshake 有关的地方都按None处理
10 也有其他地方按默认值处理的, 但忘了有哪些了
11 目前在端口 Open 状态时, 修改波特率什么的没效果, C# 中这些常用参数看上去是可以修改的
12 还忽略了许多其他事情, 需要具体对比 C# 才知道还有哪些
13 仅使用 USB-RS485 转换器测试收发了 10 几个字节,
14 所以仅能在玩具程序中使用, 要想能够真正的使用还有很长的路
15 ---------
16 TODO
17 关于 GetLastError 返回的结果, 至少做一下说明, 不然单纯的数字根本不知道发生了什么
18 ---------
19 Windows API 参考:
20 https://docs.microsoft.com/zh-cn/windows/win32/devio/communications-resources
21 https://docs.microsoft.com/zh-cn/windows/win32/api/fileapi/nf-fileapi-createfilea
22
23 关于 \\.\ 和 \\?\: https://docs.microsoft.com/zh-cn/windows/win32/fileio/naming-a-file
24 Namespaces 节的 Win32 Device Namespaces
25
26 同步和异步IO
27 https://docs.microsoft.com/zh-cn/windows/win32/fileio/synchronous-and-asynchronous-i-o
28
29 学习串口工具的编写请参阅:
30 https://github.com/dotnet/runtime/blob/master/src/libraries/System.IO.Ports/src/System/IO/Ports/SerialPort.cs
31 https://github.com/dotnet/runtime/blob/master/src/libraries/System.IO.Ports/src/System/IO/Ports/SerialStream.Windows.cs
32 }
33 interface
34
35 uses
36 System.Generics.Collections,
37 System.SysUtils,
38 WinApi.Windows;
39
40 type
41 TSerialPort = class
42 // 串口
43 // @Section private type
44 private
45 type TEventLoop = class
46 // 处理 WaitCommEvent
47 // TODO 这个事件循环现在什么都没做, 有空再处理
48 private
49 FHandle : THandle;
50 public
51 constructor Create(AHandle : THandle);
52 destructor Destroy; override;
53
54 procedure Start();
55 procedure Stop();
56 end;
57
58 // @Section public type
59
60 // @Section public const
61
62 // @Section private
63 private
64 FCommHandle : THandle; // 串口句柄
65
66 FCommName : String; // COM口名称 COM1
67 FBaudRate : Integer; // 波特率
68 FParity : Integer; // 奇偶校验
69 FDataBits : Integer; // 数据位
70 FStopBit : Integer; // 停止位
71
72 // 超时, 毫秒, 取值范围[0,MAX Integer], 如果设置为 0 表示不使用超时
73 FReadTimeOut : Integer;
74 FWriteTimeOut : Integer;
75
76 // 读写缓冲区大小
77 FReadBufferSize : Integer;
78 FWriteBufferSize : Integer;
79
80 FParityReplace : AnsiChar;
81
82 // TODO 考虑是否需要这些结构
83 // DCB TimeOuts 等结构
84 // FDcb : TDCB;
85 // FTimeouts : TCommTimeouts;
86
87 FEventLoop : TEventLoop;
88
89 // for property
90 procedure SetPropCommName(const ACommName : String);
91 procedure SetPropBaudRate(const ABaudRate : Integer);
92 procedure SetPropParity(const AParity : Integer);
93 procedure SetPropDataBits(const ADataBits : Integer);
94 procedure SetPropStopBit(const AStopBit : Integer);
95
96 procedure SetPropReadTimeOut(const ATimeOut : Integer);
97 procedure SetPropWriteTimeOut(const ATimeOut : Integer);
98
99 procedure SetPropReadBufferSize(const ASize : Integer);
100 procedure SetPropWriteBufferSize(const ASize : Integer);
101
102 // about comm config
103 procedure ConfigEvents();
104 procedure ConfigDCB(ACommProp : TCommProp);
105 procedure ConfigTimeouts();
106 procedure ConfigBufferSizes();
107
108 // about DCB.Flags
109 function GetDcbFlag(const ADcb : TDCB; AWhichFlag : Integer) : Integer;
110 procedure SetDcbFlag(var ADcb : TDCB; AWhichFlag : Integer; ASetting : Integer);
111
112 procedure SetHandleInvalid();
113 function IsInvalidHandle(const AHandle : THandle) : Boolean;
114
115 function CheckAndGetComNumber(const AComName : String) : Integer;
116 procedure CheckReadWriteArguments(const AArr : TArray<Byte>; const AOffset, ACount : Integer);
117
118 // @Section public
119 public
120 constructor Create(); overload;
121 constructor Create(const AComName : String); overload;
122 constructor Create(const AComName : String;
123 const ABaudRate, AParity, ADataBits, AStopBit : Integer); overload;
124
125 destructor Destroy(); override;
126
127 function IsOpen() : Boolean;
128
129 procedure Open();
130 procedure Close();
131
132 function ReadBytes(ABuff : TArray<Byte>; const AOffset, ACount : Integer) : Integer;
133 procedure WriteBytes(ABuff : TArray<Byte>; const AOffset, ACount : Integer);
134
135 property PortName : String read FCommName write SetPropCommName;
136 property BaudRate : Integer read FBaudRate write SetPropBaudRate;
137 property Parity : Integer read FParity write SetPropParity;
138 property DataBits : Integer read FDataBits write SetPropDataBits;
139 property StopBit : Integer read FStopBit write SetPropStopBit;
140
141 property ReadTimeOut : Integer read FReadTimeOut write SetPropReadTimeOut;
142 property WriteTimeOut : Integer read FWriteTimeOut write SetPropWriteTimeOut;
143
144 property ReadBufferSize : Integer read FReadBufferSize write SetPropReadBufferSize;
145 property WriteBufferSize : Integer read FWriteBufferSize write SetPropWriteBufferSize;
146
147 property ParityReplace : AnsiChar read FParityReplace write FParityReplace;
148
149 // @Section public class
150 public
151 class function GetPortNames() : TArray<String>;
152 end;
153
154
155 // 串口异常
156 ESerialPort = class(Exception);
157
158 // 串口读或写超时
159 ESerialPortTimeOut = class(ESerialPort);
160
161
162 // 别名, 辅助用
163 TBaudRateTool = record
164 public const
165 // aliases
166 BR_110 = CBR_110;
167 BR_300 = CBR_300;
168 BR_600 = CBR_600;
169 BR_1200 = CBR_1200;
170 BR_2400 = CBR_2400;
171 BR_4800 = CBR_4800;
172 BR_9600 = CBR_9600;
173 BR_14400 = CBR_14400;
174 BR_19200 = CBR_19200;
175 BR_38400 = CBR_38400;
176 BR_56000 = CBR_56000;
177 BR_57600 = CBR_57600;
178 BR_115200 = CBR_115200;
179 BR_128000 = CBR_128000;
180 BR_256000 = CBR_256000;
181
182 SupportedValues : array[0..14] of Integer
183 = (BR_110, BR_300, BR_600, BR_1200, BR_2400,
184 BR_4800, BR_9600, BR_14400, BR_19200, BR_38400,
185 BR_56000, BR_57600, BR_115200, BR_128000, BR_256000);
186 public
187 class function IsSupportedBaudRate(const ABaudRate : Integer) : Boolean; static;
188 end;
189
190 TParityTool = record
191 public const
192 // aliases
193 None = NOPARITY; // 无校验
194 Odd = ODDPARITY; // 奇校验
195 Even = EVENPARITY; // 偶校验
196
197 SupportedValues : array[0..2] of Integer = (None, Odd, Even);
198 public
199 class function IsSupportedParity(const AParity : Integer) : Boolean; static;
200 end;
201
202 TDataBitsTool = record
203 public const
204 SupportedValues : array[0..3] of Integer = (5, 6, 7, 8);
205 public
206 class function IsSupportedDataBits(const ADataBits : Integer) : Boolean; static;
207 end;
208
209 TStopBitTool = record
210 public const
211 // aliases
212 One = ONESTOPBIT; // 1
213 One5 = ONE5STOPBITS; // 1.5
214 Two = TWOSTOPBITS; // 2
215
216 SupportedValues : array[0..2] of Integer = (One, One5, Two);
217 public
218 class function IsSupportedStopBit(const AStopBit : Integer) : Boolean; static;
219 end;
220
221
222 implementation
223
224 uses
225 System.Classes,
226 System.Math,
227 System.Win.Registry;
228
229
230
231 // --- types from C# ---
232
233 type
234 DCBFlags = class
235 // 没仔细看, 想来应该是偏移量
236 // --see-also=https://github.com/dotnet/runtime/blob/master/src/libraries/Common/src/Interop/Windows/Kernel32/Interop.DCB.cs
237 public
238 const FBINARY = 0;
239 const FPARITY = 1;
240 const FOUTXCTSFLOW = 2;
241 const FOUTXDSRFLOW = 3;
242 const FDTRCONTROL = 4;
243 const FDSRSENSITIVITY = 6;
244 const FOUTX = 8;
245 const FINX = 9;
246 const FERRORCHAR = 10;
247 const FNULL = 11;
248 const FRTSCONTROL = 12;
249 const FABORTONOERROR = 14;
250 const FDUMMY2 = 15;
251 end;
252
253 DCBDTRFlowControl = class
254 public
255 const DTR_CONTROL_DISABLE = $00;
256 const DTR_CONTROL_ENABLE = $01;
257 end;
258
259 DCBRTSFlowControl = class
260 public
261 const RTS_CONTROL_DISABLE = $00;
262 const RTS_CONTROL_ENABLE = $01;
263 const RTS_CONTROL_HANDSHAKE = $02;
264 const RTS_CONTROL_TOGGLE = $03;
265 end;
266
267 TDCBTool = class
268 public
269 const EOFCHAR = AnsiChar(26);
270
271 const DEFAULTXONCHAR = AnsiChar(17);
272 const DEFAULTXOFFCHAR = AnsiChar(19);
273 end;
274
275
276
277 // --- TSerialPort ---
278
279 // --- class functions
280
281 class function TSerialPort.GetPortNames() : TArray<String>;
282 // 获取当前计算机的串行端口名的数组
283 var
284 LRegistry : TRegistry;
285 LValNames : TStrings; // 注册表键下值的名称
286 LIndex : Integer;
287 begin
288 LRegistry := nil;
289 LValNames := nil;
290 try
291 LValNames := TStringList.Create();
292 LRegistry := TRegistry.Create();
293
294 LRegistry.RootKey := HKEY_LOCAL_MACHINE;
295 if not LRegistry.OpenKeyReadOnly('HARDWARE\DEVICEMAP\SERIALCOMM') then
296 begin
297 Result := nil;
298 Exit;
299 end;
300
301 LRegistry.GetValueNames(LValNames);
302
303 SetLength(Result, LValNames.Count);
304
305 for LIndex := 0 to (LValNames.Count - 1) do begin
306 Result[LIndex] := LRegistry.ReadString(LValNames[LIndex]);
307 end;
308 finally
309 FreeAndNil(LRegistry);
310 FreeAndNil(LValNames);
311 end;
312 end;
313
314
315 // --- functions
316
317 constructor TSerialPort.Create();
318 begin
319 Create('COM1');
320 end;
321
322 constructor TSerialPort.Create(const AComName: string);
323 // 默认 9600波特率 无校验 8数据位 1停止位
324 begin
325 Create(AComName, CBR_9600, NOPARITY, 8, ONESTOPBIT);
326 end;
327
328 constructor TSerialPort.Create(const AComName: string; const ABaudRate, AParity, ADataBits, AStopBit: Integer);
329 const
330 LDefaultBufferSize = 2048;
331 LDefaultParityReplace = '?';
332 begin
333 inherited Create();
334
335 self.SetHandleInvalid();
336
337 self.FEventLoop := nil;
338
339 self.FReadBufferSize := LDefaultBufferSize;
340 self.FWriteBufferSize := LDefaultBufferSize;
341
342 self.FReadTimeOut := 0;
343 self.FWriteTimeOut := 0;
344
345 self.FParityReplace := LDefaultParityReplace;
346
347 self.SetPropCommName(AComName);
348 self.SetPropBaudRate(ABaudRate);
349 self.SetPropParity(AParity);
350 self.SetPropDataBits(ADataBits);
351 self.SetPropStopBit(AStopBit);
352 end;
353
354
355 destructor TSerialPort.Destroy();
356 begin
357 if self.IsOpen() then begin
358 try
359 self.Close();
360 except
361 // 如果执行到了这里, 能做什么呢
362 end;
363 end;
364
365 inherited;
366 end;
367
368
369
370 function TSerialPort.IsOpen() : Boolean;
371 // 判断端口是否已被打开
372 begin
373 Result := not self.IsInvalidHandle(self.FCommHandle);
374 end;
375
376 procedure TSerialPort.SetHandleInvalid();
377 // 将串口句柄设置为无效句柄
378 begin
379 self.FCommHandle := INVALID_HANDLE_VALUE;
380 end;
381
382 function TSerialPort.IsInvalidHandle(const AHandle: NativeUInt) : Boolean;
383 // 判断串口句柄是否有效
384 begin
385 Result := (AHandle = INVALID_HANDLE_VALUE);
386 end;
387
388
389
390 procedure TSerialPort.Open();
391 // 打开端口, 如果有问题会抛出异常
392 var
393 LPortNumber : Integer;
394 LTmpHandle : THandle;
395 LErrCode : Cardinal;
396 LFileType : Integer;
397 LErrors : Cardinal;
398 LCommProp : TCommProp;
399 // only for function parameter
400 LPinStatus : Cardinal;
401 LComStat : ComStat;
402 begin
403 if self.IsOpen() then begin
404 raise ESerialPort.Create('SerialPort is already open');
405 end;
406
407 LPortNumber := self.CheckAndGetComNumber(self.FCommName);
408
409 // 创建句柄, 使用 tmpHandle 保存
410 LTmpHandle := CreateFile(
411 PChar('\\?\COM' + Integer.ToString(LPortNumber)),
412 GENERIC_READ or GENERIC_WRITE, // 读写访问
413 0, // comm devices must be opened w/exclusive-access
414 nil, // 安全属性 default security attributes
415 OPEN_EXISTING, // comm devices must use OPEN_EXISTING
416 FILE_FLAG_OVERLAPPED, // 异步
417 0); // hTemplate must be NULL for comm devices
418
419 if self.IsInvalidHandle(LTmpHandle) then begin
420 LErrCode := GetLastError();
421 raise ESerialPort.CreateFmt('Open port failed invalied_handle_value, caused by error %d', [LErrCode]);
422 end;
423
424 try
425 LFileType := GetFileType(LTmpHandle);
426
427 // Allowing FILE_TYPE_UNKNOWN for legitimate serial device such as USB to serial adapter device
428 if ((LFileType <> FILE_TYPE_CHAR) and (LFileType <> FILE_TYPE_UNKNOWN)) then begin
429 raise ESerialPort.CreateFmt('The given port name (%s) does not resolve to a valid serial port',
430 [self.FCommName]);
431 end;
432
433 // 把 tmpHandle 的值赋到 字段 FCommHandle 上来,
434 // 但 tmpHandle 的值不动, 上面抛出异常或下面发生错误时 close tmpHandle
435 self.FCommHandle := LTmpHandle;
436
437 if (not(GetCommProperties(LTmpHandle, LCommProp)))
438 or(not(GetCommModemStatus(LTmpHandle, LPinStatus)))
439 then begin
440 // If the portName they have passed in is a FILE_TYPE_CHAR but not a serial port,
441 // for example "LPT1", this API will fail. For this reason we handle the error message specially.
442 LErrCode := GetLastError();
443 if ((LErrCode = ERROR_INVALID_PARAMETER) or (LErrCode = ERROR_INVALID_HANDLE)) then begin
444 raise ESerialPort.CreateFmt('The given port name (%s) is invalid. It may be a valid port, but not a serial port.', [self.FCommName]);
445 end
446 else begin
447 // Win32Marshal.GetExceptionForWin32Error(errorCode, string.Empty);
448 raise ESerialPort.CreateFmt('Open port failed, caused by error %d', [LErrCode]);
449 end;
450 end;
451
452 if ((LCommProp.dwMaxBaud <> 0) and (Cardinal(self.BaudRate) > LCommProp.dwMaxBaud)) then begin
453 raise ESerialPort.CreateFmt('The maximum baud rate for the device is %d.', [LCommProp.dwMaxBaud]);
454 end;
455
456 self.ConfigDCB(LCommProp);
457 self.ConfigEvents();
458 self.ConfigTimeouts();
459 self.ConfigBufferSizes();
460
461 // TODO process errors
462 PurgeComm(self.FCommHandle, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
463 ClearCommError(self.FCommHandle, LErrors, @LComStat);
464
465 // 启动事件循环
466 self.FEventLoop := TSerialPort.TEventLoop.Create(self.FCommHandle);
467 self.FEventLoop.Start();
468 except
469 self.SetHandleInvalid();
470
471 CloseHandle(LTmpHandle);
472 raise;
473 end;
474 end;
475
476
477 procedure TSerialPort.Close();
478 // 关闭串口
479 var
480 LTmpHandle : THandle;
481 begin
482 if not self.IsOpen() then begin
483 Exit;
484 end;
485
486 // 停止事件循环
487 self.FEventLoop.Stop();
488 FreeAndNil(self.FEventLoop);
489
490 // 处理串口句柄
491 LTmpHandle := self.FCommHandle;
492 self.SetHandleInvalid();
493
494 // TODO process errors
495 SetCommMask(LTmpHandle, 0); // 禁止所有事件
496 EscapeCommFunction(LTmpHandle, CLRDTR); // 清除信号
497 // 丢弃未完成的内容, 终止所有操作
498 PurgeComm(LTmpHandle, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
499
500 CloseHandle(LTmpHandle);
501 end;
502
503
504 // --- read and write
505
506 function TSerialPort.ReadBytes(ABuff: TArray<Byte>; const AOffset: Integer; const ACount: Integer) : Integer;
507 // 读操作
508 // TODO 方法的实现需要仔细检查
509 var
510 LReadResult : Boolean;
511 LLenReaded : Cardinal;
512 LLastErr : Cardinal;
513 LWaitResult : Cardinal;
514 LReadOv : TOverlapped;
515 begin
516 if not self.IsOpen() then begin
517 raise ESerialPort.Create('The serialPort is closed');
518 end;
519
520 self.CheckReadWriteArguments(ABuff, AOffset, ACount);
521
522 if (ACount = 0) then begin
523 Result := 0;
524 Exit;
525 end;
526
527 FillChar(LReadOv, SizeOf(LReadOv), 0);
528 LReadOv.hEvent := CreateEvent(nil, True, False, nil);
529
530 if (LReadOv.hEvent = 0) then begin
531 LLastErr := GetLastError();
532 raise ESerialPort.CreateFmt('Create event failed in read bytes, %d', [LLastErr]);
533 end;
534
535 LReadResult := ReadFile(self.FCommHandle,
536 ABuff[AOffset],
537 ACount,
538 LLenReaded,
539 @LReadOv);
540
541 if LReadResult then begin
542 Result := LLenReaded;
543 Exit;
544 end;
545
546 LLastErr := GetLastError();
547 if not(LLastErr = ERROR_IO_PENDING) then begin
548 // TODO error description
549 raise ESerialPort.CreateFmt('Read failed, caused by %d', [LLastErr]);
550 end;
551
552 // TODO 观察 C# 对这里超时是怎样处理的
553 LWaitResult := WaitForSingleObject(LReadOv.hEvent, INFINITE);
554
555 // TODO 考虑下面需要做哪些事情
556 if (LWaitResult = WAIT_OBJECT_0) then begin
557 if GetOverlappedResult(self.FCommHandle, LReadOv, LLenReaded, False) then begin
558 Result := LLenReaded;
559 //Break;
560 end
561 else begin
562 Result := 0;
563 //Break;
564 end;
565 end
566 else if (LWaitResult = WAIT_TIMEOUT) then begin
567 CancelIO(self.FCommHandle);
568
569 Result := 0;
570 // TODO timeout
571 end
572 else begin
573 Result := 0;
574 end;
575 end;
576
577 procedure TSerialPort.WriteBytes(ABuff: TArray<System.Byte>; const AOffset: Integer; const ACount: Integer);
578 // 写操作
579 // TODO 方法的实现需要仔细检查,
580 // 当前的实现不能保证把所有的数据都发送出去, 所以这里还需要更多处理
581 var
582 LWriteResult : Boolean;
583 LWriteOv : TOverlapped;
584 LLenSent : Cardinal;
585 LWriteErr : Cardinal;
586 LWaitResult : Cardinal;
587 begin
588 if not self.IsOpen() then begin
589 raise ESerialPort.Create('The serialPort is closed');
590 end;
591
592 self.CheckReadWriteArguments(ABuff, AOffset, ACount);
593
594 FillChar(LWriteOv, SizeOf(LWriteOv), 0);
595
596 LWriteOv.hEvent := CreateEvent(nil, True, False, nil);
597
598 if (LWriteOv.hEvent = 0) then begin
599 raise ESerialPort.CreateFmt('Write failed, cuased by create event error %d.', [GetLastError()]);
600 end;
601
602 try
603 LWriteResult := WriteFile( self.FCommHandle,
604 ABuff[AOffSet],
605 ACount,
606 LLenSent,
607 @LWriteOv);
608
609 if LWriteResult then begin
610 Exit; // 发送完, 退出
611 end;
612
613 LWriteErr := GetLastError();
614 if (LWriteErr <> ERROR_IO_PENDING) then begin
615 // TODO error description
616 raise ESerialPort.CreateFmt('Write failed, error %d.', [LWriteErr]);
617 end;
618
619 // TODO configure wait timeout
620 LWaitResult := WaitForSingleObject(LWriteOv.hEvent, INFINITE);
621
622 if (LWaitResult = WAIT_OBJECT_0) then begin
623 if GetOverlappedResult(self.FCommHandle, LWriteOv, LLenSent, False) then begin
624 Exit;
625 end
626 else begin
627 // TODO type an exception
628 raise ESerialPort.CreateFmt('Write failed, error %d.', [GetLastError()]);
629 end;
630 end
631 else if (LWaitResult = WAIT_TIMEOUT) then begin
632 // TODO timeout
633 raise ESerialPort.Create('Write failed, timeout.');
634 end
635 else begin
636 raise ESerialPort.CreateFmt('Write failed, Wait result %d.', [LWaitResult]);
637 end;
638 // write finished
639 finally
640 CloseHandle(LWriteOv.hEvent);
641 end;
642 end;
643
644
645 procedure TSerialPort.CheckReadWriteArguments(const AArr: TArray<System.Byte>; const AOffset, ACount: Integer);
646 // 检查读写操作的输入参数
647 var
648 LLen : Integer;
649 begin
650 LLen := Length(AArr);
651 if (LLen <= 0) then begin
652 raise ESerialPort.Create('Null bytes buffer');
653 end;
654
655 if (AOffset < 0) then begin
656 raise ESerialPort.Create('Non-negative number required, offset');
657 end;
658
659 if (ACount < 0) then begin
660 raise ESerialPort.Create('Non-negative number required, count');
661 end;
662
663 if (LLen - AOffset < ACount) then begin
664 raise ESerialPort.Create('Offset and length were out of bounds for the array '
665 + 'or count is greater than the number of elements from index to the end of the source collection');
666 end;
667 end;
668
669
670 function TSerialPort.CheckAndGetComNumber(const AComName: string) : Integer;
671 // 检查和串口名是不是 COM后面跟着数字 的格式, 如果是则返回数字, 否则抛出异常
672 const
673 LStrInvalidPortNameFmt = 'The given port name (%s) does not resolve to a valid serial port';
674 begin
675 if (not AComName.StartsWith('COM', True))
676 or (not Integer.TryParse(AComName.Substring(3), Result))
677 or (not Result > 0)
678 then begin
679 raise ESerialPort.CreateFmt(LStrInvalidPortNameFmt, [AComName]);
680 end;
681 end;
682
683
684 // --- about comm config
685
686 procedure TSerialPort.ConfigEvents();
687 // 配置事件
688 const
689 LEV_ALL = ( EV_BREAK or EV_CTS or EV_DSR or EV_ERR or EV_RING
690 or EV_RLSD or EV_RXCHAR or EV_RXFLAG or EV_TXEMPTY);
691 var
692 LErrCode : Cardinal;
693 begin
694 // 设置事件, 把所有的事件都设置了, 虽然没有处理这些事件
695 if not SetCommMask(self.FCommHandle, LEV_ALL) then begin
696 LErrCode := GetLastError();
697 raise ESerialPort.CreateFmt('SetCommMask failed, caused by %d', [LErrCode]);
698 end;
699 end;
700
701
702 procedure TSerialPort.ConfigDCB(ACommProp : TCommProp);
703 // 配置 设备控制块
704 // TODO 完善
705 var
706 LDcb : TDCB;
707 LErrCode : Cardinal;
708 begin
709 if not GetCommState(self.FCommHandle, LDcb) then begin
710 LErrCode := GetLastError();
711 raise ESerialPort.CreateFmt('Get DCB failed, caused by %d', [LErrCode]);
712 end;
713
714 // TODO others
715 //LDcb.DCBlength := SizeOf(TDCB);
716
717 LDcb.BaudRate := self.FBaudRate;
718 LDcb.Parity := self.FParity;
719 LDcb.ByteSize := self.FDataBits;
720 LDcb.StopBits := self.FStopBit;
721
722 // always true for communications resources
723 SetDcbFlag(LDcb, DCBFlags.FBINARY, 1);
724 //LDcb.Flags := 1;
725
726 if (self.FParity = TParityTool.None) then begin
727 SetDcbFlag(LDcb, DCBFlags.FPARITY, 0);
728 end
729 else begin
730 SetDcbFlag(LDcb, DCBFlags.FPARITY, 1);
731 end;
732
733 // Note-1
734 // 不支持这个东西, 不了解它, C# 默认Handshake.None
735 SetDcbFlag(LDcb, DCBFlags.FOUTXCTSFLOW, 0);
736
737 SetDcbFlag(LDcb, DCBFlags.FOUTXDSRFLOW, 0); // dsrTimeout is always set to 0.
738 SetDcbFlag(LDcb, DCBFlags.FDTRCONTROL, DCBDTRFlowControl.DTR_CONTROL_DISABLE);
739 SetDcbFlag(LDcb, DCBFlags.FDSRSENSITIVITY, 0); // this should remain off
740
741 // 同 Note-1
742 SetDcbFlag(LDcb, DCBFlags.FINX, 0);
743 SetDcbFlag(LDcb, DCBFlags.FOUTX, 0);
744
745
746 // if no parity, we have no error character (i.e. ErrorChar = '\0' or null character)
747 if (self.FParity = TParityTool.None) then begin
748 SetDcbFlag(LDcb, DCBFlags.FERRORCHAR, 0);
749 LDcb.ErrorChar := #0;
750 end
751 else begin
752 if (Ord(self.FParityReplace) = 0) then begin
753 SetDcbFlag(LDcb, DCBFlags.FERRORCHAR, 0);
754 end
755 else begin
756 SetDcbFlag(LDcb, DCBFlags.FERRORCHAR, 1);
757 end;
758
759 LDcb.ErrorChar := self.FParityReplace;
760 end;
761
762 // Note-2 默认 C# 默认 false
763 SetDcbFlag(LDcb, DCBFlags.FNULL, 0);
764
765 // SerialStream does not handle the fAbortOnError behaviour, so we must make sure it's not enabled
766 // C# 的 SerialStream
767 SetDcbFlag(LDcb, DCBFlags.FABORTONOERROR, 0);
768
769 // Setting RTS control, which is RTS_CONTROL_HANDSHAKE if RTS / RTS-XOnXOff handshaking
770 // used, RTS_ENABLE (RTS pin used during operation) if rtsEnable true but XOnXoff / No handshaking
771 // used, and disabled otherwise.
772 // C# 这里有与 Handshake 有关的处理
773 if (GetDcbFlag(LDcb, DCBFlags.FRTSCONTROL) = DCBRTSFlowControl.RTS_CONTROL_HANDSHAKE) then begin
774 SetDcbFlag(LDcb, DCBFlags.FRTSCONTROL, DCBRTSFlowControl.RTS_CONTROL_DISABLE);
775 end;
776
777 LDcb.XonChar := TDCBTool.DEFAULTXONCHAR; // may be exposed later but for now, constant
778 LDcb.XoffChar := TDCBTool.DEFAULTXOFFCHAR;
779
780 // minimum number of bytes allowed in each buffer before flow control activated
781 // heuristically, this has been set at 1/4 of the buffer size
782 LDcb.XonLim := (ACommProp.dwCurrentRxQueue div 4);
783 LDcb.XoffLim := (ACommProp.dwCurrentRxQueue div 4);
784
785 LDcb.EofChar := TDCBTool.EOFCHAR;
786
787 // OLD MSCOMM: dcb.EvtChar = (byte) 0;
788 // now changed to make use of RXFlag WaitCommEvent event => Eof WaitForCommEvent event
789 LDcb.EvtChar := TDCBTool.EOFCHAR;
790
791
792 if not SetCommState(self.FCommHandle, LDcb) then begin
793 LErrCode := GetLastError();
794 raise ESerialPort.CreateFmt('Set DCB failed, caused by %d.', [LErrCode]);
795 end;
796 end;
797
798
799 procedure TSerialPort.ConfigTimeouts();
800 // 配置超时
801 var
802 LTimeouts : TCommTimeouts;
803 LErrCode : Cardinal;
804 begin
805 if not GetCommTimeouts(self.FCommHandle, LTimeouts) then begin
806 LErrCode := GetLastError();
807 raise ESerialPort.CreateFmt('Get timeouts failed, caused by %d', [LErrCode]);
808 end;
809
810 if (self.FReadTimeOut = 0) then begin
811 // 不使用超时, 读操作总是立即返回
812 LTimeouts.ReadIntervalTimeout := MAXDWORD;
813 LTimeouts.ReadTotalTimeoutMultiplier := 0;
814 LTimeouts.ReadTotalTimeoutConstant := 0;
815 end
816 else begin
817 // 固定超时
818 LTimeouts.ReadIntervalTimeout := MAXDWORD;
819 LTimeouts.ReadTotalTimeoutMultiplier := MAXDWORD;
820 LTimeouts.ReadTotalTimeoutConstant := self.FReadTimeOut;
821 end;
822
823 LTimeouts.WriteTotalTimeoutMultiplier := 0;
824 // 如果 FWriteTimeout 设置为 0, 则不使用写超时
825 LTimeouts.WriteTotalTimeoutConstant := self.FWriteTimeOut;
826
827 if not SetCommTimeouts(self.FCommHandle, LTimeouts) then begin
828 LErrCode := GetLastError();
829 raise ESerialPort.CreateFmt('Set timeouts failed, caused by %d.', [LErrCode]);
830 end;
831 end;
832
833
834 procedure TSerialPort.ConfigBufferSizes;
835 // 配置缓冲区
836 var
837 LErrCode : Cardinal;
838 begin
839 if not(SetupComm(self.FCommHandle, self.FReadBufferSize, self.FWriteBufferSize)) then begin
840 LErrCode := GetLastError();
841 raise ESerialPort.CreateFmt('Set buffer sizes failed, caused by %d', [LErrCode]);
842 end;
843 end;
844
845
846
847 // --- about Dcb.Flags
848
849 function TSerialPort.GetDcbFlag(const ADcb : TDCB; AWhichFlag : Integer) : Integer;
850 // from C#
851 var
852 LMask : Cardinal;
853 begin
854 if ((AWhichFlag = DCBFlags.FDTRCONTROL) or (AWhichFlag = DCBFlags.FRTSCONTROL)) then begin
855 LMask := $03;
856 end
857 else if (AWhichFlag = DCBFlags.FDUMMY2) then begin
858 LMask := $1FFFF;
859 end
860 else begin
861 LMask := $01;
862 end;
863
864 Result := ADcb.Flags and (LMask shl AWhichFlag);
865 Result := Result shr AWhichFlag;
866 end;
867
868
869 procedure TSerialPort.SetDcbFlag(var ADcb : TDCB; AWhichFlag : Integer; ASetting : Integer);
870 // from C#
871 var
872 LMask : Cardinal;
873 begin
874 ASetting := ASetting shl AWhichFlag;
875
876 if ((AWhichFlag = DCBFlags.FDTRCONTROL) or (AWhichFlag = DCBFlags.FRTSCONTROL)) then begin
877 LMask := $03;
878 end
879 else if (AWhichFlag = DCBFlags.FDUMMY2) then begin
880 LMask := $1FFFF;
881 end
882 else begin
883 LMask := $01;
884 end;
885
886 // clear the region
887 ADcb.Flags := ADcb.Flags and (not (LMask shl ADcb.Flags));
888
889 // set the region
890 ADcb.Flags := ADcb.Flags or ASetting;
891 end;
892
893
894 // --- for properties
895
896 procedure TSerialPort.SetPropCommName(const ACommName: string);
897 begin
898 if Trim(ACommName) = '' then begin
899 raise ESerialPort.Create('The port name can not be empty');
900 end;
901
902 if self.IsOpen() then begin
903 raise ESerialPort.CreateFmt('"%s" can not be set while the port is open', [self.FCommName]);
904 end;
905
906 self.FCommName := ACommName;
907 end;
908
909 procedure TSerialPort.SetPropBaudRate(const ABaudRate: Integer);
910 begin
911 // if not TBaudRateTool.IsSupportedBaudRate(ABaudRate) then begin
912 if (ABaudRate <= 0) then begin
913 raise ESerialPort.CreateFmt('Unsupported bardrate %d', [ABaudRate]);
914 end;
915
916 self.FBaudRate := ABaudRate;
917 end;
918
919 procedure TSerialPort.SetPropParity(const AParity: Integer);
920 begin
921 if not TParityTool.IsSupportedParity(AParity) then begin
922 raise ESerialPort.CreateFmt('Unsupported parity %d', [AParity]);
923 end;
924
925 self.FParity := AParity;
926 end;
927
928 procedure TSerialPort.SetPropDataBits(const ADataBits: Integer);
929 begin
930 if not TDataBitsTool.IsSupportedDataBits(ADataBits) then begin
931 raise ESerialPort.CreateFmt('Unsupported dataBits %d', [ADataBits]);
932 end;
933
934 self.FDataBits := ADataBits;
935 end;
936
937 procedure TSerialPort.SetPropStopBit(const AStopBit: Integer);
938 begin
939 if not TStopBitTool.IsSupportedStopBit(AStopBit) then begin
940 raise ESerialPort.CreateFmt('Unsupported stopBit %d', [AStopBit]);
941 end;
942
943 self.FStopBit := AStopBit;
944 end;
945
946
947 procedure TSerialPort.SetPropReadTimeOut(const ATimeOut: Integer);
948 // 设置读超时
949 // timeout == 0 表示不使用超时, 无论有没有数据总是立即返回
950 var
951 LOldTimeout : Integer;
952 begin
953 if (ATimeOut < 0) then begin
954 raise ESerialPort.CreateFmt('ReadTimeout %d out of range, timeout can not less than 0.', [ATimeOut]);
955 end;
956
957 LOldTimeOut := self.FReadTimeOut;
958 try
959 self.FReadTimeOut := ATimeOut;
960
961 if self.IsOpen() then begin
962 self.ConfigTimeouts();
963 end;
964 except
965 self.FReadTimeOut := LOldTimeout;
966 raise;
967 end;
968 end;
969
970 procedure TSerialPort.SetPropWriteTimeOut(const ATimeOut: Integer);
971 // 设置写超时
972 // timeout == 0 表示不使用写超时
973 var
974 LOldTimeOut : Integer;
975 begin
976 if (ATimeOut < 0) then begin
977 raise ESerialPort.CreateFmt('ReadTimeout %d out of range, timeout can not less than 0.', [ATimeOut]);
978 end;
979
980 LOldTimeOut := self.FWriteTimeOut;
981 try
982 self.FWriteTimeOut := ATimeOut;
983
984 if self.IsOpen() then begin
985 self.ConfigTimeouts();
986 end;
987 except
988 self.FWriteTimeOut := LOldTimeout;
989 raise;
990 end;
991 end;
992
993
994 procedure TSerialPort.SetPropReadBufferSize(const ASize: Integer);
995 // 设置 读缓冲区
996 begin
997 if (ASize <= 0) then begin
998 raise ESerialPort.Create('ReadBufferSize must greater than 0.');
999 end;
1000
1001 if self.IsOpen() then begin
1002 raise ESerialPort.Create('ReadBufferSize cannot be set while the port is open.');
1003 end;
1004
1005 self.FReadBufferSize := ASize;
1006 end;
1007
1008 procedure TSerialPort.SetPropWriteBufferSize(const ASize: Integer);
1009 // 设置 写缓冲区
1010 begin
1011 if (ASize <= 0) then begin
1012 raise ESerialPort.Create('WriteBufferSize must greater than 0.');
1013 end;
1014
1015 if self.IsOpen() then begin
1016 raise ESerialPort.Create('WriteBufferSize cannot be set while the port is open.');
1017 end;
1018
1019 self.FWriteBufferSize := ASize;
1020 end;
1021
1022
1023
1024 // --- TSerialPort.TEventLoop ---
1025 // TODO
1026
1027 constructor TSerialPort.TEventLoop.Create(AHandle : THandle);
1028 begin
1029 inherited Create();
1030
1031 self.FHandle := AHandle;
1032 // TODO
1033 end;
1034
1035 destructor TSerialPort.TEventLoop.Destroy;
1036 begin
1037 // TODO
1038
1039 inherited;
1040 end;
1041
1042
1043 procedure TSerialPort.TEventLoop.Start();
1044 begin
1045 // TODO
1046 end;
1047
1048
1049 procedure TSerialPort.TEventLoop.Stop();
1050 begin
1051 // TODO
1052 end;
1053
1054
1055
1056
1057 // --- unit private sequential search ---
1058
1059 function Contains(const AItem : Integer; const AArray : array of Integer) : Boolean;
1060 var
1061 LElem : Integer;
1062 begin
1063 for LElem in AArray do begin
1064 if (AItem = LElem) then begin
1065 Result := True;
1066 Exit;
1067 end;
1068 end;
1069
1070 Result := False;
1071 end;
1072
1073
1074 // --- TBaudRateTool ---
1075
1076 class function TBaudRateTool.IsSupportedBaudRate(const ABaudRate : Integer) : Boolean;
1077 begin
1078 Result := Contains(ABaudRate, SupportedValues);
1079 end;
1080
1081 // --- TPairtyTool ---
1082
1083 class function TParityTool.IsSupportedParity(const AParity : Integer) : Boolean;
1084 begin
1085 Result := Contains(AParity, SupportedValues);
1086 end;
1087
1088 // --- TDataBitsTool ---
1089
1090 class function TDataBitsTool.IsSupportedDataBits(const ADataBits : Integer) : Boolean;
1091 begin
1092 Result := Contains(ADataBits, SupportedValues);
1093 end;
1094
1095 // --- TStopBitTool ---
1096
1097 class function TStopBitTool.IsSupportedStopBit(const AStopBit : Integer) : Boolean;
1098 begin
1099 Result := Contains(AStopBit, SupportedValues);
1100 end;
1101
1102
1103 end.
发表于 2020-3-28 08:58:00