多线程串口异步通信类TSerialPort

多线程串口异步通信类TSerialPort_自学php网

来源：自学PHP网时间：2014-12-04 22:12 作者：阅读:次

[导读] 刚开始学vb的时候，做的第一个网络聊天程序就是用的activeX控件，就是大名鼎鼎的winsock.ocx控件了。等到用到后面准备搞多线程的时候，才发现vb连多线程都支持不了，后来就自己封装...

刚开始学vb的时候，做的第一个网络聊天程序就是用的activeX控件，就是大名鼎鼎的winsock.ocx控件了。等到用到后面准备搞多线程的时候，才发现vb连多线程都支持不了，后来就自己封装socket类了，也是从那个时候开始，抛弃了vb，用起了delphi。

至于串口的通信类，用mscomm.ocx对于大部分人来讲，是很方便的编程应用了。如上所说的原因，我不喜欢用控件。此外，用这个控件，回头还得注册一下才能用，很伤。于是决定封装一个了。

TSerialPort.pas

wxs这哥们写了个宝贝，挂在csdn上供人下载。我直接下载下来从下午直接弄到晚上，利用虚拟的com连接软件，发送信息是没有问题了，但是依然收不到信息。

等到第二天再打开仔细的看了看他写的接收数据的代码，才发现，这个哥们用调用ReadFile两次，第一次只读取和保存了6个字节的数据，第二次就读全了数据。一开始百思不得其解。后来才想明白，大概是他通讯是有另外一个协议的，第一次读取6byte的数据是数据包头，代表的是整个数据据包的大小。也不知道这是哪门子协议。不管它，反正ASTM还有hl7只有约定每次发送包的最大值，多了就拆，压根就没有限定大小了。我们读出来是啥就是啥。

看看这个类的结构吧，这个哥们写的比较漂亮。

TSerialPort:串口通信的主类，用于创建该类，并且初始化一些连接参数。

TWriteThread：写入数据（发送数据）的类，该类为TThread的多线程类，用于com口发送数据。

TReadThread ：读数据类，该类也是TThread的多线程类，用于接受com口的数据。

整个流程如下：

TSerialPort通过open的方法打开com口，然后构造TWriteThread，TReadThread这两个类，这两个类使用while（True)跑一个死循环，各自在自己的线程里面跑着。当调用TSerialPort的WriteData方法发送数据的时候，程序将发送线程消息给TWriteThread，线程循环收到线程消息后将数据发送。TReadThread线程不断的轮询发现com口缓冲区有数据的时候，将会回调一个函数，并将数据返回。

delphi的字符串编码格式

delphi的字符创编码方式从delphi2009后就变的让人很受伤，变成unicode编码了，也就是两个字节编码一个字符。吵吵用的delphi版本是xe2字符串都是宽字符编码的，但是大部分的仪器都是用ascii编码的，所以，把宽字符变成ascii编码再发送就变成了一个纠结的问题。

1、用ansistring和pansistring转化。

网上说ansistring是ascii编码的，因此最简单的方法就是强制转化变量为Ansistring,如果你有这个冲动去定义一个AnsiString的变量来试试，我劝你不用实验了，最后byteslen（’w'）依然是两个字节的。再仔细一想，ansistring和pansistring不过就是一个指针，你原来字符串格式在内存中就是宽字符的，指针指向的自然还是不变的。

2、用bytes来转化。

折腾了半天找到了bytesof这个函数，这个函数能够放回基于ascii编码的字节数组，用它就能转化了：

function StrToBuffer(AStr:string;ABuffer:PAnsiChar):Integer;
var
  i:Integer;
  bytes:TBytes;
begin
  bytes:=BytesOf(AStr);

  for I := 0 to Length(bytes) - 1 do
  begin
    ABuffer[i] :=AnsiChar(bytes[i]);
  end;
  Result:=Length(Bytes);
end;

最后奉上这个多线程的异步串口通讯类，ps：还在继续完善中：

//串口通信类
//吵吵 201312
unit SerialPort;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

const
  PWM_COMMWRITE = WM_USER + 101;

type
  TParity = (ptNone, ptOdd, ptEven, ptMark, ptSpace);
  TStopBits = (_1, _1_5, _2);
  TByteBits = (_5, _6, _7, _8);

  TReceiveError = (rverBufferOverflow);

  TReceiveDataEvent = procedure (Sender: TObject; ABuffer: PAnsiChar;
    ABufferLength: DWORD);

  TReceiveErrorEvent = procedure (Sender: TObject; ABuffer: PAnsiChar;
    ABufferLength: DWORD; AReceiveError: TReceiveError);

  TReceiveTimeOutEvent = procedure (Sender: TObject; ABuffer: PAnsiChar;
    ABufferLength: DWORD);

  TRequestHangupEvent = procedure (Sender: TObject; AErrorCode: DWORD);

  //读串口线程类
  TReadThread = class(TThread)
  private
    FCommFile: THandle;
    FCloseEvent: THandle;
    FInBufferSize: DWORD;
    FBaudRate: DWORD;
    FIntervalTimeout: DWORD;

    FOnReceiveData: TReceiveDataEvent;
    FOnReceiveError: TReceiveErrorEvent;
    FOnReceiveTimeOut: TReceiveTimeOutEvent;
    FOnRequestHangup: TRequestHangupEvent;

    procedure ReceiveData(ABuffer: PAnsiChar; ABufferLength: DWORD);
    procedure ReceiveError(ABuffer: PAnsiChar; ABufferLength: DWORD;
      AReceiveError: TReceiveError);
    procedure ReceiveTimeOut(ABuffer: PAnsiChar; ABufferLength: DWORD);
    procedure RequestHangup;
  protected
    procedure Execute; override;
    function ReadData(AOverlappedRead: POverlapped; ABuffer: PAnsiChar;
      ANumberOfBytesToRead: DWORD; var ANumberOfBytesRead: DWORD): Boolean;
  end;

  //写串口线程类
  TWriteThread = class(TThread)
  private
    FCommFile: THandle;
    FCloseEvent: THandle;
    FOutBufferSize: DWORD;
    FOnRequestHangup: TRequestHangupEvent;

    procedure RequestHangup;
  protected
    procedure Execute; override;
    function WriteData(AOverlappedWrite: POverlapped;
      ABuffer: PAnsiChar; ANumberToBytesWrite: DWORD): Boolean;
  end;

  //串口类
  TSerialPort = class
  private
    FCommFile: THandle;
    FCloseEvent: THandle;

    FPortOpen: Boolean;
    FCommPort: Byte;

    FCommName: WideString;
    FBaudRate: DWORD;
    FParityCheck: Boolean;
    FParity: TParity;
    FStopBits: TStopBits;
    FByteBits: TByteBits;

    FIntervalTimeout: DWORD; //指定时间间隔内没有收到数据
    FReadIntervalTimeout: DWORD;
    FReadTotalTimeoutMultiplier: DWORD;
    FReadTotalTimeoutConstant: DWORD;
    FWriteTotalTimeoutMultiplier: DWORD;
    FWriteTotalTimeoutConstant: DWORD;

    FInBufferSize: DWORD;
    FOutBufferSize: DWORD;

    FReadThread: TReadThread;
    FWriteThread: TWriteThread;

    FOnReceiveData: TReceiveDataEvent;
    FOnReceiveError: TReceiveErrorEvent;
    FOnReceiveTimeOut: TReceiveTimeOutEvent;
    FOnRequestHangup: TRequestHangupEvent;

    procedure SetCommPort(AValue: Byte);
    procedure SetBaudRate(AValue: DWORD);
    procedure SetParityCheck(AValue: Boolean);
    procedure SetByteBits(AValue: TByteBits);
    procedure SetParity(AValue: TParity);
    procedure SetStopBits(AValue: TStopBits);

    procedure SetReadIntervalTimeout(AValue: DWORD);
    procedure SetReadTotalTimeoutMultiplier(AValue: DWORD);
    procedure SetReadTotalTimeoutConstant(AValue: DWORD);
    procedure SetWriteTotalTimeoutMultiplier(AValue: DWORD);
    procedure SetWriteTotalTimeoutConstant(AValue: DWORD);

    procedure SetCommState;
    procedure SetCommTimeouts;

    procedure CloseReadThread;
    procedure CloseWriteThread;
  public
    property Handle: THandle read FCommFile;

    constructor Create;
    destructor Destroy; override;

    function Open: Boolean;
    procedure Close;

    property IsOpen: Boolean read FPortOpen;

    function GetModemState: DWORD;

    property CommPort: BYTE read FCommPort write SetCommPort default 1;
    property CommName: WideString read FCommName write FCommName;
    property BaudRate: DWORD read FBaudRate write SetBaudRate default 9600;
    property ByteBits: TByteBits read FByteBits write SetByteBits;
    property ParityCheck: Boolean read FParityCheck
      write SetParityCheck default False;
    property Parity: TParity read FParity write SetParity;
    property StopBits: TStopBits read FStopBits write SetStopBits;

    property InBufferSize: DWORD read FInBufferSize write FInBufferSize;
    property OutBufferSize: DWORD read FOutBufferSize write FOutBufferSize;

    property IntervalTimeOut: DWORD read FIntervalTimeout
      write FIntervalTimeout;
    property ReadIntervalTimeout: DWORD read FReadIntervalTimeout
      write SetReadIntervalTimeout;
    property ReadTotalTimeoutMultiplier: DWORD read FReadTotalTimeoutMultiplier
      write SetReadTotalTimeoutMultiplier;
    property ReadTotalTimeoutConstant: DWORD read FReadTotalTimeoutConstant
      write SetReadTotalTimeoutConstant;
    property WriteTotalTimeoutMultiplier: DWORD read FWriteTotalTimeoutMultiplier
      write SetWriteTotalTimeoutMultiplier;
    property WriteTotalTimeoutConstant: DWORD read FWriteTotalTimeoutConstant
      write SetWriteTotalTimeoutConstant;

    function WriteData(ABuffer: PAnsiChar;
      ANumberToBytesToWrite: DWORD): Boolean;

    property OnReceiveData: TReceiveDataEvent read FOnReceiveData
      write FOnReceiveData;
    property OnReceiveError: TReceiveErrorEvent read FOnReceiveError
      write FOnReceiveError;
    property OnReceiveTimeOut: TReceiveTimeOutEvent read FOnReceiveTimeOut
      write FOnReceiveTimeOut;
    property OnRequestHangup: TRequestHangupEvent read FOnRequestHangup
      write FOnRequestHangup;
  end;

implementation

//读串口线程类-----------------------------
//2. 按包头、包体分别接收(能避免粘包问题)
//假设包头长度固定为6，包头第5、6字节保存包体数据长度
procedure TReadThread.Execute;
var
  InBuffer: array of AnsiChar;
  dwNumberOfBytesToRead, dwBytesRead, dwNumberOfBytesRead: DWORD;
  dwHandleSignaled, dwLastError: DWORD;
  HandlesToReadFor: array [0 .. 1] of THandle;
  OverlappedRead: TOverlapped;

  procedure EndReadThread;
  begin
    PurgeComm(FCommFile, PURGE_RXABORT + PURGE_RXCLEAR);
    CloseHandle(OverlappedRead.hEvent);
  end;
begin
  SetLength(InBuffer, FInBufferSize);
  FillChar(OverlappedRead, Sizeof(OverlappedRead), 0);

  //ShowMessage(IntToStr(FInBufferSize));

  OverlappedRead.hEvent := CreateEvent(nil, True, True, nil);
  if OverlappedRead.hEvent = 0 then
  begin
    RequestHangup;
    EndReadThread;
    Exit;
  end;          

  HandlesToReadFor[0] := FCloseEvent;
  HandlesToReadFor[1] := OverlappedRead.hEvent;

  //清空输入缓冲区
  PurgeComm(FCommFile, PURGE_RXABORT + PURGE_RXCLEAR);

  while True do
  begin
    //接收包头
    //
    dwNumberOfBytesToRead := FInBufferSize;
    dwNumberOfBytesRead := 0;

    if not ReadFile(FCommFile,
             InBuffer[dwNumberOfBytesRead],
             dwNumberOfBytesToRead,
             dwBytesRead,
             @OverlappedRead) then
    begin
      dwLastError := GetLastError;

      if dwLastError <> ERROR_IO_PENDING then
      begin
        EndReadThread;
        Exit;
      end;
    end;

    dwHandleSignaled := WaitForMultipleObjects(2, @HandlesToReadFor,
                          False, FIntervalTimeout);

    case dwHandleSignaled of
      WAIT_OBJECT_0:
      begin
        EndReadThread;
        Exit;
      end;

      WAIT_OBJECT_0 + 1:
      begin
        if not GetOverlappedResult(FCommFile, OverlappedRead,
                 dwBytesRead, False) then
        begin
          RequestHangup;
          EndReadThread;
          Exit;
        end;

       // ShowMessage(IntToStr(dwBytesRead));

        InBuffer[dwBytesRead] := #0;
        ReceiveData(@InBuffer[0], dwNumberOfBytesRead);
        //FillChar(InBuffer,SizeOf(InBuffer),0);
      end;

      WAIT_TIMEOUT: //超时(指定时间内没有收到数据)
      begin
        PurgeComm(FCommFile, PURGE_RXABORT + PURGE_RXCLEAR);
        ReceiveTimeOut(nil, 0);
      end;
    else
      RequestHangup;
      EndReadThread;
      Exit;
    end;
  end;
end;

function TReadThread.ReadData(AOverlappedRead: POverlapped; ABuffer: PAnsiChar;
  ANumberOfBytesToRead: DWORD; var ANumberOfBytesRead: DWORD): Boolean;
var
  dwBytesRead, dwLastError, dwHandleSignaled, dwMilliseSecond: DWORD;
  HandlesToReadFor: array [0 .. 1] of THandle;
begin
  Result := False;

  HandlesToReadFor[0] := FCloseEvent;
  HandlesToReadFor[1] := AOverlappedRead.hEvent;

  ANumberOfBytesRead := 0;     

  repeat
    if not ReadFile(FCommFile,
             ABuffer[ANumberOfBytesRead],
             ANumberOfBytesToRead,
             dwBytesRead,
             AOverlappedRead) then
    begin
      dwLastError := GetLastError;

      if dwLastError <> ERROR_IO_PENDING then
        Exit;

      dwMilliseSecond := round(ANumberOfBytesToRead * 8000 / FBaudRate);
      Inc(dwMilliseSecond);

      dwHandleSignaled := WaitForMultipleObjects(2,
                            @HandlesToReadFor,
                            False,
                            dwMilliseSecond);

      case dwHandleSignaled of
        WAIT_OBJECT_0:
        begin
          Exit;
        end;

        WAIT_OBJECT_0 + 1:
        begin
          if not GetOverlappedResult(FCommFile,
                   AOverlappedRead^, dwBytesRead, False) then
          begin
            RequestHangup;
            Exit;
          end;
        end;

        WAIT_TIMEOUT:
        begin
          PurgeComm(FCommFile, PURGE_RXABORT + PURGE_RXCLEAR);
          Result := True;
          Exit;
        end;
      else
        RequestHangup;
        Exit;
      end;
    end;

    Dec(ANumberOfBytesToRead, dwBytesRead);
    Inc(ANumberOfBytesRead, dwBytesRead);
  until ANumberOfBytesToRead <= 0;

  Result := True;
end;

procedure TReadThread.ReceiveData(ABuffer: PAnsiChar; ABufferLength: DWORD);
begin
  if Assigned(FOnReceiveData) then
    FOnReceiveData(Self, ABuffer, ABufferLength);

end;

procedure TReadThread.ReceiveError(ABuffer: PAnsiChar; ABufferLength: DWORD;
  AReceiveError: TReceiveError);
begin
  if Assigned(FOnReceiveError) then
    FOnReceiveError(Self, ABuffer, ABufferLength, AReceiveError);
end;

procedure TReadThread.ReceiveTimeOut(ABuffer: PAnsiChar; ABufferLength: DWORD);
begin
  if Assigned(FOnReceiveTimeOut) then
    FOnReceiveTimeOut(Self, ABuffer, ABufferLength);
end;

procedure TReadThread.RequestHangup;
begin
  if Assigned(FOnRequestHangup) then
    FOnRequestHangup(Self, GetLastError);
end;

//写串口线程类-----------------------------
procedure TWriteThread.Execute;
var
  msg: TMsg;
  dwHandleSignaled: DWORD;
  OverlappedWrite: TOverLapped;

  procedure EndWriteThread;
  begin
    PurgeComm(FCommFile, PURGE_TXABORT + PURGE_TXCLEAR);
    CloseHandle(OverlappedWrite.hEvent)
  end;
begin
  FillChar(OverlappedWrite, sizeof(OverlappedWrite), 0);

  OverlappedWrite.hEvent := CreateEvent(nil, True, True, nil);
  if OverlappedWrite.hEvent = 0 then
  begin
    RequestHangup;
    EndWriteThread;
    Exit;
  end;

  while True do
  begin
    if not PeekMessage(msg, 0, 0, 0, PM_REMOVE) then
    begin
      dwHandleSignaled := MsgWaitForMultipleObjects(1,
                            FCloseEvent,
                            False,
                            INFINITE,
                            QS_ALLINPUT);

      case dwHandleSignaled of
        WAIT_OBJECT_0:
        begin
          EndWriteThread;
          Exit;
        end;
        WAIT_OBJECT_0 + 1:
        begin
          Continue;
        end;
      else
        RequestHangup;
        EndWriteThread;
        Exit;
      end;
    end;

    //确保FCloseEvent没有信号
    if WAIT_TIMEOUT <> WaitForSingleObject(FCloseEvent, 0) then
    begin
      EndWriteThread;
      Exit;
    end;

    if msg.hwnd <> 0 then
    begin
      TranslateMessage(msg);
      DispatchMessage(msg);
      Continue;
    end;

    case msg.message of
      PWM_COMMWRITE:
      begin

        if not WriteData(@OverlappedWrite, PAnsiChar(msg.lParam),
                 DWORD(msg.wParam)) then
        begin
          LocalFree(HLOCAL(msg.lParam));
          EndWriteThread;
          Exit;
        end;
        LocalFree(HLOCAL(msg.lParam));
      end;
    end;
  end;
end;

function TWriteThread.WriteData(AOverlappedWrite: POverlapped;
  ABuffer: PAnsiChar; ANumberToBytesWrite: DWORD): Boolean;
var
  dwLastError, dwNumberOfBytesWritten, dwWhereToStartWriting: DWORD;
  dwHandleSignaled: DWORD;
  HandlesToWaitFor: array [0 .. 1] of THandle;
begin
  Result := False;

  dwNumberOfBytesWritten := 0;
  dwWhereToStartWriting := 0;

  HandlesToWaitFor[0] := FCloseEvent;
  HandlesToWaitFor[1] := AOverlappedWrite^.hEvent;

  repeat
    if not WriteFile(FCommFile,
             ABuffer[dwWhereToStartWriting],
             ANumberToBytesWrite,
             dwNumberOfBytesWritten,
             AOverlappedWrite) then
    begin
      dwLastError := GetLastError;

      if dwLastError <> ERROR_IO_PENDING then
        Exit;

      dwHandleSignaled := WaitForMultipleObjects(2, @HandlesToWaitFor,
                            False, INFINITE);

      case dwHandleSignaled of
        WAIT_OBJECT_0:
        begin
          Exit;
        end;

        WAIT_OBJECT_0 + 1:
        begin
          if not GetOverlappedResult(FCommFile,
                   AOverlappedWrite^,
                   dwNumberOfBytesWritten, True) then
            Exit;
        end;
      else
        Exit;
      end;
    end;

    Dec(ANumberToBytesWrite, dwNumberOfBytesWritten);
    Inc(dwWhereToStartWriting, dwNumberOfBytesWritten);
  until (ANumberToBytesWrite <= 0);  

  Result := True;
end;

procedure TWriteThread.RequestHangup;
begin
  if Assigned(FOnRequestHangup) then
    FOnRequestHangup(Self, GetLastError);
end;

//串口类-------------------------------
constructor TSerialPort.Create;
begin
  FCommFile := 0;
  FCloseEvent := 0;

  FPortOpen := False;
  FCommPort := 1;
  FCommName := 'COM1';
  FBaudRate := 9600;
  FByteBits := _8;
  FParity := ptNone;
  FStopBits := _1;
  FParityCheck := False;

  FInBufferSize := 4096;
  FOutBufferSize := 4096;

  FIntervalTimeout := INFINITE;
  FReadIntervalTimeout := 100;
  FReadTotalTimeoutMultiplier := 0;
  FReadTotalTimeoutConstant := 0;
  FWriteTotalTimeoutMultiplier := 0;
  FWriteTotalTimeoutConstant := 0;

  FOnReceiveData := nil;
  FOnReceiveError := nil;
  FOnReceiveTimeOut := nil;
  FOnRequestHangup := nil;

  FReadThread := nil;
  FWriteThread := nil;
end;

destructor TSerialPort.Destroy;
begin
  if IsOpen then
    Close;
  inherited Destroy;
end;

function TSerialPort.Open: Boolean;
var
  hNewCommFile: THandle;
begin
  Result := False;

  if FCommFile <> 0 then
    Exit;

  hNewCommFile := CreateFile(PWideChar(FCommName),
                    GENERIC_READ or GENERIC_WRITE,
                    0,
                    nil,
                    OPEN_EXISTING,
                    FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED,
                    0);

  if hNewCommFile = INVALID_HANDLE_VALUE then
    Exit;

  if not SetupComm(hNewCommFile, FInBufferSize, FOutBufferSize) then
  begin
    CloseHandle(hNewCommFile);
    Exit;
  end;

  FCommFile := hNewCommFile;

  PurgeComm(FCommFile,
    PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);

  SetCommTimeouts;

  SetCommState;

  FCloseEvent := CreateEvent(nil, True, False, nil);

  try
    FReadThread := TReadThread.Create(True);
  except
    FReadThread := nil;
    CloseHandle(FCloseEvent);
    CloseHandle(FCommFile);
    FCommFile := 0;
    raise Exception.Create('Unable to create read thread!');
    Exit;
  end;
  FReadThread.FCommFile := FCommFile;
  FReadThread.FCloseEvent := FCloseEvent;
  FReadThread.FBaudRate := FBaudRate;
  FReadThread.FInBufferSize := FInBufferSize;
  FReadThread.FIntervalTimeout := FIntervalTimeout;
  FReadThread.FOnReceiveData := FOnReceiveData;
  FReadThread.FOnReceiveError := FOnReceiveError;
  FReadThread.FOnReceiveTimeOut := FOnReceiveTimeOut;
  FReadThread.FOnRequestHangup := FOnRequestHangup;
  FReadThread.Priority := tpHighest;

  try
    FWriteThread := TWriteThread.Create(True);
  except
    CloseReadThread;
    FWriteThread := nil;
    CloseHandle(FCloseEvent);
    CloseHandle(FCommFile);
    FCommFile := 0;
    raise Exception.Create('Unable to create write thread!');
    Exit;
  end;
  FWriteThread.FCommFile := FCommFile;
  FWriteThread.FCloseEvent := FCloseEvent;
  FWriteThread.FOutBufferSize := FOutBufferSize;
  FWriteThread.FOnRequestHangup := FOnRequestHangup;
  FWriteThread.Priority := tpHigher;

  FReadThread.Resume;
  FWriteThread.Resume;

  FPortOpen := True;

  Result := True;
end;

procedure TSerialPort.Close;
begin
  if FCommFile = 0 then
    Exit;

  CloseReadThread;
  CloseWriteThread;

  CloseHandle(FCloseEvent);

  FPortOpen := False;

  CloseHandle(FCommFile);
  FCommFile := 0
end;

procedure TSerialPort.CloseReadThread;
begin
  if FReadThread <> nil then
  begin
    SetEvent(FCloseEvent);

    PurgeComm(FCommFile, PURGE_RXABORT + PURGE_RXCLEAR);

    if (WaitForSingleObject(FReadThread.Handle, 5000) = WAIT_TIMEOUT) then
      FReadThread.Terminate;

    FreeAndNil(FReadThread);
  end
end;

procedure TSerialPort.CloseWriteThread;
begin
  if FWriteThread <> nil then
  begin
    SetEvent(FCloseEvent);

    PurgeComm(FCommFile, PURGE_TXABORT + PURGE_TXCLEAR);

    if (WaitForSingleObject(FWriteThread.Handle, 5000) = WAIT_TIMEOUT) then
      FWriteThread.Terminate;

    FreeAndNil(FWriteThread);
  end
end;

function TSerialPort.GetModemState: DWORD;
var
  dwModemState: DWORD;
begin
  if GetCommModemStatus(FCommFile, dwModemState) then
    Result := dwModemState
  else
    Result := 0;
end;

procedure TSerialPort.SetCommState;
var
  dcb: TDCB;
begin
  GetCommState(FCommFile, dcb);
  dcb.BaudRate := FBaudRate;
  dcb.Flags := 1; //Enable fBinary
  if FParityCheck then
    dcb.Flags := dcb.Flags or 2; // Enable parity check
  dcb.ByteSize := Ord(FByteBits) + 5;
  dcb.Parity := Ord(FParity);
  dcb.StopBits := Ord(FStopBits);
  Windows.SetCommState(FCommFile, dcb);
end;

procedure TSerialPort.SetCommTimeouts;
var
  CommTimeOuts: TCommTimeouts;
begin
  GetCommTimeouts(FCommFile, CommTimeOuts);
  CommTimeOuts.ReadIntervalTimeout := FReadIntervalTimeout;
  CommTimeOuts.ReadTotalTimeoutMultiplier := FReadTotalTimeoutMultiplier;
  CommTimeOuts.ReadTotalTimeoutConstant := FReadTotalTimeoutConstant;
  CommTimeOuts.WriteTotalTimeoutMultiplier := FWriteTotalTimeoutMultiplier;
  CommTimeOuts.WriteTotalTimeoutConstant := FWriteTotalTimeoutConstant;
  Windows.SetCommTimeouts(FCommFile, CommTimeOuts);
end;

procedure TSerialPort.SetCommPort(AValue: BYTE);
begin
  if (AValue <> 0) and (AValue <> FCommPort) then
  begin
    FCommPort := AValue;
    FCommName := 'COM' + IntToStr(AValue);
  end;
end;

procedure TSerialPort.SetBaudRate(AValue: DWORD);
begin
  if AValue <> FBaudRate then
  begin
    FBaudRate := AValue;
    if FCommFile <> 0 then
      SetCommState;
  end;
end;

procedure TSerialPort.SetParityCheck(AValue: Boolean);
begin
  if AValue <> FParityCheck then
  begin
    FParityCheck := AValue;
    if FCommFile <> 0 then
      SetCommState;
  end;
end;

procedure TSerialPort.SetByteBits(AValue: TByteBits);
begin
  if AValue <> FByteBits then
  begin
    FByteBits := AValue;
    if FCommFile <> 0 then
      SetCommState;
  end;
end;

procedure TSerialPort.SetParity(AValue: TParity);
begin
  if AValue <> FParity then
  begin
    FParity := AValue;
    if FCommFile <> 0 then
      SetCommState;
  end;
end;

procedure TSerialPort.SetStopBits(AValue: TStopBits);
begin
  if AValue <> FStopBits then
  begin
    FStopBits := AValue;
    if FCommFile <> 0 then
      SetCommState;
  end;
end;

procedure TSerialPort.SetReadIntervalTimeout(AValue: DWORD);
begin
  if AValue <> FReadIntervalTimeout then
  begin
    FReadIntervalTimeout := AValue;
    if FCommFile <> 0 then
      SetCommTimeouts;
  end;
end;

procedure TSerialPort.SetReadTotalTimeoutMultiplier(AValue: DWORD);
begin
  if AValue <> FReadTotalTimeoutMultiplier then
  begin
    FReadTotalTimeoutMultiplier := AValue;
    if FCommFile <> 0 then
      SetCommTimeouts;
  end;
end;

procedure TSerialPort.SetReadTotalTimeoutConstant(AValue: DWORD);
begin
  if AValue <> FReadTotalTimeoutConstant then
  begin
    FReadTotalTimeoutConstant := AValue;
    if FCommFile <> 0 then
      SetCommTimeouts;
  end;
end;

procedure TSerialPort.SetWriteTotalTimeoutMultiplier(AValue: DWORD);
begin
  if AValue <> FWriteTotalTimeoutMultiplier then
  begin
    FWriteTotalTimeoutMultiplier := AValue;
    if FCommFile <> 0 then
      SetCommTimeouts;
  end;
end;

procedure TSerialPort.SetWriteTotalTimeoutConstant(AValue: DWORD);
begin
  if AValue <> FWriteTotalTimeoutConstant then
  begin
    FWriteTotalTimeoutConstant := AValue;
    if FCommFile <> 0 then
      SetCommTimeouts;
  end;
end;

function TSerialPort.WriteData(ABuffer: PAnsiChar;
  ANumberToBytesToWrite: DWORD): Boolean;
var
  WriteBuff: Pointer;
begin
  Result := False;
  if (FWriteThread <> nil) and (ANumberToBytesToWrite > 0) then
  begin
    WriteBuff := Pointer(LocalAlloc(LPTR, ANumberToBytesToWrite + 1));
    Move(ABuffer^, WriteBuff^, ANumberToBytesToWrite);
    //ShowMessage(ABuffer[0]);
    Result := PostThreadMessage(FWriteThread.ThreadID,
                PWM_COMMWRITE,
                WPARAM(ANumberToBytesToWrite),
                LPARAM(WriteBuff));
  end;
end;

end.

Zend Studio安装PyDev插件_自学php网

Sublime text 3如何安装package control办法_自学php网

子栏目

多线程串口异步通信类TSerialPort_自学php网

最新评论

添加评论

更多文章推荐

添加评论