编写delphi串口类

是开心超人呀 發表於 2020-3-28 08:58:00

自己动手编写 delphi 的串口类
    --date=2020-03-28
    --group="笔记草稿"
---------
TODO 当前状态=玩具状态 --date=2020-05-24
 
<div class="cnblogs_code">
<pre> 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 表示不使用超时
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 functionGetDcbFlag(const ADcb : TDCB; AWhichFlag : Integer) : Integer;
 110 procedure SetDcbFlag(var ADcb : TDCB; AWhichFlag : Integer; ASetting : Integer);
 111
 112 procedure SetHandleInvalid();
 113 functionIsInvalidHandle(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 functionReadBytes(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 := LRegistry.ReadString(LValNames);
 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', );
 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 );
 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.', );
 445 end
 446 else begin
 447 // Win32Marshal.GetExceptionForWin32Error(errorCode, string.Empty);
 448 raise ESerialPort.CreateFmt('Open port failed, caused by error %d', );
 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.', );
 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 // TODOprocess 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', );
 533 end;
 534
 535 LReadResult := ReadFile(self.FCommHandle,
 536 ABuff,
 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', );
 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.', );
 600 end;
 601
 602 try
 603 LWriteResult := WriteFile( self.FCommHandle,
 604 ABuff,
 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.', );
 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.', );
 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.', );
 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, );
 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_RLSDor 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', );
 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', );
 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.', );
 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', );
 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.', );
 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', );
 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', );
 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', );
 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', );
 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', );
 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', );
 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.', );
 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.', );
 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 raiseESerialPort.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 raiseESerialPort.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.</pre>
</div>
 
 
 
 
--------- THE END --------- 
来源：https://www.cnblogs.com/shadow-abyss/p/12585696.html

頁: [1]

琼殿技术论坛's Archiver

编写delphi串口类