comms.pas

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

    Act := Windows.CLRDTR;

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

procedure TComPort.SetRTS(State: Boolean);
var
  Act: DWORD;
begin
  if State then
    Act := Windows.SETRTS
  else
    Act := Windows.CLRRTS;

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

procedure TComPort.SetXonXoff(State: Boolean);
var
  Act: DWORD;
begin
  if State then
    Act := Windows.SETXON
  else
    Act := Windows.SETXOFF;

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

function TComPort.Write(var Buffer; Count: DWORD; WaitFor: Boolean): DWORD;
var
  Success, Pending, Pop: Boolean;
  ErrCode, BytesTrans: DWORD;
  PO: POverlapped;
begin
  InitOverlapped(PO);
  Stack.Push(PO);
  Pending := False;
  Pop := True;

  Success := WriteFile(FHandle, Buffer, Count, BytesTrans, PO);
  if not Success then begin
    ErrCode := GetLastError;
    if ErrCode = ERROR_IO_PENDING then begin
      if WaitFor then begin
        BytesTrans := WaitForLastIO;
        Success := True;
      end
      else
        Pending := True;
      Pop := False;
    end
  end;

  if Pop then begin
    PO := Stack.Pop;
    DoneOverlapped(PO);
  end;

  if not (Success or Pending) then
    raise EComPort.Create('Operation failed: ' + LastErr);

  if Pending then
    Result := NOT_FINISHED
  else
    Result := BytesTrans;
end;

function TComPort.WriteString(Str: String; WaitFor: Boolean): DWORD;
var
  Success, Pending, Pop: Boolean;
  ErrCode, BytesTrans: DWORD;
  PO: POverlapped;
begin
  InitOverlapped(PO);
  Stack.Push(PO);
  Pending := False;
  Pop := True;

  Success := WriteFile(FHandle, Str[1], Length(Str), BytesTrans, PO);
  if not Success then begin
    ErrCode := GetLastError;
    if ErrCode = ERROR_IO_PENDING then begin
      if WaitFor then begin
        BytesTrans := WaitForLastIO;
        Success := True;
      end else
        Pending := True;
      Pop := False;
    end;
  end;

  if Pop then begin
    PO := Stack.Pop;
    DoneOverlapped(PO);
  end;

  if not (Success or Pending) then
    raise EComPort.Create('Operation failed: ' + LastErr);

  if Pending then
    Result := NOT_FINISHED
  else
    Result := BytesTrans;
end;

function TComPort.Read(var Buffer; Count: DWORD; WaitFor: Boolean): DWORD;
var
  Success, Pending, Pop: Boolean;
  ErrCode, BytesTrans: DWORD;
  PO: POverlapped;
begin
  InitOverlapped(PO);
  Stack.Push(PO);
  Pending := False;
  Pop := True;

  Success := ReadFile(FHandle, Buffer, Count, BytesTrans, PO);
  if not Success then begin
    ErrCode := GetLastError;
    if ErrCode = ERROR_IO_PENDING then begin
      if WaitFor then begin
        BytesTrans := WaitForLastIO;
        Success := True;
      end else
        Pending := True;
      Pop := False;
    end;
  end;

  if Pop then begin
    PO := Stack.Pop;
    DoneOverlapped(PO);
  end;

  if not (Success or Pending) then
    raise EComPort.Create('Operation failed: ' + LastErr);

  if Pending then
    Result := NOT_FINISHED
  else
    Result := BytesTrans;
end;

function TComPort.ReadString(var Str: String; Count: DWORD; WaitFor: Boolean): DWORD;
var
  Success, Pending, Pop: Boolean;
  ErrCode, BytesTrans: DWORD;
  PO: POverlapped;
begin
  SetLength(Str, Count);

  InitOverlapped(PO);
  Stack.Push(PO);
  Pending := False;
  Pop := True;

  Success := ReadFile(FHandle, Str[1], Count, BytesTrans, PO);
  if not Success then begin
    ErrCode := GetLastError;
    if ErrCode = ERROR_IO_PENDING then begin
      if WaitFor then begin
        BytesTrans := WaitForLastIO;
        Success := True;
      end else
        Pending := True;
      Pop := False;
    end;
  end;

  if Pop then begin
    PO := Stack.Pop;
    DoneOverlapped(PO);
  end;

  if not (Success or Pending) then
    raise EComPort.Create('Operation aborted: ' + LastErr);

  if Pending then
    Result := NOT_FINISHED
  else
    Result := BytesTrans;
end;

function TComPort.PendingIO: Boolean;
begin
  Result := not Stack.IsEmpty;
end;

function TComPort.WaitForLastIO: DWORD;
var
  Signaled, BytesTrans: DWORD;
  Success: Boolean;
  PO: POverlapped;
begin
  if PendingIO then begin
    PO := Stack.Pop;
    Signaled := WaitForSingleObject(PO^.hEvent, INFINITE);

    Success := (Signaled = WAIT_OBJECT_0) and
          (GetOverlappedResult(FHandle, PO^, BytesTrans, False));

    DoneOverlapped(PO);
    if Success then
      Result := BytesTrans
    else
      raise EComPort.Create('Operation failed: ' + LastErr);
  end else
    Result := NO_OPERATION;
end;

procedure TComPort.AbortAllIO;
var
  PO: POverlapped;
begin
  if PendingIO then begin
    try
      if not PurgeComm(FHandle, PURGE_TXABORT or PURGE_RXABORT) then
        raise EComPort.Create('Cannot abort operation: ' + LastErr);
    finally
      while (not Stack.IsEmpty) do begin
        PO := Stack.Pop;
        DoneOverlapped(PO);
      end;
    end;
  end;
end;

procedure TComPort.ShowPropForm;
begin
  with TCommFrm.Create(nil) do begin
    ComboBox1.ItemIndex := Integer(Port);
    ComboBox2.ItemIndex := Integer(BaudRate);
    ComboBox3.ItemIndex := Integer(StopBits);
    ComboBox4.ItemIndex := Integer(DataBits);
    ComboBox5.ItemIndex := Integer(Parity.Bits);
    CheckBox1.Checked := FFlowControl.OutCtsFlow;
    CheckBox2.Checked := FFlowControl.OutDsrFlow;
    CheckBox3.Checked := FFlowControl.XonXoffOut;
    CheckBox4.Checked := FFlowControl.XonXoffIn;
    RadioGroup1.ItemIndex := Integer(FFlowControl.ControlRts);
    RadioGroup2.ItemIndex := Integer(FFlowControl.ControlDtr);
    if ShowModal = mrOK then begin
      Port := TPortType(ComboBox1.ItemIndex);
      BaudRate := TBaudRate(ComboBox2.ItemIndex);
      StopBits := TStopBits(ComboBox3.ItemIndex);
      DataBits := TDataBits(ComboBox4.ItemIndex);
      Parity.FBits := TParityBits(ComboBox5.ItemIndex);
      FFlowControl.OutCtsFlow := CheckBox1.Checked;
      FFlowControl.OutDsrFlow := CheckBox2.Checked;
      FFlowControl.XonXoffOut := CheckBox3.Checked;
      FFlowControl.XonXoffIn := CheckBox4.Checked;
      FFlowControl.ControlRts := TRtsFlowControl(RadioGroup1.ItemIndex);
      FFlowControl.ControlDtr := TDtrFlowControl(RadioGroup2.ItemIndex);
    end;
    Free;
  end;
end;

procedure TComPort.SetBaudRate(Value: TBaudRate);
begin
  if Value <> FBaudRate then begin
    FBaudRate := Value;
    SetDCB;
  end;
end;

procedure TComPort.SetDataBits(Value: TDataBits);
begin
  if Value <> FDataBits then begin
    FDataBits := Value;
    SetDCB;
  end;
end;

procedure TComPort.SetDiscardNull(Value: Boolean);
begin
  if Value <> FDiscardNull then begin
    FDiscardNull := Value;
    SetDCB;
  end;
end;

procedure TComPort.SetEventChar(Value: Byte);
begin
  if Value <> FEventChar then begin
    FEventChar := Value;
    SetDCB;
  end;
end;

procedure TComPort.SetPort(Value: TPortType);
begin
  if Value <> FPort then begin
    FPort := Value;
    if FConnected then begin
      Close;
      Open;
    end;
  end;
end;

procedure TComPort.SetReadBufSize(Value: DWORD);
begin
  if Value <> FReadBufSize then begin
    FReadBufSize := Value;
    SetComm;
  end;
end;

procedure TComPort.SetStopBits(Value: TStopBits);
begin
  if Value <> FStopBits then begin
    FStopBits := Value;
    SetDCB;
  end;
end;

procedure TComPort.SetWriteBufSize(Value: DWORD);
begin
  if Value <> FWriteBufSize then begin
    FWriteBufSize := Value;
    SetComm;
  end;
end;

procedure TComPort.SetSyncMethod(Value: TSyncMethod);
begin
  if Value <> FSyncMethod then begin
    if FConnected then
      raise EComPort.Create('Cannot set SyncMethod while connected')
    else
      FSyncMethod := Value;
  end;
end;

procedure TComPort.DoOnRxChar;
begin
  if Assigned(FOnRxChar) then FOnRxChar(Self, Integer(InQue));
end;

procedure TComPort.DoOnBreak;
begin
  if Assigned(FOnBreak) then FOnBreak(Self);
end;

procedure TComPort.DoOnRing;
begin
  if Assigned(FOnRing) then FOnRing(Self);
end;

procedure TComPort.DoOnTxEmpty;
begin
  if Assigned(FOnTxEmpty) then FOnTxEmpty(Self);
end;

procedure TComPort.DoOnCTS;
begin
  if Assigned(FOnCTS) then FOnCTS(Self);
end;

procedure TComPort.DoOnDSR;
begin
  if Assigned(FOnDSR) then FOnDSR(Self);
end;

procedure TComPort.DoOnRLSD;
begin
  if Assigned(FOnRLSD) then FOnRLSD(Self);
end;

procedure TComPort.DoOnError;
begin
  if Assigned(FOnError) then FOnError(Self);
end;

procedure TComPort.DoOnRxFlag;
begin
  if Assigned(FOnRxFlag) then FOnRxFlag(Self);
end;

procedure TComPort.DoOnRx80Full;
begin
  if Assigned(FOnRx80Full) then FOnRx80Full(Self);
end;

procedure TComPort.InitOverlapped(var PO: POverlapped);
begin
  New(PO);
  FillChar(PO^, SizeOf(TOverlapped), 0);
  PO^.hEvent := CreateEvent(nil, True, False, nil);
end;

procedure TComPort.DoneOverlapped(var PO: POverlapped);
begin
  CloseHandle(PO^.hEvent);
  Dispose(PO);
end;

function TComPort.ComString: String;
begin
  case FPort of
    COM1: Result := 'COM1';
    COM2: Result := 'COM2';
    COM3: Result := 'COM3';
    COM4: Result := 'COM4';
    COM5: Result := 'COM5';
    COM6: Result := 'COM6';
    COM7: Result := 'COM7';
    COM8: Result := 'COM8';
  end;
end;

// TComPortEditor;

procedure TComPortEditor.ExecuteVerb(Index: Integer);
begin
  if Index = 0 then begin
    (Component as TComPort).ShowPropForm;
    Designer.Modified;
  end;
end;

function TComPortEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := 'Edit Properties';
  end;
end;

function TComPortEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;

procedure Register;
begin
  RegisterComponents('Dejan', [TComPort]);
  RegisterComponentEditor(TComPort, TComPortEditor);
end;

end.