Solved

Communicating with COM Ports

Posted on 2003-11-19
6
1,679 Views
Last Modified: 2009-12-16
Hi,

I am not much that familiar with Delphi but I was wondering if any of you could help me out in this problem.

I was wondering if I could be detailed about how I can connect to the COM ports of the computer. For example I have a router connected to a COM Port. How can I connect to that port and read/send data and so on. Or I have a software that communicates with the COM port which is connected to an equipment. How can I connect to that port and read/send data through it.

I know this is going to be a little complex one. But if it isn't a bother, could you kind of help me out with some explanations.

Thanks for you help...
0
Comment
Question by:warheat001
6 Comments
 
LVL 2

Accepted Solution

by:
monir earned 25 total points
ID: 9785088

look at the following components:

Serial communication in Delphi and related components.
http://delphree.clexpert.com/pages/projects/asyncfree/AsyncFree.zip

PCPort component
http://groups.yahoo.com/group/FreeDelphiComponent/files/Ports/

hope that helps
Monir.
0
 
LVL 1

Assisted Solution

by:Binsky
Binsky earned 45 total points
ID: 9785595
Hi there,

To connect via serial port (commport), first you need to get a serial port component, and add that to your project. I'm sorry, but I can't find a link to one right now...(I could send one to you if you would like that)

When a serialport component is available, use these steps to connect/send ansd read.
- Initialize the serialport component, set the baudrate, commport to use, parity type, stopbits, databits. (If you don't know what they are, please do some research on the serialport part)
- Open the commport (this should be a procedure native to the serialport component)

- when the commport is open, you can start sending data. Usually this happens by sending the pointer to a datastream to a sendata procedure, along with the size of the data to send.
- The receiving of data is almost the same, but now you receive a pointer to the start of the received data, and the SerialPort.BytesReceived property will tell you how many bytes have been received. So it's just a matter of "walking" through the string, until you've read all bytes.

- You should of course check the data before you do anything with it, so it would be good to check if the amount of bytes received is the amount you expected, you can verify if the checksum is good, and you can verify the control part of the data (if available).

Hope this was any help, there is a lot to tell, but these were the bare essentials I guess...

Robin






0
 
LVL 8

Expert Comment

by:gmayo
ID: 9785771
You don't need a component at all.

Here's a unit I wrote which reads data off a custom trackerball. Writing to the COM port is the same principle.

unit TBall;

// Purpose: Handles trackerball interface via a comm port

{
$Log$
}

interface

uses
      Dialogs,
      Windows;

procedure TBallDone;
procedure TBallInit(comportid : string);
procedure TBallTenMSTimer;

implementation

uses
      Display,
      Globals;

var
      CommPort : THandle;                  // Handle for the comm port
      Byte1, Byte2, Byte3 : byte;      // Most recently received bytes
      ByteCount : integer;            // Number of bytes received

{---------------------------------------------------------------------------------------------------
TBallDone
---------
Purpose:        Closes the communications port
Inputs:         None
Returns:        Nothing
Preconditions:  None
Postconditions: Comm port closed if open
Actions:        If the handle is non-zero, then close the handle and zero the handle.
---------------------------------------------------------------------------------------------------}
procedure TBallDone;
begin
      if CommPort <> 0 then begin
            CloseHandle(CommPort);
            CommPort := 0;
      end;
end;

{---------------------------------------------------------------------------------------------------
TBallInit
---------
Purpose:        Initialises the communications port
Inputs:         comportid - Identity (e.g. COM2: ) of the communications port
Returns:        Nothing
Preconditions:  None
Postconditions: Comm port opened or error shown
Actions:        Open the comm port. If an error occurs then show the error. Otherwise, initialise
                the port to the appropriate speed etc.
---------------------------------------------------------------------------------------------------}
procedure TBallInit(comportid : string);
var
      dcb : TDCB;
      t : TCommTimeouts;
begin
      if CommPort <> 0 then TBallDone;
      CommPort := CreateFile(PChar(comportid), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, 0, 0);
      if CommPort <> 0 then begin
            SetupComm(CommPort, 256, 256);

            dcb.DCBlength := SizeOf(dcb);
            GetCommState(CommPort, dcb);

            dcb.BaudRate := CBR_1200;
            dcb.Parity := NOPARITY;
            dcb.ByteSize := 8;
            dcb.StopBits := ONESTOPBIT;
            SetCommState(CommPort, dcb);

            t.ReadIntervalTimeout := MAXDWORD;
            t.ReadTotalTimeoutConstant := 0;
            t.ReadTotalTimeoutMultiplier := 0;
            t.WriteTotalTimeoutMultiplier := 0;
            t.WriteTotalTimeoutConstant := 0;
            SetCommTimeouts(CommPort, t);
      end else begin
            ShowMessage('Failed to open hardware port ' + comportid + ' for trackerball. Hardware will not be available in this session.');
      end;
end;

{---------------------------------------------------------------------------------------------------
TBallTenMSTimer
---------------
Purpose:        Checks the port for activity
Inputs:         None
Returns:        Nothing
Preconditions:  Comm port opened
Postconditions: Mouse cursor moved if necessary
Actions:        Read any bytes from the comm port if open. If any are received, process them. Three
                bytes are received per movement, although not necessarily at the same time. Certain
                bit patterns in the 3 bytes denote the X and Y distance, and whether the byte is the
                first of the 3 (ie to synchronise with a triplet).
---------------------------------------------------------------------------------------------------}
procedure TBallTenMSTimer;
      procedure ProcessMouse;
      var
            {lb, rb : boolean;}
            xm, ym, xdiff : integer;
            xc, yc : shortint;
            p : TPoint;
      begin
            {$R-}
            {lb := (Byte1 and 32) = 32;      // Not used at present
            rb := (Byte1 and 16) = 16;}
            xc := ((Byte1 and 3) shl 6) + (Byte2 and 63);
            yc := ((Byte1 and 12) shl 4) + (Byte3 and 63);
                        GetCursorPos(p);
            xm := p.X + xc div 1;
            ym := p.Y - yc div 1;
            if MouseScreenBoundary then DisplayForm.MouseMoveTest(xm, ym, xdiff);
            SetCursorPos(xm, ym);
            {$R+}
      end;
var
      buf : byte;
      numread : cardinal;
begin
      if CommPort <> 0 then begin
            numread := 1;
            while (ReadFile(CommPort, buf, 1, numread, nil) = true) and (numread = 1) do begin
                  if (buf and 64) = 64 then begin
                        bytecount := 0;
                        Byte1 := buf;
                  end else if bytecount = 0 then begin
                        bytecount := 1;
                        Byte2 := buf;
                  end else if bytecount = 1 then begin
                        bytecount := 2;
                        Byte3 := buf;
                        ProcessMouse;
                  end;
            end;
      end;
end;
{--------------------------------------------------------------------------------------------------}
end.


Geoff M.
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 1

Expert Comment

by:Vihmapuu
ID: 9826271
Or, you could just open your port as a normal file.
Filenames like "COM1", "LPT1", etc. work fine with all normal file routines.
0
 
LVL 2

Expert Comment

by:TheLeader
ID: 9829173
function InPort(PortAddr: word): byte;
{$IFDEF VER90}
assembler; stdcall;
asm
        mov dx,PortAddr
        in al,dx
end;
{$ELSE}
begin
Result := Port[PortAddr];
end;
{$ENDIF}

procedure OutPort(PortAddr: word; Databyte: byte);
{$IFDEF VER90}
assembler; stdcall;
asm
   mov al,Databyte
   mov dx,PortAddr
   out dx,al
end;
{$ELSE}
begin
Port[PortAddr] := DataByte;
end;
{$ENDIF}

hope it helped ...
0
 
LVL 1

Assisted Solution

by:Binsky
Binsky earned 45 total points
ID: 9830011
GMayo is totally right, you don't need a component...Just a unit containing the Serialport functionality, which I called a component, but it isn't!

Here's the unit I use for communicating through the commport :

(You probably won't need all of it, but justy in case, I've copied the whole unit here...)

unit SerialPort;

interface

uses Windows, SysUtils;

type
  // There are 5 types of communication errors
  {the general CommError}
  ECommException = class(Exception);
  {No packet or invalid packet received}
  ECommPacketError = class(ECommException);
  {If the response is not the same, change setting failed}
  ECommPacketVerifyError = class(ECommException);

   {-----------------------------------------------------------------------
         There are 8 comports you can select from.
         The main program must use CommPortToInt() to get integer version.
   -----------------------------------------------------------------------}
  TCommPort = (cpCOM1, cpCOM2, cpCOM3, cpCOM4,
    cpCOM5, cpCOM6, cpCOM7, cpCOM8);
  { All of the baud rates that the DCB supports.}
  TBaudRate = (br110, br300, br600, br1200, br2400, br4800, br9600,
    br14400, br19200, br38400, br56000, br128000, br256000);
  { Parity types for parity error checking}
  TParityType = (pcNone, pcEven, pcOdd, pcMark, pcSpace);
  TStopBits = (sbOne, sbOnePtFive, sbTwo);
  TDataBits = (db4, db5, db6, db7, db8);
  TFlowControl = (fcNone, fcHARDWARE);

  // Set some constant defaults.
  // These are the equivalent of
  // COM1:9600,N,8,1;

// The next constants are the default parameters for the serial port
const
  dflt_CommPort = cpCOM1;
  dflt_BaudRate = br9600;
  dflt_ParityType = pcNone;
  dflt_ParityErrorChecking = False;
  dflt_ParityErrorChar = 0;
  dflt_ParityErrorReplacement = False;
  dflt_StopBits = sbOne;
  dflt_DataBits = db8;
  dflt_XONChar = $11;  {ASCII 11h}
  dflt_XOFFChar = $13; {ASCII 13h}
  dflt_XONLim = 1024;
  dflt_XOFFLim = 2048;
  dflt_ErrorChar = 0; // For parity checking.
  dflt_FlowControl = fcHARDWARE; // might not use flowcontrol...we'll see!
  dflt_StripNullChars = False;
  dflt_EOFChar = 0;




{-----------------Basic serial port class definition-------------------}
type
  TSerialPort = class(TObject)
  private
    hCommPort: THandle; // Handle to the serial port.
    fCommPort: TCommPort;
    fBaudRate: TBaudRate;
    fParityType: TParityType;
    fParityErrorChecking: boolean;
    fParityErrorChar: byte;
    fParityErrorReplacement: boolean;
    fStopBits: TStopBits;
    fDataBits: TDataBits;
    fXONChar: byte;  {0..255}
    fXOFFChar: byte; {0..255}
    fXONLim: word;  {0..65535}
    fXOFFLim: word; {0..65535}
    fErrorChar: byte;
    fFlowControl: TFlowControl;
    fStripNullChars: boolean;  // Strip null chars?
    fEOFChar: byte;
    fByteReceive: Dword;
    //   fRXBytes : DWord;
    //   fTXBytes : DWord;
    ReadBuffer: string; // Where the results from the read go to .
    procedure SetCommPort(Value: TCommPort);
    procedure SetBaudRate(Value: TBaudRate);
    procedure SetParityType(Value: TParityType);
    procedure SetParityErrorChecking(Value: boolean);
    procedure SetParityErrorChar(Value: byte);
    procedure SetParityErrorReplacement(Value: boolean);
    procedure SetStopBits(Value: TStopBits);
    procedure SetDataBits(Value: TDataBits);
    procedure SetXONChar(Value: byte);
    procedure SetXOFFChar(Value: byte);
    procedure SetXONLim(Value: word);
    procedure SetXOFFLim(Value: word);
    procedure SetErrorChar(Value: byte);
    procedure SetFlowControl(Value: TFlowControl);
    procedure SetStripNullChars(Value: boolean);
    procedure SetEOFChar(Value: byte);
    procedure Initialize_DCB;
  public
    constructor Create();
    destructor Destroy; override;
  published
    function OpenPort(MyCommPort: TCommPort): boolean;
    function ClosePort: boolean;
    procedure SendData(Data: PChar; size: DWord);
    function GetData: PChar;
    function PortIsOpen: boolean;
    procedure FlushTX;
    procedure FlushRX;
    property CommPort: TCommport     read fCommPort
                                     write SetCommPort
                                     default dflt_CommPort;
    property BaudRate: TBaudRate     read fBaudRate
                                     write SetBaudRate
                                     default dflt_BaudRate;
    property ParityType: TParityType read fParityType
                                     write SetParityType
                                     default dflt_ParityType;
    property ParityErrorChecking: boolean read fParityErrorChecking
                                     write SetParityErrorChecking
                                     default dflt_ParityErrorChecking;
    property ParityErrorChar: byte   read fParityErrorChar
                                     write SetParityErrorChar
                                     default dflt_ParityErrorChar;
    property ParityErrorReplacement: boolean read fParityErrorReplacement
                                     write SetParityErrorReplacement
                                     default dflt_ParityErrorReplacement;
    property StopBits: TStopBits     read fStopBits
                                     write SetStopBits
                                     default dflt_StopBits;
    property DataBits: TDataBits     read fDataBits
                                     write SetDataBits
                                     default dflt_DataBits;
    property XONChar: byte           read fXONChar
                                     write SetXONChar
                                     default dflt_XONChar;
    property XOFFChar: byte          read fXOFFChar
                                     write SetXOFFChar
                                     default dflt_XOFFChar;
    property XONLim: word            read fXONLim
                                     write SetXONLim
                                     default dflt_XONLim;
    property XOFFLim: word           read fXOFFLim
                                     write SetXOFFLim
                                     default dflt_XOFFLim;
    property ErrorChar: byte         read fErrorChar
                                     write SetErrorChar
                                     default dflt_ErrorChar;
    property FlowControl: TFlowControl read fFlowControl
                                     write SetFlowControl
                                     default dflt_FlowControl;
    property StripNullChars: boolean read fStripNullChars
                                     write SetStripNullChars
                                     default dflt_StripNullChars;
    property EOFChar: byte           read fEOFChar
                                     write SetEOFChar
                                     default dflt_EOFChar;
    property ByteReceive: Dword      read fByteReceive
                                     write fByteReceive;
  end;
{-----------------End of Basic serial port class-----------------------}

const
  {Up to 8 commports can be monitored at the same time}
  MaxCommPort = 8;

var
  CommPortObject: array [1..MaxCommPort] of TSerialPort;

   // Global functions
   function CommPortToInt(const CommPort: TCommPort): integer;
   function IntToCommPort(const CommPortNr: integer): TCommPort;
   function CommPortPresent(const Comm: TCommPort): boolean;

implementation

{-----------Basic SerialPort procedures and funtions start here------------}

{---------------------------------------------------------------------------
   Name     : CommPortToInt(const CommPort: TCommPort): integer;
   Function : Conversion function that returns an integer value when a valid
              commport name was given
   Input    : The commport that was selected, in the "official" format
              (cpCOM1, etc.)
   Output   : CommPortNr - integer value representing the commport
---------------------------------------------------------------------------}
function CommPortToInt(const CommPort: TCommPort): integer;
begin
  if Ord(cpCOM1) = 0 then Result := Ord(CommPort) + 1
  else
    Result := Ord(CommPort)
end;

{---------------------------------------------------------------------------
   Name     : IntToCommPort(const CommPortNr: integer): TCommPort;
   Function : Conversion function that returns a valid commport name when
              an integer value was given
   Input    : CommPortNr - integer value representing the commport
   Output   : The commport that was selected, but now in the "official" format
               (cpCOM1, etc.)
---------------------------------------------------------------------------}
function IntToCommPort(const CommPortNr: integer): TCommPort;
begin
  case CommPortNr of
    1: Result := cpCOM1;
    2: Result := cpCOM2;
    3: Result := cpCOM3;
    4: Result := cpCOM4;
    5: Result := cpCOM5;
    6: Result := cpCOM6;
    7: Result := cpCOM7;
    8: Result := cpCOM8;
    else
      raise ECommException.Create('Commport does not exist');
  end;
end;

{---------------------------------------------------------------------------
   Name     : CommPortPresent(const Comm: TCommPort): boolean;
   Function : Tries to create a commport with given name
   Input    : Comm - commport to try for
   Output   : true  - The commport was opened successfully
              false - The commport has a problem, doesn't exist, etc.
---------------------------------------------------------------------------}
function CommPortPresent(const Comm: TCommPort): boolean;
var
  SerialPort: TSerialPort;
begin
  Result := False;
  SerialPort := TSerialPort.Create;
  try
    SerialPort.OpenPort(Comm);
    if SerialPort.PortIsOpen then Result := True;
  finally
    SerialPort.ClosePort;
    SerialPort.Free;
  end;
end;



{---------------------------------------------------------------------------
   Name     : TSerialPort.OpenPort(MyCommPort: TCommPort): boolean;
   Function : Tries to open the given commport for communication
   Input    : MyCommport - cpCOM1, cpCOM2, cpCOM3, cpCOM4,
                           cpCOM5, cpCOM6, cpCOM7, cpCOM8
   Output   : true  - open was successful
              false - handle couldn't be created
---------------------------------------------------------------------------}
function TSerialPort.OpenPort(MyCommPort: TCommPort): boolean;
var
  MyPort: PChar;
begin
   // close first
   ClosePort;
   // name the commport to be opened
   MyPort := PChar('COM' + IntToStr(CommPortToInt(MyCommPort)));
   // create handle to commport
   hCommPort := CreateFile(MyPort, GENERIC_READ or GENERIC_WRITE, 0, nil,
   OPEN_EXISTING, 0, 0);
  // Initialize the port.
  Initialize_DCB;
  // Was successful if not an invalid handle.
  Result := hCommPort <> INVALID_HANDLE_VALUE;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.ClosePort: boolean;
   Function : Closes port, after flushing read/write buffers.
   Input    : -
   Output   : true  - handle is now closed
              false - handle is not closed yet, something happened
---------------------------------------------------------------------------}
function TSerialPort.ClosePort: boolean;
begin
  // flush both TX and RX buffers before closing handle
  FlushTX;
  FlushRX;
  // Close the handle to the port.
  Result := CloseHandle(hCommPort);
  hCommPort := INVALID_HANDLE_VALUE;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SendData(Data: PChar; size: DWord);
   Function : Public Send data method. Sends a character pointer, from where
              the procedure will start writing, until size is reached
   Input    : Data - pointer to the data to write (data)
              Size - size of data to write (offset)
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.SendData(Data: PChar; size: DWord);
var
  NumBytesWritten: DWord;
begin
   if hCommPort = INVALID_HANDLE_VALUE then exit;

   WriteFile(hCommPort,
       Data^,
       Size,
       NumBytesWritten,
       nil);
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.GetData: PChar;
   Function : Gets 'BytesInQueue' bytes of data from the commport. To do this
              First the comm-errors are cleared, then it checks to see if there
              are bytes waiting in the queue. Then the length is determined.
              Then it actually reads the data.
   Input    : -
   Output   : PChar - Character pointer pointing to the memory location where
                      the read character was stored (read buffer)
---------------------------------------------------------------------------}
function TSerialPort.GetData: PChar;
var
  BytesInQueue: longint;
  oStatus: TComStat;
  NumBytesRead, dwErrorCode: DWord;
begin
  fByteReceive := 0;
  Result := nil;
  if hCommPort = INVALID_HANDLE_VALUE then exit;
  // Get the total number of bytes that
  // are waiting to be read from the
  // input buffer.
  ClearCommError(hCommPort, dwErrorCode, @oStatus);
  BytesInQueue := oStatus.cbInQue;
  if BytesInQueue > 0 then
  begin
    SetLength(ReadBuffer, BytesInQueue); // + 1 is deleted 18-1-2002
    ReadFile(hCommPort,
      PChar(ReadBuffer)^,
      BytesInQueue,
      NumBytesRead,
      nil);
    SetLength(ReadBuffer, BytesInQueue);// // + 1 is deleted 18-1-2002
  end;
  fByteReceive := BytesInQueue;
  Result := PChar(ReadBuffer);
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.Create();
   Function : Creates the serialport object, and sets all parameters and
              properties to their default settings.
   Input    : -
   Output   : -
---------------------------------------------------------------------------}
constructor TSerialPort.Create();
begin
  inherited;
  // Initalize the handle to the port as
  // an invalid handle value.  We do this
  // because the port hasn't been opened
  // yet, and it allows us to test for
  // this condition in some functions,
  // thereby controlling the behavior
  // of the function.

  hCommPort := INVALID_HANDLE_VALUE;

  // Set initial settings.  Even though
  // the default parameter was specified
  // in the property, if you were to
  // create a component at runtime, the
  // defaults would not get set.  So it
  // is important to call them again in
  // the create of the component.
  fCommPort := dflt_CommPort;
  fBaudRate := dflt_BaudRate;
  fParityType := dflt_ParityType;
  fParityErrorChecking := dflt_ParityErrorChecking;
  fParityErrorChar := dflt_ParityErrorChar;
  fParityErrorReplacement := dflt_ParityErrorReplacement;
  fStopBits := dflt_StopBits;
  fDataBits := dflt_DataBits;
  fXONChar := dflt_XONChar;
  fXOFFChar := dflt_XOFFChar;
  fXONLim := dflt_XONLim;
  fXOFFLim := dflt_XOFFLim;
  fErrorChar := dflt_ErrorChar;
  fFlowControl := dflt_FlowControl;
  fStripNullChars := dflt_StripNullChars;
  fEOFChar := dflt_EOFChar;
  //  fOnTransmit := nil;
  //  fOnReceive := nil;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.Destroy;
   Function : Destroys Serialport object
   Input    : -
   Output   : -
---------------------------------------------------------------------------}
destructor TSerialPort.Destroy;
begin
  ClosePort;
  inherited;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.Initialize_DCB;
   Function : Initialize the device control block. Sets all properties needed
              for serial communication. Every serialport settings change calls
              this procedure
   Input    : -
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.Initialize_DCB;
var
  MyDCB: TDCB;
begin
  // Only want to perform the setup
  // if the port has been opened and
  // the handle assigned.
  if hCommPort = INVALID_HANDLE_VALUE then exit;

  // The GetCommState function fills in a
  // device-control block (a DCB structure)
  // with the current control settings for
  // a specified communications device.
  // (Win32 Developers Reference)
  // Get a default fill of the DCB.
  GetCommState(hCommPort, MyDCB);

  case fBaudRate of
    br110: MyDCB.BaudRate := 110;
    br300: MyDCB.BaudRate := 300;
    br600: MyDCB.BaudRate := 600;
    br1200: MyDCB.BaudRate := 1200;
    br2400: MyDCB.BaudRate := 2400;
    br4800: MyDCB.BaudRate := 4800;
    br9600: MyDCB.BaudRate := 9600;
    br14400: MyDCB.BaudRate := 14400;
    br19200: MyDCB.BaudRate := 19200;
    br38400: MyDCB.BaudRate := 38400;
    br56000: MyDCB.BaudRate := 56000;
    br128000: MyDCB.BaudRate := 128000;
    br256000: MyDCB.BaudRate := 256000;
    else
      raise Exception.Create(' No case else exception');
  end;

  // Parity error checking parameters.
  case fParityType of
    pcNone: MyDCB.Parity := NOPARITY;
    pcEven: MyDCB.Parity := EVENPARITY;
    pcOdd: MyDCB.Parity := ODDPARITY;
    pcMark: MyDCB.Parity := MARKPARITY;
    pcSpace: MyDCB.Parity := SPACEPARITY;
    else
      raise Exception.Create(' No case else exception');
  end;

  // check this.
  if fParityErrorChecking then MyDCB.Flags := MyDCB.Flags or $0002;
  if fParityErrorReplacement then MyDCB.Flags := MyDCB.Flags or $0402;
  //Set 2 parity ON & error replacement

  MyDCB.ErrorChar := char(fErrorChar);

  case fStopBits of
    sbOne: MyDCB.StopBits := ONESTOPBIT;
    sbOnePtFive: MyDCB.StopBits := ONE5STOPBITS;
    sbTwo: MyDCB.StopBits := TWOSTOPBITS;
    else
      raise Exception.Create(' No case else exception');
  end;

  case fDataBits of
    db4: MyDCB.ByteSize := 4;
    db5: MyDCB.ByteSize := 5;
    db6: MyDCB.ByteSize := 6;
    db7: MyDCB.ByteSize := 7;
    db8: MyDCB.ByteSize := 8;
    else
      raise Exception.Create(' No case else exception');
  end;

  // The 'flags' are bit flags,
  // which means that the flags
  // either turn on or off the
  // desired flow control type.
  case fFlowControl of
    // first clear all the RTS,DTR,XOFF bit and the set it on again!
    fcHARDWARE: MyDCB.Flags := (MyDCB.Flags and $FFFFCC03) or
        (DTR_CONTROL_ENABLE shl 4) or (RTS_CONTROL_TOGGLE shl 12);
    fcNone:; // Do not change a bit.
    else
      raise Exception.Create(' No case else exception');
  end;

  if fStripNullChars then inc(MyDCB.Flags, $0022);

  MyDCB.XONChar := char(fXONChar);
  MyDCB.XOFFChar := char(fXONChar);

  // The XON Limit is the number of bytes that the data in the receive buffer
  // must fall below before sending the XON character, there for resuming the
  // flow of data
  MyDCB.XONLim := fXONLim;
  // The XOFF limit is the max number of bytes that the receive buffer can
  // contain before sending the XOFF character, therefore stopping the flow
  // flow of data
  MyDCB.XOFFLim := fXOFFLim;

  // Character that signals the end of file.
  if fEOFChar <> 0 then MyDCB.EOFChar := char(EOFChar);

  // The SetCommTimeouts function sets
  // the time-out parameters for all
  // read and write operations on a
  // specified communications device.
  // (Win32 Developers Reference)
  // The GetCommTimeouts function retrieves
  // the time-out parameters for all read
  // and write operations on a specified
  // communications device.
  // GetCommTimeouts(hCommPort, MyCommTimeouts);
  // MyCommTimeouts.ReadIntervalTimeout := ...
  // MyCommTimeouts.ReadTotalTimeoutMultiplier := ...
  // MyCommTimeouts.etc...................
  // SetCommTimeouts(hCommPort, MyCommTimeouts);

  SetCommState(hCommPort, MyDCB);
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SetCommPort(Value: TCommPort);
   Function : Sets the commport to use for communication. Possible commports
              values are : cpCOM1, cpCOM2, cpCOM3, cpCOM4, cpCOM5, cpCOM6,
              cpCOM7, cpCOM8)
   Input    : value - one of the above commports
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.SetCommPort(Value: TCommPort);
begin
  if fCommPort <> Value then
  begin
    fCommPort := Value;
    Initialize_DCB;
  end;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SetBaudRate(Value: TBaudRate);
   Function : Set the baud rate. Sets the communication speed. Possible
              baud rates are : br110, br300, br600, br1200, br2400, br4800,
              br9600, br14400, br19200, br38400, br56000, br128000, br256000
   Input    : value - one of the above baudrates
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.SetBaudRate(Value: TBaudRate);
begin
  if fBaudRate <> Value then
  begin
    fBaudRate := Value;
    Initialize_DCB;
  end;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SetParityType(Value: TParityType);
   Function : Set the parity check type. Possible types are :
              - pcNone, no parity checking
              - pcEven, check for even parity
              - pcOdd, check for odd parity
              - pcMark, is always set, don't use!
              - pcSpace, is never set, don't use!
   Input    : value - one of the above parity types
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.SetParityType(Value: TParityType);
begin
  if fParityType <> Value then
  begin
    fParityType := Value;
    Initialize_DCB;
  end;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SetParityErrorChecking(Value: boolean);
   Function : Do we want to do parity error checking?
   Input    : true  - parity checking is needed
              false - parity checking is not needed
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.SetParityErrorChecking(Value: boolean);
begin
  if fParityErrorChecking <> Value then
  begin
    fParityErrorChecking := Value;
    Initialize_DCB;
  end;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SetParityErrorChar(Value: byte);
   Function : Set a character to represent a parity error
   Input    : value - byte value (char) to use as an error
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.SetParityErrorChar(Value: byte);
begin
  if fParityErrorChar <> Value then
  begin
    fParityErrorChar := Value;
    Initialize_DCB;
  end;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SetParityErrorReplacement(Value: boolean);
   Function : Set to determine if parity errors are replaced with error char
   Input    : value - true  if replacement is neccessary
                      false if replacement is not needed
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.SetParityErrorReplacement(Value: boolean);
begin
  if fParityErrorReplacement <> Value then
  begin
    fParityErrorReplacement := Value;
    Initialize_DCB;
  end;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SetStopBits(Value: TStopBits);
   Function : Set the amount of stop bits
              Possible values are : sbOne, sbOnePtFive, sbTwo
   Input    : value - one of the 3 possible values for stopbits
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.SetStopBits(Value: TStopBits);
begin
  if fStopBits <> Value then
  begin
    fStopBits := Value;
    Initialize_DCB;
  end;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SetDataBits(Value: TDataBits);
   Function : Set which bits are to be used as data bits.
              Possible values are : db4, db5, db6, db7, db8
   Input    : value - one or more of the above databits
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.SetDataBits(Value: TDataBits);
begin
  if fDataBits <> Value then
  begin
    fDataBits := Value;
    Initialize_DCB;
  end;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SetXONChar(Value: byte);
   Function : Set the XON Char. The XON character is the character that is
              generated to start the flow of data when the buffer is ready
              to receive more data
   Input    : value - the new XON character
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.SetXONChar(Value: byte);
begin
  if fXONChar <> Value then
  begin
    fXONChar := Value;
    Initialize_DCB;
  end;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SetXOFFChar(Value: byte);
   Function : Set the XOFF Char. The XOFF character is the character that is
              generated to stop the flow of data, because the buffer is full
   Input    : Value - the new XOFF character
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.SetXOFFChar(Value: byte);
begin
  if fXOFFChar <> Value then
  begin
    fXOFFChar := Value;
    Initialize_DCB;
  end;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SetXONLim(Value: word);
   Function : Set the XON Limit. The XON Limit is the number of bytes that
              the data in the receive buffer must fall below before sending
              the XON character, there for resuming the flow of data.
   Input    : Value - the new limit for XON
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.SetXONLim(Value: word);
begin
  if fXONLim <> Value then
  begin
    fXONLim := Value;
    Initialize_DCB;
  end;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SetXOFFLim(Value: word);
   Function : Set the XOFF Limit. The XOFF limit is the max number of bytes
              that the receive buffer can contain before sending the XOFF
              character, therefore stopping the flow of data.
   Input    : Value - the new limit for XOFF
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.SetXOFFLim(Value: word);
begin
  if fXOFFLim <> Value then
  begin
    fXOFFLim := Value;
    Initialize_DCB;
  end;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SetErrorChar(Value: byte);
   Function : Set the character that represents an error
   Input    : Value - byte representing an error
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.SetErrorChar(Value: byte);
begin
  if fErrorChar <> Value then
  begin
    fErrorChar := Value;
    Initialize_DCB;
  end;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SetFlowControl(Value: TFlowControl);
   Function : Set the type of flow control desired. Possible flowcontrol
   Input    : values are :
              fcNone     - No flow control
              fcHARDWARE - Hardware flow control
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.SetFlowControl(Value: TFlowControl);
begin
  if fFlowControl <> Value then
  begin
    fFlowControl := Value;
    Initialize_DCB;
  end;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SetStripNullChars(Value: boolean);
   Function : Do we want to strip off the null characters?
   Input    : true  - strip nullchar
              false - don't strip nullchar
   Output   :
---------------------------------------------------------------------------}
procedure TSerialPort.SetStripNullChars(Value: boolean);
begin
  if fStripNullChars <> Value then
  begin
    fStripNullChars := Value;
    Initialize_DCB;
  end;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.SetEOFChar(Value: byte);
   Function : Set the EOF char to the value given to this procedure
   Input    : Value - a byte representing the end-of-file character
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.SetEOFChar(Value: byte);
begin
  if fEOFChar <> Value then
  begin
    fEOFChar := Value;
    Initialize_DCB;
  end;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.PortIsOpen: boolean;
   Function : Public function to check if the commport is open. Checks if the
              handle to the commport is initialized ok
   Input    : -
   Output   : true  - port is open if the hCommPort (handle) is something
                      other then INVALID_HANDLE_VALUE
              false - hCommPort (handle) is same as INVALID_HANDLE_VALUE
---------------------------------------------------------------------------}
function TSerialPort.PortIsOpen: boolean;
begin
  Result := hCommPort <> INVALID_HANDLE_VALUE;
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.FlushRx;
   Function : Public method to cancel communication and flush the receive
              buffer
   Input    : -
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.FlushRx;
begin
  if hCommPort = INVALID_HANDLE_VALUE then exit;
  PurgeComm(hCommPort, PURGE_RXABORT or PURGE_RXCLEAR);
  ReadBuffer := '';
end;

{---------------------------------------------------------------------------
   Name     : TSerialPort.FlushTx;
   Function : Public method to cancel communication and flush the transmit
              buffer
   Input    : -
   Output   : -
---------------------------------------------------------------------------}
procedure TSerialPort.FlushTx;
begin
  if hCommPort = INVALID_HANDLE_VALUE then exit;
  PurgeComm(hCommPort, PURGE_TXABORT or PURGE_TXCLEAR);
end;

end.
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now