{------------------------------------------------------------------------------}
{
   Unit Name: com485
   Purpose  : Delphi component for handling RS485 line.
              To be used in modbus protocol master.
   Author   : Vesa Lappalainen
   Date     : 28.12.1996
   Changed  : 07.08.2000
    - timeouts to options
    - changed due new error-system

   ToDo     :
               

   Algorithm for sending:
     1) Set DTR on
     2) Send string
     3) Wait same string received
     4) Set DTR off

   Algorithm for reading:
}
{------------------------------------------------------------------------------}

unit com485;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,
  kErrors, ExtCtrls, kComp, KParam, kinicomp, savepos, ComCtrls, kEditPnl
  ;      // MessageDlg
// {$ifndef VER120}
// type LongWord = integer;
// type cardinal = integer;
// {$endif}

{ Class Definition ------------------------------}


{ ComPort class }

type
  TCom485 = class(TForm)
    Panel1: TPanel;
    ParamBaud: TkParam;
    ParamPort: TkParam;
    SavePos1: TSavePos;
    PageControl1: TPageControl;
    TabSending: TTabSheet;
    TabTimeouts: TTabSheet;
    GroupBox1: TGroupBox;
    CBSetDTR: TkCheckBox;
    CBClearDTR: TkCheckBox;
    CBSetPrio: TkCheckBox;
    CBWaitTXEmpty: TkCheckBox;
    CBWaitSame: TkCheckBox;
    CBSetRTS: TkCheckBox;
    CBClearRTS: TkCheckBox;
    PanelButtons: TPanel;
    ButtonCancel: TButton;
    ButtonOK: TButton;
    ParamReadIntervalTimeout: TkParam;
    ParamWriteTotalTimeoutConstant: TkParam;
    ParamWriteTotalTimeoutMultiplier: TkParam;
    ParamReadTotalTimeoutConstant: TkParam;
    ParamReadTotalTimeoutMultiplier: TkParam;
    TabData: TTabSheet;
    Panel2: TPanel;
    Panel3: TPanel;
    Label1: TLabel;
    Panel4: TPanel;
    Label2: TLabel;
    Panel5: TPanel;
    Label3: TLabel;
    CBDataBits: TComboBoxIni;
    CBParity: TComboBoxIni;
    CBStopBits: TComboBoxIni;
    procedure ButtonOKClick(Sender: TObject);
    procedure ButtonCancelClick(Sender: TObject);

  private  { Private declarations }
    hPort: DWord; // LongWord; {handle from OpenComm }
    sInTerminator: ShortString; { response terminator string }
    boolExpired: Boolean; { set true when a timeout occurs }
    boolShowErrors: Boolean; { true to enable error boxes }
    boolInUse: Boolean; { true while port is blocked, waiting for response }
    writing : Boolean;
    writeover : TOverlapped;
    readover : TOverlapped;
    { Events (method pointers) user can assign code to these }
    pmOnTimeout: TNotifyEvent;	{ timeout event }
    PreferedName : string;
    PreferedBaud : integer;
    PreferedPort : integer;
//    UseName : string;
    { functions }
    procedure SetTimeout(lTimeout: LongInt);
    function GetTimeout: LongInt;
    procedure SetBaud(lBaudToSet: LongInt);
    function GetBaud: LongInt;
    procedure SetParity(lBaudToSet: LongInt);
    function GetParity: LongInt;
    procedure SetStopBits(lBaudToSet: LongInt);
    function GetStopBits: LongInt;
    function GetPort: Integer;
    procedure SetPort(nPortToSet: Integer);
    function GetInCount: LongInt;
    procedure ErrorShowMessage(const s:String);
    procedure ErrorShowDebug(const s:String);
//    function Read: ShortString;
//    procedure Close; override;

  protected
{$ifdef READ}
    function Read: ShortString;
{$endif}
  public
    { Public declarations }
    IErrors:  DWord;
    Stat : TComStat;
    function IsOpen: Boolean;
    procedure Loaded; override;
    constructor Create(AOwner: TComponent); override;
    constructor Create2(AOwner: TComponent;name:string;defport:integer=0;defbaud:integer=0); virtual;
    destructor Destroy; override;
    function OpenPort: Boolean;
    function ResetPort: Boolean;
    function Write(const sData: ShortString; const waitSt:ShortString=''): Boolean;
//    function Read: ShortString;
    function GetInCount2(var dwErrorCode:dword): LongInt;
    function ReadN(n:DWord): ShortString;
    function ReadThis(const s:ShortString): ShortString;
    function ReadThis2(const s:ShortString): ShortString;
    function WaitThis(const s:ShortString): ShortString;
    function ReadUntilThis(const s:ShortString): string;
    function ReadOne: ShortString;
    function WaitChar(c: Char; timeout: longint): boolean;
    procedure Flush;
    procedure ClosePort;
    procedure DoSetDTR(const status:boolean);
    procedure DoSetRTS(const status:boolean);
    function GetInputStatus:integer;
  published { Published declarations }
    { timeout for waiting for a response, in mS }
    property ResponseTime: LongInt read GetTimeout write SetTimeout;
    { timeout event }
    property OnTimeout: TNotifyEvent read pmOnTimeout write pmOnTimeout;
    { flag set when a timeout occured }
    property TimedOut: Boolean read boolExpired;
    property Baud: LongInt read GetBaud write SetBaud;        { baud rate }
    property StopBits: LongInt read GetStopBits write SetStopBits;
    property Parity: LongInt read GetParity write SetParity;
    property Port: Integer read GetPort write SetPort;        { COM port }
    { number of characters received }
    property InCount: LongInt read GetInCount;
    { string to signal end of input from external device }
    property EndOfResponse: ShortString read sInTerminator write sInTerminator;
    { flag to enable showing error message boxes }
    property ShowErrors: Boolean read boolShowErrors write boolShowErrors;
    { flag indicating if port is open }
    property Opened: Boolean read IsOpen;
    { flag indication if port is blocked }
    property InUse: Boolean read boolInUse;
end;

function StrToHexStr(const s:string):string;

procedure Register;

//var
//  TCom485: TTCom485;

implementation

// procedure TCom485.Close; begin inherited close; end;

{$R *.DFM}

{ Register the component with the Delphi IDE }
procedure Register;
begin
  RegisterComponents('Kave2000', [TCom485]);
end;

var ceCommError,ceCommDebug : TCommError;

function ShowComError : boolean;
begin
  Result := ( ceCommError.show or ceCommError.log );
end;

function ShowComDebug : boolean;
begin
  Result := ( ceCommDebug.show or ceCommDebug.log );
end;

function CharToHex(c:char):string;
begin
  Result := Format('%02x',[Ord(c)]);
  if ( Result[1] = ' ' ) then Result[1] := '0';
end;

function StrToHexStr(const s:string):string;
var i:integer;
begin
  Result := '';
  for i:=1 to Length(s) do
    Result := Result + CharToHex(s[i]) + ' ';
end;


{------------------------------------------------------------------------------}
procedure TCom485.ErrorShowMessage(const s:String);
begin
  if ( ShowComError )  then
    ceCommError.Add(format('Com485-%d:',[Port]) +s);
end;

{------------------------------------------------------------------------------}
procedure TCom485.ErrorShowDebug(const s:String);
begin
  if ( ShowComDebug ) then
    ceCommDebug.Add(format('Com485-%d:',[Port]) +s);
end;

{ Component constructor }
constructor TCom485.Create(AOwner: TComponent);
begin
  hPort := INVALID_HANDLE_VALUE; { invalidate to start }
  inherited Create(AOwner);
  { set default property values }
  boolExpired := False;
  boolShowErrors := True;
  boolInUse := False;
  pmOnTimeout := NIL;
  writing := False;
  writeover.hEvent := 0; //CreateEvent(NIL,TRUE,FALSE,'WriteEvent');
  readover.hEvent := 0; //CreateEvent(NIL,TRUE,FALSE,'WriteEvent');
end;

{ Component constructor }
constructor TCom485.Create2;
begin
  self.PreferedName := name;
  self.PreferedBaud := defbaud;
  self.PreferedPort := defport;
  Create(AOwner);
end;

procedure TCom485.Loaded;
begin
  if ( PreferedName <> '' ) then Name := PreferedName;
  if ( PreferedBaud <> 0 )  then Baud := PreferedBaud;
  if ( PreferedPort <> 0 )  then Port := PreferedPort;
  inherited;
end;


{ Component destructor }
destructor TCom485.Destroy;
begin
  ClosePort;                { close the com port (if open) }
  inherited Destroy;        { destroy ancestor class }
end;


procedure TCom485.SetTimeout(lTimeout: LongInt);
begin
{ Tekemättä }
end;

{ Get the current timeout setting }
function TCom485.GetTimeout: LongInt;
begin
  Result := 0;
end;

{ Return True if port is open }
function TCom485.IsOpen: Boolean;
begin
  //if hPort <> INVALID_HANDLE_VALUE then Result := True else Result := False;
  Result := (hPort <> INVALID_HANDLE_VALUE);
end;

function TCom485.GetBaud: LongInt;
begin
  Result := ParamBaud.AsInteger;
end;

{ Set the baud rate property }
procedure TCom485.SetBaud(lBaudToSet: LongInt);
begin
  if lBaudToSet = ParamBaud.Value then exit;
  ParamBaud.Value := lBaudToSet;
  if IsOpen then begin ClosePort; OpenPort; end;
end;

{ Get the Port property }
function TCom485.GetPort: Integer;
begin
  Result := ParamPort.AsInteger;
end;

{ Set the Port property }
procedure TCom485.SetPort(nPortToSet: Integer);
begin
  if nPortToSet = ParamPort.AsInteger then exit;
  ParamPort.AsInteger := nPortToSet;
  if IsOpen then begin ClosePort; OpenPort; end;
end;

{ Opens the COM port, returns True if ok }
function TCom485.OpenPort: Boolean;
var
	sCom: String;
	dcbPort: TDCB; {device control block }
	boolAbort: Boolean;
	sErrMsg: ShortString;
        tmouts : TCommTimeouts;
begin
   { init }
   Result := False;
   boolAbort := True;
   sErrMsg := '';
   //boolInUse := True;

   if IsOpen then ClosePort;

   { try to open the port }
   repeat
     sCom := 'COM' + IntToStr(Port);
     hPort := CreateFile(PChar(sCom), GENERIC_READ or GENERIC_WRITE, 0, nil,
                             OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, LongInt(0));
//                             OPEN_EXISTING, FILE_FLAG_OVERLAPPED, LongInt(0));

     if ( Not IsOpen ) and boolShowErrors then begin
       if MessageDlg('Error opening COM' + IntToStr(Port) + ': ' + sErrMsg,
           mtWarning, [mbAbort, mbRetry], 0) = idAbort then
         boolAbort := True
       else
         boolAbort := False;
       end;
     if ( Not IsOpen ) then
       ErrorShowMessage('Can not open port ' + IntToStr(Port));

   until ( IsOpen ) or (boolAbort = True);

   { set the baud rate and other parameters }
   if ( Not IsOpen ) then exit;
   if ( Not GetCommState(hPort, dcbPort) ) then exit;
   { fill in the fields of the structure }
   dcbPort.BaudRate := Baud;
   dcbPort.ByteSize := 8;
   dcbPort.Parity := Parity;
   dcbPort.StopBits := StopBits;
   dcbPort.Flags := 1; // $4801; // 0
 //  dcbPort.ErrorChar := #$aa;
   { flag bit fields:
   dcb_Binary, dcb_Parity, dcb_OutxCtsFlow, dcb_fOutxDsrFlow,
   dcb_fOutX, dcb_fInX, dcb_DtrFlow, dcb_RtsFlow
   }
   if not SetCommState(hPort, dcbPort) then begin
     MessageDlg('Error setting COM' + IntToStr(Port) + ': ' + sErrMsg,
         mtWarning, [mbAbort, mbRetry], 0);
     Exit;
   end;

   ClearCommError(hPort,IErrors,@Stat);

   GetCommTimeouts(hPort,tmouts);
    tmouts.ReadIntervalTimeout := ParamReadIntervalTimeout.AsInteger; // 100

    tmouts.ReadTotalTimeoutMultiplier := ParamReadTotalTimeoutMultiplier.AsInteger; // 20

    tmouts.ReadTotalTimeoutConstant := ParamReadTotalTimeoutConstant.AsInteger; // 500;

    tmouts.WriteTotalTimeoutMultiplier := ParamWriteTotalTimeoutMultiplier.AsInteger; // 20;
    tmouts.WriteTotalTimeoutConstant := ParamWriteTotalTimeoutConstant.AsInteger; // 500;

   SetCommTimeouts(hPort,tmouts);
   GetCommTimeouts(hPort,tmouts);
   { return True if handle is valid }
   Result := IsOpen;
   //boolInUse := False;

end;

function TCom485.ResetPort: Boolean;
var
	dcbPort: TDCB; {device control block }
begin
   Result := False;
   if ( not IsOPen ) then exit;

   if ( Not GetCommState(hPort, dcbPort) ) then exit;
   SetCommState(hPort, dcbPort);
   Result := IsOpen;
end;

{ Close the COM port }
procedure TCom485.ClosePort;
begin
  if IsOpen then CloseHandle(hPort);
  hPort := INVALID_HANDLE_VALUE;
  //boolInUse := False;
end;

(*
function CChar(const s:ShortString):PChar;
begin
  Result := @s[1];
end;
*)

{ Write a string out the COM port, return true if all chars written }
function TCom485.Write(const sData: ShortString; const waitSt:ShortString=''): Boolean;
var
  dwCharsWritten: DWord;
//  event : cardinal;
  event : dword;
  handle : integer;
  oldprio : integer;
  send : string;
//  oldprio : TThreadPriority;
begin
  { init }
  //boolInUse := True;
  dwCharsWritten := 0;
  Result := False; { default to error return }

  if Not IsOpen then exit;
  if writing then begin
    ErrorShowMessage('Already writing! -- operation aborted');
    Exit;
  end;
  writing := true;
  handle := 0;
  oldprio := 0;
  ErrorShowDebug('Write: '+StrToHexStr(sData));
  if ( CBSetDTR.Checked )      then DoSetDTR(true);
  if ( CBSetRTS.Checked )      then DoSetRTS(true);
  if ( CBWaitTXEmpty.Checked ) then SetCommMask(hPort,EV_TXEMPTY);
  if ( CBSetPrio.Checked )     then begin
    handle := GetCurrentThread;
    oldprio := GetThreadPriority(handle);
    Flush;
    SetThreadPriority(handle,THREAD_PRIORITY_TIME_CRITICAL);
  end
  else Flush;
  send := sData;// + #$00 + #$00 + #$00 ;
  WriteFile(hPort, send[1], Length(send), dwCharsWritten, nil);
//  WriteFile(hPort, sData[1], Length(sData), dwCharsWritten, @writeover);
//  WaitForSingleObject(hPort,2000);
  if dwCharsWritten = Length(sData) then Result := True
  else begin
    ErrorShowMessage(Format('Tried to write %d, could write %d:',[Length(sData),dwCharsWritten]));
    ClearCommError(hPort,IErrors,@Stat);
    IErrors := GetLastError;
  end;


//    Sleep(1);
//  WaitCommEvent(hPort,event,@writeover);
//  WaitForSingleObject(hPort,2000);
  if ( CBWaitTXEmpty.Checked ) then begin
    WaitCommEvent(hPort,event,NIL);
    SetCommMask(hPort,0);
  end;
  if ( CBWaitSame.Checked ) then ReadThis(sData);
  if ( waitSt <> '' ) then Result := ReadThis2(waitSt)=waitSt;
//    PurgeComm(hPort, PURGE_RXCLEAR); // ???
  if ( CBClearDTR.Checked ) then DoSetDTR(false);
  if ( CBClearRTS.Checked ) then DoSetRTS(false);
  if ( CBSetPrio.Checked )  then SetThreadPriority(handle,oldprio);
  writing := false;
end;

{ Return the number of bytes waiting in the queue }
function TCom485.GetInCount2(var dwErrorCode:dword): LongInt;
var
  statPort: TCOMSTAT;
  Flags : TComStateFlags;
//  dwErrorCode: DWord;
begin
  Result := 0;
  if Not IsOpen then exit;

  ClearCommError(hPort, dwErrorCode, @statPort);
  Flags := statPort.Flags;
  Result := statPort.cbInQue;
  if ( Flags <> [] ) then begin
//    Result := 5;
    dwErrorCode := dwErrorCode or $8000; // or dword(Flags);
  end;

//  ClearCommError(hPort, dwErrorCode, @statPort);
end;

{ Return the number of bytes waiting in the queue }
function TCom485.GetInCount: LongInt;
var
  statPort: TCOMSTAT;
  dwErrorCode: DWord;
begin
  Result := 0;
  if Not IsOpen then exit;

  ClearCommError(hPort, dwErrorCode, @statPort);
  Result := statPort.cbInQue;
end;

//-----------------------------------------------------------------------------
// Reads a string from the port, puts it into pchBuffer, returns the
// number of characters read
//-----------------------------------------------------------------------------
{$ifdef READ}
function TCom485.Read: ShortString;
var cbCharsAvailable, cbCharsRead: DWord;
    boolExit: Boolean;
    sBuffer: ShortString;
begin
  { init }
  Result := '';

{ check boolInUse in case of rentrancy }
  if boolInUse then begin
    if boolShowErrors then ErrorShowMessage('Port is in use -- operation aborted');
    Exit;
  end;

  if Not IsOpen then exit;
  boolInUse := True;

{ if no terminator is defined, simply read any available data and return }
  if Length(sInTerminator) = 0 then begin
//      cbCharsAvailable := GetInCount;
    cbCharsAvailable := 200;
    if cbCharsAvailable > 0 then begin
      SetLength(sBuffer, cbCharsAvailable + 1); { allocate space }
      ReadFile(hPort, sBuffer[1], cbCharsAvailable, cbCharsRead, nil);
      SetLength(sBuffer, cbCharsRead); { adjust length }
      Result := sBuffer;
    end;
  end
  else { a terminator is defined, so read port until terminator found or timed out }
  begin
    boolExit := False;
    repeat
      boolExpired := False;

      { loop until timeout or terminator recieved }
      repeat
        cbCharsAvailable := GetInCount;
        if cbCharsAvailable > 0 then begin
          if cbCharsAvailable >= Length(sBuffer) then
                  SetLength(sBuffer, cbCharsAvailable + 1); { allocate space }

          ReadFile(hPort, sBuffer[1], cbCharsAvailable, cbCharsRead, nil);

          { append chars read to end of result buffer }
          Result := Result + Copy(sBuffer, 0, cbCharsRead);
        end;

      until (boolExpired) or (boolExit);


      { If timed out, then give user a chance to retry }
      if boolExpired and boolShowErrors then
      begin
        if MessageDlg('Timeout waiting for response.', mtWarning,
           [mbAbort, mbRetry], 0) = idAbort then boolExit := True;
      end;

    until boolExit = True;
  end;
  boolInUse := False;
end;
{$endif}

function TCom485.ReadN(n:DWord): ShortString;
var sBuffer: ShortString;
    cbCharsRead: DWord;
    bok:boolean;
begin
  Result := '';
  if boolInUse then begin
    if boolShowErrors then ErrorShowMessage('Port is in use -- operation aborted');
    Exit;
  end;

  if not IsOpen then exit;

  boolInUse := True;
  bok := ReadFile(hPort, sBuffer[1], n, cbCharsRead, NIL);
  if ( not bok ) then begin
    ErrorShowDebug('Read : '+StrToHexStr(sBuffer));
  end;
//  ReadFile(hPort, sBuffer[1], n, cbCharsRead, @readover);
//  WaitForSingleObject(hPort,200);
  SetLength(sBuffer, cbCharsRead); { adjust length }
  Result := sBuffer;
  if ( cbCharsRead <> n ) then begin
    if boolShowErrors then
      ErrorShowMessage(Format('Wait %d got %d:',[n,cbCharsRead])+StrToHexStr(Result));
  end;
  if ( ShowComDebug ) then
    ErrorShowDebug('Read : '+StrToHexStr(Result));

  boolInUse := False;
end;

function TCom485.ReadThis(const s:ShortString): ShortString;
var sr,se : ShortString; i : integer;
begin
  Result := ReadN(Length(s));
  if ( Result = s ) then exit;
  sr := Result;
  for i:=1 to Length(s) div 2 do begin
    delete(sr,1,1);
    if Pos(sr,s) = 1 then begin
      se := ReadN(i);
      Result := sr + se;
      if ( Result = s ) then exit;
      break;
    end;
  end;
  if boolShowErrors then
    ErrorShowMessage('Send waiting: '+StrToHexStr(s)+' got: '+StrToHexStr(Result));
end;

// Insitua varten???
function TCom485.ReadThis2(const s:ShortString): ShortString;
var i,p,l : integer;
begin
  l := Length(s);
  Result := ReadN(l);
  if ( Pos(s,result) > 0 ) then begin
    result := s;
    exit;
  end;
  p := Pos(s[1],Result);
  if ( p = 0 ) then exit;
  delete(Result,1,p-1);
  p := Length(result);
  if ( p > l ) then begin
    delete(result,l+1,p-l);
  end
  else begin
    for i := 1 to l-p do begin
      Result := Result + ReadOne;
    end;
  end;
  if boolShowErrors then
    ErrorShowMessage('Send waiting: '+StrToHexStr(s)+' got: '+StrToHexStr(Result));
end;

function TCom485.WaitThis(const s:ShortString): ShortString;
var sr,se,old : ShortString;
begin
  Result := s;
  sr := '';
  old := '';
  se := ReadN(Length(s));
  while ( se <> '' ) do begin
    sr := sr + se;
    old := old + se;
    if ( sr = s ) then Exit;
    Delete(sr,1,1);
    se := ReadN(1);
  end;

  Result := copy(old,1,10);
  if boolShowErrors then
    ErrorShowMessage('Waiting this: '+StrToHexStr(s)+' got: '+StrToHexStr(Result));
end;

function TCom485.ReadUntilThis(const s:ShortString): string;
var
  sr,se : ShortString;
  old:string;
begin
  Result := '';
  sr := '';
  old := '';
  se := ReadN(Length(s));
  while ( se <> '' ) do begin
    sr := sr + se;
    old := old + se;
    if ( sr = s ) then begin Result:=old; Exit; end;
    Delete(sr,1,1);
    se := ReadN(1);
  end;

  Result := old;
  if boolShowErrors then
    ErrorShowMessage('Reading until this: '+StrToHexStr(s)+' got: '+StrToHexStr(Result));
end;

//******************************************************************************
// Returns true, if wanted character was received
//******************************************************************************
function TCom485.WaitChar(c: Char; timeout: longint): boolean;
var StartTime, CurrentTime: TTimeStamp;
    sBuffer: ShortString;
    cbCharsRead: DWord;
begin
  result := False;
  if boolInUse then begin
    if boolShowErrors then ErrorShowMessage('Port is in use -- operation aborted');
    Exit;
  end;
  if not IsOpen then exit;
  boolInUse := True;
  StartTime := DateTimeToTimeStamp(Now);
  CurrentTime := DateTimeToTimeStamp(Now);
  while not result and ( CurrentTime.Time -StartTime.Time < timeout )do begin
    ReadFile(hPort, sBuffer[1], 1, cbCharsRead, NIL);
    if ( cbCharsRead = 1 ) then begin
      Result := ( sBuffer[1] = c );
    end;
    CurrentTime := DateTimeToTimeStamp(Now);
  end;
  boolInUse := False;
end;


function TCom485.ReadOne: ShortString;
var cbCharsAvailable, cbCharsRead: DWord;
begin
  { init }
  Result := '';

{ check boolInUse in case of rentrancy }
  if boolInUse then begin
    if boolShowErrors then ErrorShowMessage('Port is in use -- operation aborted');
    Exit;
  end;

  if not IsOpen then exit;

  boolInUse := True;
  cbCharsAvailable := 1;
  ReadFile(hPort, Result[1], cbCharsAvailable, cbCharsRead, nil);
  SetLength(Result, cbCharsRead); { adjust length }
  if ( ShowErrors ) then ErrorShowDebug('Read: '+StrToHexStr(Result));
  boolInUse := False;
end;


{ Flush the port by reading any characters in the queue }
procedure TCom485.Flush;
begin
  if Not IsOpen then exit;
  PurgeComm(hPort, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
end;


procedure TCom485.ButtonOKClick(Sender: TObject);
begin
//  if ( IsOpen ) then begin ClosePort; OpenPort; end;
  OpenPort;
  Close;
end;

procedure TCom485.ButtonCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TCom485.DoSetDTR(const status:boolean);
begin
  if (status) then begin
    EscapeCommFunction(hPort,SETDTR);
  end else begin
    EscapeCommFunction(hPort,CLRDTR);
  end;
end;

procedure TCom485.DoSetRTS(const status:boolean);
begin
  if (status) then begin
    EscapeCommFunction(hPort,SETRTS);
  end else begin
    EscapeCommFunction(hPort,CLRRTS);
  end;
end;

function TCom485.GetInputStatus: integer;
var status : DWORD;
begin
  if ( GetCommModemStatus(hPort,status) ) then 
    Result := status
  else
    Result := -1;
end;

function TCom485.GetParity: LongInt;
begin
  Result:=NOPARITY;

  if CBParity.AsString='Even' then Result:=EVENPARITY
  else if CBParity.AsString='Odd' then Result:=ODDPARITY
  else if CBParity.AsString='None' then Result:=NOPARITY
  else if CBParity.AsString='Mark' then Result:=MARKPARITY
  else if CBParity.AsString='Space' then Result:=SPACEPARITY
  else begin  CBParity.AsString:='None'; end;

end;

function TCom485.GetStopBits: LongInt;
begin
  Result:=ONESTOPBIT;

  if CBStopBits.AsString='1' then Result:=ONESTOPBIT
  else if CBStopBits.AsString='1.5' then Result:=ONE5STOPBITS
  else if CBStopBits.AsString='2' then Result:=TWOSTOPBITS
  else begin CBStopBits.AsString:='1' end;

end;

procedure TCom485.SetParity(lBaudToSet: Integer);
begin
//
end;

procedure TCom485.SetStopBits(lBaudToSet: Integer);
begin
//
end;

initialization begin
  RegisterError(ceCommError   ,'ce', 'Communication error'    , True);
  RegisterError(ceCommDebug   ,'cd', 'Communication debug');
end;


end.