comms.pas

Motorola 集群通信系统中SDTS车载台PEI端测试程序

procedure TComTimeouts.SetWriteTotalC(Value: Integer);
begin
  if Value <> FWriteTotalC then begin
    FWriteTotalC := Value;
    ComPort.SetTimeouts;
  end;
end;

procedure TComTimeouts.SetWriteTotalM(Value: Integer);
begin
  if Value <> FWriteTotalM then begin
    FWriteTotalM := Value;
    ComPort.SetTimeouts;
  end;
end;

// TFlowControl

constructor TFlowControl.Create(AComPort: TComPort);
begin
  ComPort := AComPort;
end;

procedure TFlowControl.AssignTo(Dest: TPersistent);
begin
  if Dest is TFlowControl then begin
    with TFlowControl(Dest) do begin
      FOutCtsFlow := Self.FOutCtsFlow;
      FOutDsrFlow := Self.FOutDsrFlow;
      FControlDtr := Self.FControlDtr;
      FControlRts := Self.FControlRts;
      FXonXoffOut := Self.FXonXoffOut;
      FXonXoffIn  := Self.FXonXoffIn;
      ComPort     := Self.ComPort;
    end
  end
  else
    inherited AssignTo(Dest);
end;

procedure TFlowControl.SetControlDtr(Value: TDtrFlowControl);
begin
  if Value <> FControlDtr then begin
    FControlDtr := Value;
    ComPort.SetDCB;
  end;
end;

procedure TFlowControl.SetControlRts(Value: TRtsFlowControl);
begin
  if Value <> FControlRts then begin
    FControlRts := Value;
    ComPort.SetDCB;
  end;
end;

procedure TFlowControl.SetOutCtsFlow(Value: Boolean);
begin
  if Value <> FOutCtsFlow then begin
    FOutCtsFlow := Value;
    ComPort.SetDCB;
  end;
end;

procedure TFlowControl.SetOutDsrFlow(Value: Boolean);
begin
  if Value <> FOutDsrFlow then begin
    FOutDsrFlow := Value;
    ComPort.SetDCB;
  end;
end;

procedure TFlowControl.SetXonXoffIn(Value: Boolean);
begin
  if Value <> FXonXoffIn then begin
    FXonXoffIn := Value;
    ComPort.SetDCB;
  end;
end;

procedure TFlowControl.SetXonXoffOut(Value: Boolean);
begin
  if Value <> FXonXoffOut then begin
    FXonXoffOut := Value;
    ComPort.SetDCB;
  end;
end;

// TParity

constructor TParity.Create(AComPort: TComPort);
begin
  ComPort := AComPort;
end;

procedure TParity.AssignTo(Dest: TPersistent);
begin
  if Dest is TParity then begin
    with TParity(Dest) do begin
      FBits        := Self.FBits;
      FCheck       := Self.FCheck;
      FReplace     := Self.FReplace;
      FReplaceChar := Self.FReplaceChar;
      ComPort      := Self.ComPort;
    end
  end
  else
    inherited AssignTo(Dest);
end;

procedure TParity.SetBits(Value: TParityBits);
begin
  if Value <> FBits then begin
    FBits := Value;
    ComPort.SetDCB;
  end;
end;

procedure TParity.SetCheck(Value: Boolean);
begin
  if Value <> FCheck then begin
    FCheck := Value;
    ComPort.SetDCB;
  end;
end;

procedure TParity.SetReplace(Value: Boolean);
begin
  if Value <> FReplace then begin
    FReplace := Value;
    ComPort.SetDCB;
  end;
end;

procedure TParity.SetReplaceChar(Value: Byte);
begin
  if Value <> FReplaceChar then begin
    FReplaceChar := Value;
    ComPort.SetDCB;
  end;
end;

// TComPort

constructor TComPort.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FConnected := False;
  FBaudRate := br9600;
  FPort := COM1;
  FStopBits := sbOneStopBit;
  FDataBits := dbEight;
  FEvents := [evRxChar, evTxEmpty, evRxFlag, evRing, evBreak,
             evCTS, evDSR, evError, evRLSD, evRx80Full];
  FWriteBufSize := 1024;
  FReadBufSize := 1024;
  FHandle := INVALID_HANDLE_VALUE;
  FParity := TParity.Create(Self);
  FFlowControl := TFlowControl.Create(Self);
  FTimeouts := TComTimeouts.Create(Self);
  Stack := TStack.Create;
end;

destructor TComPort.Destroy;
begin
  Close;
  Stack.Free;
  FFlowControl.Free;
  FTimeouts.Free;
  FParity.Free;
  inherited Destroy;
end;

procedure TComPort.CreateHandle;
begin
  FHandle := CreateFile(
    PChar(ComString),
    GENERIC_READ or GENERIC_WRITE,
    0,
    nil,
    OPEN_EXISTING,
    FILE_FLAG_OVERLAPPED,
    0);

  if FHandle = INVALID_HANDLE_VALUE then
    raise EComPort.Create('Unable to open com port: ' + LastErr);
end;

procedure TComPort.DestroyHandle;
begin
  if FHandle <> INVALID_HANDLE_VALUE then
    CloseHandle(FHandle);
end;

procedure TComPort.WindowMethod(var Message: TMessage);
begin
  with Message do
    if Msg = CM_COMPORT then begin
      if (wParam = EV_RXCHAR) then DoOnRxChar;
      if (wParam = EV_TXEMPTY) then DoOnTxEmpty;
      if (wParam = EV_BREAK) then DoOnBreak;
      if (wParam = EV_RING) then DoOnRing;
      if (wParam = EV_CTS) then DoOnCTS;
      if (wParam = EV_DSR) then DoOnDSR;
      if (wParam = EV_RXFLAG) then DoOnRxFlag;
      if (wParam = EV_RLSD) then DoOnRLSD;
      if (wParam = EV_ERR) then DoOnError;
      if (wParam = EV_RX80FULL) then DoOnRx80Full;
    end else
      Result := DefWindowProc(FWindow, Msg, wParam, lParam);
end;

procedure TComPort.Open;
begin
  Close;
  CreateHandle;
  FConnected := True;
  try
    SetupComPort;
  except
    DestroyHandle;
    FConnected := False;
    raise;
  end;
  if (FSyncMethod = smWindow) then
    FWindow := AllocateHWnd(WindowMethod);
  if (FEvents = []) then
    ThreadCreated := False
  else begin
    EventThread := TComThread.Create(Self);
    ThreadCreated := True;
  end;
  if Assigned(FOnOpen) then FOnOpen(Self);
end;

procedure TComPort.Close;
begin
  if FConnected then begin
    AbortAllIO;
    if ThreadCreated then
      EventThread.Free;
    DestroyHandle;
    FConnected := False;
    if FSyncMethod = smWindow then
      DeallocateHWnd(FWindow);
    if Assigned(FOnClose) then
      FOnClose(Self);
  end;
end;

procedure TComPort.SetTimeouts;
var
  Timeouts: TCommTimeouts;
begin
  if FConnected then begin
    Timeouts.ReadIntervalTimeout := GetTOValue(FTimeouts.FReadInterval);
    Timeouts.ReadTotalTimeoutMultiplier := GetTOValue(FTimeouts.FReadTotalM);
    Timeouts.ReadTotalTimeoutConstant := GetTOValue(FTimeouts.FReadTotalC);
    Timeouts.WriteTotalTimeoutMultiplier := GetTOValue(FTimeouts.FWriteTotalM);
    Timeouts.WriteTotalTimeoutConstant := GetTOValue(FTimeouts.FWriteTotalC);

    if not SetCommTimeouts(FHandle, Timeouts) then
      raise EComPort.Create('Unable to set com state: ' + LastErr);
  end;
end;

procedure TComPort.SetDCB;
var
  DCB: TDCB;
  Temp: DWORD;
begin
  if FConnected then begin
    FillChar(DCB, SizeOf(DCB), 0);

    DCB.DCBlength := SizeOf(DCB);
    DCB.XonChar := #17;
    DCB.XoffChar := #19;
    DCB.XonLim := FReadBufSize div 4;
    DCB.XoffLim := DCB.XonLim;
    DCB.EvtChar := Char(FEventChar);

    DCB.Flags := DCB.Flags or dcb_Binary;
    if FDiscardNull then
      DCB.Flags := DCB.Flags or dcb_Null;

    with FFlowControl do begin
      if FOutCtsFlow then
        DCB.Flags := DCB.Flags or dcb_OutxCtsFlow;
      if FOutDsrFlow then
        DCB.Flags := DCB.Flags or dcb_OutxDsrFlow;
      Temp := 0;
      case FControlDtr of
        dtrDisable:   Temp := DTR_CONTROL_DISABLE;
        dtrEnable:    Temp := DTR_CONTROL_ENABLE;
        dtrHandshake: Temp := DTR_CONTROL_HANDSHAKE;
      end;
      DCB.Flags := DCB.Flags or Integer(dcb_DtrControl and (Temp shl 4));
      case FControlRts of
        rtsDisable:   Temp := RTS_CONTROL_DISABLE;
        rtsEnable:    Temp := RTS_CONTROL_ENABLE;
        rtsHandshake: Temp := RTS_CONTROL_HANDSHAKE;
        rtsToggle:    Temp := RTS_CONTROL_TOGGLE;
      end;
      DCB.Flags := DCB.Flags or Integer(dcb_RtsControl and (Temp shl 12));
      if FXonXoffOut then
        DCB.Flags := DCB.Flags or dcb_OutX;
      if FXonXoffIn then
        DCB.Flags := DCB.Flags or dcb_InX;
    end;

    case FParity.FBits of
      prNone:  DCB.Parity := NOPARITY;
      prOdd:   DCB.Parity := ODDPARITY;
      prEven:  DCB.Parity := EVENPARITY;
      prMark:  DCB.Parity := MARKPARITY;
      prSpace: DCB.Parity := SPACEPARITY;
    end;

    if FParity.FCheck then
      DCB.Flags := DCB.Flags or dcb_Parity;

    if FParity.FReplace then begin
      DCB.Flags := DCB.Flags or dcb_ErrorChar;
      DCB.ErrorChar := Char(FParity.ReplaceChar);
    end;

    case FStopBits of
      sbOneStopBit:   DCB.StopBits := ONESTOPBIT;
      sbOne5StopBits: DCB.StopBits := ONE5STOPBITS;
      sbTwoStopBits:  DCB.StopBits := TWOSTOPBITS;
    end;

    case FBaudRate of
      br110:    DCB.BaudRate := CBR_110;
      br300:    DCB.BaudRate := CBR_300;
      br600:    DCB.BaudRate := CBR_600;
      br1200:   DCB.BaudRate := CBR_1200;
      br2400:   DCB.BaudRate := CBR_2400;
      br4800:   DCB.BaudRate := CBR_4800;
      br9600:   DCB.BaudRate := CBR_9600;
      br14400:  DCB.BaudRate := CBR_14400;
      br19200:  DCB.BaudRate := CBR_19200;
      br38400:  DCB.BaudRate := CBR_38400;
      br56000:  DCB.BaudRate := CBR_56000;
      br57600:  DCB.BaudRate := CBR_57600;
      br115200: DCB.BaudRate := CBR_115200;
    end;

    DCB.ByteSize := Integer(FDataBits) + 5;

    if not SetCommState(FHandle, DCB) then
      raise EComPort.Create('Unable to set com state: ' + LastErr);
  end;
end;

procedure TComPort.SetComm;
begin
  if FConnected then begin
    if not SetupComm(FHandle, FReadBufSize, FWriteBufSize) then
      raise EComPort.Create('Unable to set com state: ' + LastErr);
  end;
end;

procedure TComPort.SetupComPort;
begin
  SetComm;
  SetDCB;
  SetTimeouts;
end;

function TComPort.InQue: DWORD;
var
  Errors: DWORD;
  ComStat: TComStat;
begin
  if not ClearCommError(FHandle, Errors, @ComStat) then
    raise EComPort.Create('Unable to read com status: ' + LastErr);
  Result := ComStat.cbInQue;
end;

function TComPort.OutQue: DWORD;
var
  Errors: DWORD;
  ComStat: TComStat;
begin
  if not ClearCommError(FHandle, Errors, @ComStat) then
    raise EComPort.Create('Unable to read com status: ' + LastErr);
  Result := ComStat.cbOutQue;
end;

function TComPort.HighCTS: Boolean;
var
  Status: DWORD;
begin
  if not GetCommModemStatus(FHandle, Status) then
    raise EComPort.Create('Unable to read com status: ' + LastErr);
  Result := (MS_CTS_ON and Status) <> 0
end;

function TComPort.HighDSR: Boolean;
var
  Status: DWORD;
begin
  if not GetCommModemStatus(FHandle, Status) then
    raise EComPort.Create('Unable to read com status: ' + LastErr);
  Result := (MS_DSR_ON and Status) <> 0
end;

function TComPort.HighRLSD: Boolean;
var
  Status: DWORD;
begin
  if not GetCommModemStatus(FHandle, Status) then
    raise EComPort.Create('Unable to read com status: ' + LastErr);
  Result := (MS_RLSD_ON and Status) <> 0
end;

function TComPort.HighRing: Boolean;
var
  Status: DWORD;
begin
  if not GetCommModemStatus(FHandle, Status) then
    raise EComPort.Create('Unable to read com status: ' + LastErr);
  Result := (MS_RING_ON and Status) <> 0
end;

procedure TComPort.SetBreak(State: Boolean);
var
  Act: DWORD;
begin
  if State then
    Act := Windows.SETBREAK
  else
    Act := Windows.CLRBREAK;

  if not EscapeCommFunction(FHandle, Act) then
    raise EComPort.Create('Unable to set signal: ' + LastErr);
end;

procedure TComPort.SetDTR(State: Boolean);
var
  Act: DWORD;
begin
  if State then
    Act := Windows.SETDTR
  else