How to communicate with a com port through RS232

Problem/Question/Abstract:

I want to develop a device that communicates through RS232 with the Com1 port. I know the port is connected to IRQ4 and I know the IO address of the 8250 status and data registers. I know how to do this mission in DOS (interrupt vector), but what I do not know is how to do something like this with Window 98 system and Delphi as a programming platform.

Answer:

The DOS solution is not recommended and will not work under NT anyway. The following unit has a class for the RS232 communication:


unit ComPort;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TComPort = class(TObject)
  private
    ComID, ComError: Integer;
    DcbOld: TDCB;
    CommTimeoutsOld: TCommTimeouts;
  protected
  public
    function Open(PortNo: integer): boolean;
    procedure Close;
    function Config(Baudrate: DWORD; ByteSize, StopBits, Parity: Byte): boolean;
    function ReadBlock(var Ch: array of char; BlockSize: dword): integer;
    function ReadChar(var Ch: char): boolean;
    function WriteBlock(var Ch: array of char; BlockSize: dword): boolean;
    function WriteChar(Ch: char): boolean;
    procedure Purge;
    function Error: integer;
    constructor Create;
  published
  end;

const
  cpReadError = 1;
  cpWriteError = 2;
  cpOpenError = 3;

implementation

constructor TComPort.Create;
begin
  inherited Create;
  ComID := -1;
end;

function TComPort.Open(PortNo: integer): boolean;
var
  CommTimeouts: TCommTimeouts;
  Port: string;
begin
  Port := 'COM' + IntToStr(PortNo);
  ComID := CreateFile(pChar(Port), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, 0, 0);
  if ComID <> -1 then
  begin
    GetCommState(ComID, DcbOld);
    GetCommTimeouts(ComID, CommTimeoutsOld);
    CommTimeouts.ReadIntervalTimeout := 1;
    CommTimeouts.ReadTotalTimeoutMultiplier := 1;
    CommTimeouts.ReadTotalTimeoutConstant := 1;
    CommTimeouts.WriteTotalTimeoutMultiplier := 10;
    CommTimeouts.WriteTotalTimeoutConstant := 10;
    SetCommTimeouts(ComID, CommTimeouts);
    ComError := 0;
  end
  else
    ComError := cpOpenError;
  Result := (ComID <> -1)
end;

procedure TComPort.Close;
begin
  if ComID <> -1 then
  begin
    SetCommState(ComID, DcbOld);
    SetCommTimeouts(ComID, CommTimeoutsOld);
    CloseHandle(ComID);
  end;
  ComID := -1;
end;

function TComPort.Config(Baudrate: DWORD; ByteSize, StopBits, Parity: Byte): boolean;
var
  Dcb: TDCB;
begin
  if ComID <> -1 then
  begin
    GetCommState(ComID, Dcb);
    Dcb.Baudrate := Baudrate;
    Dcb.ByteSize := ByteSize;
    Dcb.StopBits := StopBits;
    Dcb.Parity := Parity;
    SetCommState(ComID, Dcb);
  end
  else
    ComError := cpOpenError;
  Result := (ComID <> -1)
end;

function TComPort.ReadBlock(var Ch: array of char; BlockSize: dword): integer;
var
  rdBlockSize: dword;
begin
  Result := 0;
  if ComID <> -1 then
  begin
    rdBlockSize := BlockSize;
    if not ReadFile(ComID, Ch, BlockSize, rdBlockSize, nil) then
    begin
      GetLastError;
      ComError := cpReadError;
    end
    else
      Result := rdBlockSize;
  end
  else
    ComError := cpOpenError;
end;

function TComPort.ReadChar(var Ch: char): boolean;
var
  BlockSize: dword;
begin
  Result := False;
  if ComID <> -1 then
  begin
    if not ReadFile(ComID, Ch, 1, BlockSize, nil) then
    begin
      GetLastError;
      ComError := cpReadError;
    end
    else
      Result := (BlockSize = 1);
  end
  else
    ComError := cpOpenError;
end;

function TComPort.WriteBlock(var Ch: array of char; BlockSize: dword): boolean;
var
  W: dword;
begin
  Result := False;
  if ComID <> -1 then
  begin
    if not WriteFile(ComID, Ch, BlockSize, W, nil) then
    begin
      GetLastError;
      ComError := cpWriteError;
    end
    else
      Result := (BlockSize = W)
  end
  else
    ComError := cpOpenError;
end;

function TComPort.WriteChar(Ch: char): boolean;
var
  W: dword;
begin
  Result := False;
  if ComID <> -1 then
  begin
    if not WriteFile(ComID, Ch, 1, W, nil) then
    begin
      GetLastError;
      ComError := cpWriteError;
    end
    else
      Result := (W = 1)
  end
  else
    ComError := cpOpenError;
end;

procedure TComPort.Purge;
begin
  if ComID <> -1 then
  begin
    PurgeComm(ComID, Purge_TXABORT);
    PurgeComm(ComID, Purge_RXABORT);
    PurgeComm(ComID, Purge_TXCLEAR);
    PurgeComm(ComID, Purge_RXCLEAR);
  end
  else
    ComError := cpOpenError;
end;

function TComPort.Error: integer;
begin
  Result := ComError;
  ComError := 0;
end;

end.


And this is how you use this class:


{ ... }
var
  ComPort: TComPort;

In the Form1.OnCreate event:


ComPort := TComPort.Create;
ComPort.Open(1); {for COM1}


So now you can use ComPort.Config (see in Win32 API SetCommState for the Config parameter)


ComPort.WriteBlock
ComPort.WriteChar
ComPort.ReadBlock
ComPort.ReadChar

etc.


In the Form1.OnClose event:


ComPort.Close;
ComPort.Free;