unit CommFrm;
{$I DEFINE.PAS}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  CommInt, StdCtrls, ComCtrls, {v0.39}UtlType{/v0.39 ConfType},
  BinHex, Fileu, PropUtl;

type
  {v0.64}
  TOnRxChar = procedure(Buffer: PByteArray; Count: integer) of object;
  {/v0.64}
  TCommForm = class(TForm)
    CommPort: TComm;
    EventLogMemo: TMemo;
    DataLogMemo: TMemo;
    ButtonOpen: TButton;
    ButtonClose: TButton;
    ButtonReset: TButton;
    EditTransmit: TEdit;
    CheckBoxAddLinefeed: TCheckBox;
    ButtonTransmit: TButton;
    StatusBar1: TStatusBar;
    LabelBaudrate: TLabel;
    LabelDataBits: TLabel;
    LabelStopbits: TLabel;
    LabelParity: TLabel;
    ComboBaudrate: TComboBox;
    ComboDatabits: TComboBox;
    ComboStopbits: TComboBox;
    ComboParity: TComboBox;
    Button1: TButton;
    LabelDevName: TLabel;
    EditDevName: TEdit;
    CheckBoxRTS: TCheckBox;
    CheckBoxDTR: TCheckBox;
    CheckBoxBREAK: TCheckBox;
    CheckBoxXON: TCheckBox;
    ComInfoButton: TButton;
    FlowControlComboBox: TComboBox;
    FlowControlLabel: TLabel;
    GroupBox1: TGroupBox;
    ParityCheckBox: TCheckBox;
    DSRSensCheckBox: TCheckBox;
    IgnoreXOffCheckBox: TCheckBox;
    ErrorCharCheckBox: TCheckBox;
    NullStripCheckBox: TCheckBox;
    AbortOnErrorCheckBox: TCheckBox;
    LogToFileCheckBox: TCheckBox;
    HexaCheckBox: TCheckBox;
    LogFileNameEdit: TEdit;
    RepeatCountEdit: TEdit;
    Label1: TLabel;
    LineLenEdit: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    RTSOnOpenComboBox: TComboBox;
    DTROnOpenComboBox: TComboBox;
    BreakOnOpenComboBox: TComboBox;
    XOnOnOpenComboBox: TComboBox;
    SendHexaCheckBox: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure ButtonOpenClick(Sender: TObject);
    procedure ButtonCloseClick(Sender: TObject);
    procedure ButtonResetClick(Sender: TObject);
    procedure ButtonTransmitClick(Sender: TObject);
    procedure CommPortRxChar(Sender: TObject; Count: Integer);
    procedure CommPortRxFlag(Sender: TObject);
    procedure CommPortTxEmpty(Sender: TObject);
    procedure CommPortBreak(Sender: TObject);
    procedure CommPortCts(Sender: TObject);
    procedure CommPortDsr(Sender: TObject);
    procedure CommPortError(Sender: TObject; Errors: Integer);
    procedure CommPortRing(Sender: TObject);
    procedure CommPortRlsd(Sender: TObject);
    procedure ComboBaudrateChange(Sender: TObject);
    procedure ComboDatabitsChange(Sender: TObject);
    procedure ComboStopbitsChange(Sender: TObject);
    procedure ComboParityChange(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ComInfoButtonClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FlowControlComboBoxChange(Sender: TObject);
    procedure ParityCheckBoxClick(Sender: TObject);
    procedure DSRSensCheckBoxClick(Sender: TObject);
    procedure IgnoreXOffCheckBoxClick(Sender: TObject);
    procedure ErrorCharCheckBoxClick(Sender: TObject);
    procedure NullStripCheckBoxClick(Sender: TObject);
    procedure AbortOnErrorCheckBoxClick(Sender: TObject);
    procedure LogToFileCheckBoxClick(Sender: TObject);
    procedure CheckBoxRTSMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure CheckBoxDTRMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure CheckBoxBREAKMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure CheckBoxXONMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RepeatCountEditExit(Sender: TObject);
    procedure LineLenEditExit(Sender: TObject);
    procedure RTSOnOpenComboBoxChange(Sender: TObject);
    procedure DTROnOpenComboBoxChange(Sender: TObject);
  private
    LineData: string;
    LineLen:integer;
    FS:TFileStream;
    RepeatCount:longint;
    ReceivedCount: longint;
    {v0.64}
    FOnRxChar: TOnRxChar;
    {/v0.64}
    procedure HandleException(Sender: TObject; E: Exception);
    procedure ComToControls;
    procedure LogToFileStart;
    procedure LogToFileStop;
    procedure EnableEscapes(onOff:boolean);
    procedure WriteConfig;
  public
    { Public declarations }
    property OnRxChar: TOnRxChar read FOnRxChar write FOnRxChar;
  end;

var
  CommForm: TCommForm;

implementation
uses cominfo;
{$R *.DFM}

const
  OnOff: array[0..1] of string = ('Off', 'On');
  DefLineLen = 32;

procedure TCommForm.EnableEscapes(onOff:boolean);
begin
  CheckBoxRTS.Enabled := onoff;
  CheckBoxDTR.Enabled := onoff;
  CheckBoxBREAK.Enabled := onoff;
  CheckBoxXON.Enabled := onoff;
end;

procedure TCommForm.FormCreate(Sender: TObject);
var
  lastcom: shortstring;
begin
  Application.OnException := HandleException;

  lastcom := CommPort.DeviceName;
  ConfigReadWriteValue(nil, rwRead, 'WinCom','LastCOM',@lastcom, ptString);
  CommPort.DeviceName := lastcom;

  ReadWriteComConfig(rwRead, CommPort);
  EnableEscapes(false);
  FS := nil;
  LineData := '';
  LineLen := DefLineLen;
  ComToControls;
end;

procedure TCommForm.ComToControls;
begin
{
  with ComboBaudrate do
    ItemIndex := Items.IndexOf('cbr38400');
  with ComboDataBits do
    ItemIndex := Items.IndexOf('da8');
  with ComboParity do
    ItemIndex := Items.IndexOf('paNone');
  with ComboStopbits do
    ItemIndex := Items.IndexOf('sb10');

  CommPort.BaudRate := TBaudrate(ComboBaudrate.ItemIndex);
  CommPort.Databits := TDataBits(ComboDatabits.ItemIndex);
  CommPort.Parity := TParity(ComboParity.ItemIndex);
  CommPort.StopBits := TStopBits(ComboStopbits.ItemIndex);
}
  ComboBaudrate.ItemIndex := integer(CommPort.BaudRate);
  ComboDatabits.ItemIndex := integer(CommPort.Databits);
  ComboParity.ItemIndex := integer(CommPort.Parity);
  ComboStopbits.ItemIndex := integer(CommPort.StopBits);
  FlowControlComboBox.ItemIndex := integer(CommPort.FlowControl);
  EditDevName.Text := CommPort.DeviceName;
  ParityCheckBox.Checked := coParityCheck in CommPort.Options;
  DSRSensCheckBox.Checked := coDSRSensitivity in CommPort.Options;
  IgnoreXOffCheckBox.Checked := coIgnoreXOff in CommPort.Options;
  ErrorCharCheckBox.Checked := coErrorChar in CommPort.Options;
  NullStripCheckBox.Checked := coNullStrip in CommPort.Options;
  AbortOnErrorCheckBox.Checked := coAbortOnError in CommPort.Options;
  if CommPort.Enabled then begin
    CheckBoxRTS.Checked := CommPort.RTSState = esOn;
    CheckBoxBreak.Checked := CommPort.BreakState = esOn;
    CheckBoxXOn.Checked := CommPort.XOnState = esOn;
    CheckBoxDTR.Checked := CommPort.DTRState = esOn;
  end;
  {v0.21}
  RTSOnOpenComboBox.ItemIndex := integer(CommPort.RTSOnOpen);
  DTROnOpenComboBox.ItemIndex := integer(CommPort.DTROnOpen);
  BreakOnOpenComboBox.ItemIndex := integer(CommPort.BreakOnOpen);
  XOnOnOpenComboBox.ItemIndex := integer(CommPort.XOnOnOpen);
  {/v0.21}
end;

procedure TCommForm.HandleException(Sender: TObject; E: Exception);
begin
  if E is ECommError then    {getlasterror}
    with E as ECommError do
      ShowMessage('Async32 error: ' + Message);
end;

procedure TCommForm.ButtonOpenClick(Sender: TObject);
begin
  if EditDevName.Text <> CommPort.DeviceName then
  begin
    CommPort.DeviceName := EditDevName.Text;
    ReadWriteComConfig(rwRead, CommPort);
    {ComToControls;}
  end;
  ReceivedCount := 0;
{  ComToControls;}
  CommPort.Open;
  EnableEscapes(true);
  {if CommPort.AfterOpenState = aoDefault then}
  ComToControls;
{  if CommPort.RTSOnOnOpen then
    CommPort.SetRTSState(true);
  if CommPort.DTROnOnOpen then
    CommPort.SetDTRState(true);}
  EventLogMemo.Lines.add('Device ready: ' + CommPort.DeviceName + ' DCBFlags=' + CommPort.DCBFlags);
  ButtonOpen.Enabled := false;
  ButtonClose.Enabled := true;
//EventLogMemo.Lines.add(GetProviderSubtypeName(CommPort.ProviderSubtype));
//UpdateControls;
end;

procedure TCommForm.ButtonCloseClick(Sender: TObject);
begin
  EnableEscapes(false);
  CommPort.Close;
  {v0.21}
  WriteConfig;
  {/v0.21}
  EventLogMemo.Lines.Add('Device closed: ' + CommPort.DeviceName);
  ButtonOpen.Enabled := true;
  ButtonClose.Enabled := false;
end;

procedure TCommForm.WriteConfig;
var lastcom: shortstring;
begin
  ReadWriteComConfig(rwWrite, CommPort);
  lastcom := CommPort.DeviceName;
  ConfigReadWriteValue(nil, rwWrite, 'WinCom','LastCOM',@lastcom, ptString);

  ReadWriteComConfig(rwWrite, CommPort);
end;

procedure TCommForm.ButtonResetClick(Sender: TObject);
begin
  EventLogMemo.Lines.Clear;
  DataLogMemo.Lines.Clear;
  ReceivedCount := 0;
end;

procedure TCommForm.ButtonTransmitClick(Sender: TObject);
var
  S: string;
  Count: Integer;
begin
  S := EditTransmit.Text;
  if SendHexaCheckBox.Checked then begin
    S := HexToString(S);
  end;
  if CheckBoxAddLinefeed.Checked then
    S := S + #13#10;
  Count := Length(S);
  {}
  //CommPort.SetRTSState(false);
  //CommPort.SetDTRState(false);
  {}
  Count := CommPort.Write(S[1], Count);
  if Count = -1 then begin
    EventLogMemo.Lines.add('Error writing to: ' + CommPort.DeviceName)
  end else begin
    EventLogMemo.Lines.add('Transmitting ' + IntToStr(Count) + ' characters');
    {}
    //CommPort.SetRTSState(true);
    //CommPort.SetDTRState(true);
    {}
  end;
end;

procedure TCommForm.CommPortRxChar(Sender: TObject; Count: Integer);
type
  CharBuf = array[0..9999] of Char;
var
  Buffer: ^CharBuf;
  Bytes, P: Integer;
  shouldIgnore, shouldLF:boolean;

  procedure AddLineData;
  begin
    DataLogMemo.Lines.Add(LineData);
    LineData := '';
  end;

begin
  if not CommPort.Enabled then
    exit;
  GetMem(Buffer, CommPort.ReadBufSize);
  try
    EventLogMemo.Lines.add('RxChar signal detected...');
    Fillchar(Buffer^, CommPort.ReadBufSize, 0);
    Bytes := CommPort.Read(Buffer^, Count);
    if Bytes = -1 then
      EventLogMemo.Lines.add('Error reading incoming data...')
    else
    begin
      if FS <> nil then
        FS.Write(Buffer^, Bytes);
      {v0.64}
      if Assigned(FOnRxChar) then begin
        FOnRxChar(PByteArray(Buffer), Bytes);{pbytearray}
      end;
      {/v0.64}

      EventLogMemo.Lines.add('Reading ' + IntToStr(Bytes) + ' characters');
      for P := 0 to Bytes - 1 do
      begin
        inc(ReceivedCount);
        shouldIgnore := false;
        shouldLF := false;

        if not HexaCheckBox.Checked then begin
          case Buffer^[P] of
            #0, #10: shouldIgnore := true;
            #13: begin
              shouldIgnore := true;
              shouldLF := true;
            end;
          end;
        end;

        if ReceivedCount = RepeatCount then begin
          ReceivedCount := 0;
          shouldLF := true;
        end;

        if HexaCheckBox.Checked then begin
          LineData := LineData + ByteToHex(byte(CharBuf(Buffer^)[P]));
        end else begin
          if shouldIgnore then
            LineData := LineData + ' '
          else
            LineData := LineData + CharBuf(Buffer^)[P];
        end;
        if (length(LineData) >= LineLen) or shouldLF then
          AddLineData;
      end; //for do
    end;

    Application.ProcessMessages;
  finally
    FreeMem(Buffer);
  end;
end;

procedure TCommForm.CommPortRxFlag(Sender: TObject);
begin
  EventLogMemo.Lines.add('RxFlag signal detected...');
end;

procedure TCommForm.CommPortTxEmpty(Sender: TObject);
begin
  EventLogMemo.Lines.add('TxEmpty signal detected...');
end;

procedure TCommForm.CommPortBreak(Sender: TObject);
begin
  EventLogMemo.Lines.add('Break signal detected...');
end;

procedure TCommForm.CommPortCts(Sender: TObject);
begin
  EventLogMemo.Lines.add('CTS: ' + OnOff[ord(CommPort.CTS)]);
end;

procedure TCommForm.CommPortDsr(Sender: TObject);
begin
  EventLogMemo.Lines.add('DSR: ' + OnOff[ord(CommPort.DSR)]);
end;

procedure TCommForm.CommPortRing(Sender: TObject);
begin
  EventLogMemo.Lines.add('RING: ' + OnOff[ord(CommPort.Ring)]);
end;

procedure TCommForm.CommPortRlsd(Sender: TObject);
begin
  EventLogMemo.Lines.add('RLSD: ' + OnOff[ord(CommPort.RLSD)]);
end;

procedure TCommForm.CommPortError(Sender: TObject; Errors: Integer);
begin
  if (Errors and CE_BREAK > 0) then
    EventLogMemo.Lines.add('The hardware detected a break condition.');
  if (Errors and CE_DNS > 0) then
    EventLogMemo.Lines.add('Windows 95 only: A parallel device is not selected.');
  if (Errors and CE_FRAME > 0) then
    EventLogMemo.Lines.add('The hardware detected a framing error.');
  if (Errors and CE_IOE > 0) then
    EventLogMemo.Lines.add('An I/O error occurred during communications with the device.');
  if (Errors and CE_MODE > 0) then
  begin
    EventLogMemo.Lines.add('The requested mode is not supported, or the hFile parameter');
    EventLogMemo.Lines.add('is invalid. If this value is specified, it is the only valid error.');
  end;
  if (Errors and CE_OOP > 0) then
    EventLogMemo.Lines.add('Windows 95 only: A parallel device signaled that it is out of paper.');
  if (Errors and CE_OVERRUN > 0) then
    EventLogMemo.Lines.add('A character-buffer overrun has occurred. The next character is lost.');
  if (Errors and CE_PTO > 0) then
    EventLogMemo.Lines.add('Windows 95 only: A time-out occurred on a parallel device.');
  if (Errors and CE_RXOVER > 0) then
  begin
    EventLogMemo.Lines.add('An input buffer overflow has occurred. There is either no');
    EventLogMemo.Lines.add('room in the input buffer, or a character was received after');
    EventLogMemo.Lines.add('the end-of-file (EOF) character.');
  end;
  if (Errors and CE_RXPARITY > 0) then
    EventLogMemo.Lines.add('The hardware detected a parity error.');
  if (Errors and CE_TXFULL > 0) then
  begin
    EventLogMemo.Lines.add('The application tried to transmit a character, but the output');
    EventLogMemo.Lines.add('buffer was full.');
  end;
end;

procedure TCommForm.ComboBaudrateChange(Sender: TObject);
begin
  CommPort.BaudRate := TBaudrate(ComboBaudrate.ItemIndex);
  EventLogMemo.Lines.add('Baudrate: ' + ComboBaudrate.Text);
end;

procedure TCommForm.ComboDatabitsChange(Sender: TObject);
begin
  CommPort.Databits := TDataBits(ComboDatabits.ItemIndex);
  EventLogMemo.Lines.add('Databits: ' + ComboDatabits.Text);
end;

procedure TCommForm.ComboStopbitsChange(Sender: TObject);
begin
  CommPort.StopBits := TStopBits(ComboStopbits.ItemIndex);
  EventLogMemo.Lines.add('StopBits: ' + ComboStopbits.Text);
end;

procedure TCommForm.ComboParityChange(Sender: TObject);
begin
  CommPort.Parity := TParity(ComboParity.ItemIndex);
  EventLogMemo.Lines.add('Parity: ' + ComboParity.Text);
end;

procedure TCommForm.Button1Click(Sender: TObject);
var
  I: Integer;
  S: string;
begin
  if MessageDlg('This will sent the input a thousand times, continue?',
    mtConfirmation, [mbOk, mbCancel], 0) <> mrOk then exit;
  S := EditTransmit.Text;
  if CheckBoxAddLinefeed.Checked then
    S := S + #13#10;
  for I := 0 to 1000 do
  begin
    CommPort.Write(S[1], Length(S));
    application.ProcessMessages;
  end;
end;

procedure TCommForm.ComInfoButtonClick(Sender: TObject);
begin
  ShowPortInfo(CommPort);
end;

procedure TCommForm.FormDestroy(Sender: TObject);
begin
{  ReadWriteComConfig(rwWrite, CommPort);}
end;

procedure TCommForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if CommPort <> nil then begin
    if CommPort.Enabled then
      CommPort.Close;
    WriteConfig;
  end;
end;

procedure TCommForm.FlowControlComboBoxChange(Sender: TObject);
begin
  CommPort.FlowControl := TFlowControl(FlowControlComboBox.ItemIndex);
  EventLogMemo.Lines.add('FlowControl: ' + FlowControlComboBox.Text + ' DCBFlags=' + CommPort.DCBFlags);
end;

procedure TCommForm.ParityCheckBoxClick(Sender: TObject);
var op:TCommOptions;
begin
  op := CommPort.Options;
  if ParityCheckBox.Checked then
    Include(op, coParityCheck)
  else
    Exclude(op, coParityCheck);
  CommPort.Options := op;
end;

procedure TCommForm.DSRSensCheckBoxClick(Sender: TObject);
var op:TCommOptions;
begin
  op := CommPort.Options;
  if DSRSensCheckBox.Checked then
    Include(op, coDSRSensitivity)
  else
    Exclude(op, coDSRSensitivity);
  CommPort.Options := op;
end;

procedure TCommForm.IgnoreXOffCheckBoxClick(Sender: TObject);
var op:TCommOptions;
begin
  op := CommPort.Options;
  if IgnoreXOffCheckBox.Checked then
    Include(op, coIgnoreXOff)
  else
    Exclude(op, coIgnoreXOff);
  CommPort.Options := op;
end;

procedure TCommForm.ErrorCharCheckBoxClick(Sender: TObject);
var op:TCommOptions;
begin
  op := CommPort.Options;
  if ErrorCharCheckBox.Checked then
    Include(op, coErrorChar)
  else
    Exclude(op, coErrorChar);
  CommPort.Options := op;
end;

procedure TCommForm.NullStripCheckBoxClick(Sender: TObject);
var op:TCommOptions;
begin
  op := CommPort.Options;
  if NullStripCheckBox.Checked then
    Include(op, coNullStrip)
  else
    Exclude(op, coNullStrip);
  CommPort.Options := op;
end;

procedure TCommForm.AbortOnErrorCheckBoxClick(Sender: TObject);
var op:TCommOptions;
begin
  op := CommPort.Options;
  if AbortOnErrorCheckBox.Checked then
    Include(op, coAbortOnError)
  else
    Exclude(op, coAbortOnError);
  CommPort.Options := op;
end;

procedure TCommForm.LogToFileStart;
begin
  EraseFile(trim(LogFileNameEdit.Text));
  FS := TFileStream.Create(trim(LogFileNameEdit.Text), fmCreate);
  FS.Seek(0, soFromEnd);
end;

procedure TCommForm.LogToFileStop;
begin
  if FS <> nil then
    FS.Free;
  FS := nil;
end;

procedure TCommForm.LogToFileCheckBoxClick(Sender: TObject);
begin
  if LogToFileCheckBox.Checked then
    LogToFileStart
  else
    LogToFileStop;
end;

procedure TCommForm.CheckBoxRTSMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  CommPort.SetRTSState(CheckBoxRTS.Checked);
end;

procedure TCommForm.CheckBoxDTRMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  CommPort.SetDTRState(CheckBoxDTR.Checked);
end;

procedure TCommForm.CheckBoxBREAKMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   CommPort.SetBREAKState(CheckBoxBREAK.Checked);
end;

procedure TCommForm.CheckBoxXONMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  CommPort.SetXONState(CheckBoxXON.Checked);
end;

procedure TCommForm.RepeatCountEditExit(Sender: TObject);
begin
  RepeatCount := StrToInt(RepeatCountEdit.Text);
end;

procedure TCommForm.LineLenEditExit(Sender: TObject);
begin
  LineLen := StrToInt(LineLenEdit.Text);
  if LineLen = 0 then
    LineLen := DefLineLen;
end;

procedure TCommForm.RTSOnOpenComboBoxChange(Sender: TObject);
begin
  CommPort.RTSOnOpen := TCommEscapeState(RTSOnOpenComboBox.ItemIndex);
end;

procedure TCommForm.DTROnOpenComboBoxChange(Sender: TObject);
begin
  CommPort.DTROnOpen := TCommEscapeState(DTROnOpenComboBox.ItemIndex);

end;

end.
