From: Tomislav Karda (nomail@sorry)
Subject: Re: Serial Port Baud Rate
Newsgroups: borland.public.delphi.winapi
Date: 1999/11/04


Hi there!

On Thu, 4 Nov 1999 10:03:52 -0600, "Anthony Walter"
<sysrpl@hotmail.com> wrote:

>Of course all this stuff is SCREAMING for an object wrapper so I thought
>this might help get you started with a class interface declaration ...

I have some comm port component if that might help, better than start
from nothing ...

unit Comm;

interface

uses
        Windows,
  Classes,
  ExtCtrls,
  SysUtils,
  Forms,
  Dialogs,
  Graphics,
  Controls,
  Buttons,
  StdCtrls;

type
        TComm = class(TComponent)

        private
        { Private declarations }
                FHandle: LongInt; {handle from OpenComm }
                FPort: Integer; { port #, 1-based }
                FBaud: LongInt; { baud rate }

    FRtsOn: boolean;
    FDtrOn: boolean;

                function IsOpen: Boolean;
                procedure SetBaud(BaudToSet: LongInt);
                procedure SetPort(PortToSet: Integer);
                procedure SetRtsOn(OnOff: boolean);
                procedure SetDtrOn(OnOff: boolean);
                function GetInCount: LongInt;
                function GetOutCount: LongInt;

        protected
                { Protected declarations }

        public
        { Public declarations }
                constructor Create(AOwner: TComponent); override;
                destructor Destroy; override;
                function Open: Boolean;
                function WriteByte(ch: byte): boolean;
                function WriteData(var data; size: integer): boolean;
                function ReadByte: byte;
                function ReadData(var data; size: integer): integer;
                procedure Flush;
                procedure Close;

        published
        { Published declarations }
                property Port: Integer read FPort write SetPort;
                property Baud: LongInt read FBaud write SetBaud;
                property InCount: LongInt read GetInCount;                              // number of
characters received
                property OutCount: LongInt read GetOutCount;                    // number of
characters pending on transmit
                property Active: Boolean read IsOpen;                                                   // is port open
                property RtsOn: Boolean read FRtsOn write SetRtsOn;
                property DtrOn: Boolean read FDtrOn write SetDtrOn;
end;

procedure Register;

function MsecTime: longint;
procedure Delay(msec: longint);

implementation

// Register the component with the Delphi IDE
procedure Register;
begin
        RegisterComponents('SUP', [TComm]);
end;

function MsecTime: longint;
var
  Present: TDateTime;
  Hour, Min, Sec, MSec: Word;
begin
  Present := Now;
  DecodeTime(Present, Hour, Min, Sec, MSec);
  Result := ((((Hour * 60) + Min) * 60) + Sec) * 1000 + MSec;
end;

procedure Delay(msec: longint);
var
        nTimeOut: longint;
begin
  nTimeOut := MsecTime + msec;
  while MsecTime < nTimeOut do
        Application.ProcessMessages();
end;

// Component constructor
constructor TComm.Create(AOwner: TComponent);
begin
        inherited Create(AOwner);
        // set default property values
        FHandle := INVALID_HANDLE_VALUE;
        FPort := 1;
        FBaud := 9600;
        FRtsOn  := false;
  FDtrOn := false;
end;

// Component destructor
destructor TComm.Destroy;
begin
        // close the com port (if open)
        Close;
        inherited Destroy;
end;

// Return True if port is open
function TComm.IsOpen: Boolean;
begin
        Result := (FHandle <> INVALID_HANDLE_VALUE);
end;

// Set the baud rate property
procedure TComm.SetBaud(BaudToSet: LongInt);
begin
        if BaudToSet <> FBaud then
        begin
                FBaud := BaudToSet;
                // if port is open, then close it and then reopen it
                // to reset the baud rate
                if IsOpen then
                        begin
                                Close;
                                Open;
                        end;
        end;
end;

// Set the Port property
procedure TComm.SetPort(PortToSet: Integer);
begin
        if PortToSet <> FPort then
        begin
                FPort := PortToSet;
                // if port was open, then close and reopen it
                if IsOpen then
                        begin
                                Close;
                                Open;
                        end;
        end;
end;

procedure TComm.SetRtsOn(OnOff: boolean);
begin
        FRtsOn := OnOff;
        if IsOpen then
                begin
        if OnOff then
        EscapeCommFunction(FHandle, SETRTS)
      else
        EscapeCommFunction(FHandle, CLRRTS);
                end;
end;

procedure TComm.SetDtrOn(OnOff: boolean);
begin
        FDtrOn := OnOff;
        if IsOpen then
                begin
        if OnOff then
        EscapeCommFunction(FHandle, SETDTR)
      else
        EscapeCommFunction(FHandle, CLRDTR);
                end;
end;

// Opens the COM port, returns True if ok
function TComm.Open: Boolean;
var
        sCom: String;
        dcbPort: TDCB;  // device control block
begin

        // close port if open already
        if IsOpen then Close;

        // try to open the port
        sCom := 'COM' + IntToStr(FPort);
        FHandle := CreateFile(PChar(sCom), GENERIC_READ or GENERIC_WRITE, 0,
nil,
                                                        OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, LongInt(0));

        // set the baud rate and other parameters
        if FHandle <> INVALID_HANDLE_VALUE then
    begin
      if GetCommState(FHandle, dcbPort) then
        begin
          // fill in the fields of the structure
          dcbPort.BaudRate := FBaud;
          dcbPort.ByteSize := 8;
          dcbPort.Parity := NOPARITY;
          dcbPort.StopBits := ONESTOPBIT;
          dcbPort.Flags := 0;
          { flag bit fields:
          dcb_Binary, dcb_Parity, dcb_OutxCtsFlow, dcb_fOutxDsrFlow,
          dcb_fOutX, dcb_fInX, dcb_DtrFlow, dcb_RtsFlow
          }
          SetCommState(FHandle, dcbPort);
        end;
                        SetRtsOn(FRtsOn);
                        SetDtrOn(FDtrOn);
    end;

        // return True if port opened
        Result := IsOpen;
end;

// Close the COM port
procedure TComm.Close;
begin
        if IsOpen then
        begin
                CloseHandle(FHandle);
                        FHandle := INVALID_HANDLE_VALUE;
    end;
end;

// Write a char out the COM port
function TComm.WriteByte(ch: byte): boolean;
var
        dwCharsWritten: DWord;
begin
        dwCharsWritten := 0;
        if IsOpen then
                begin
                        WriteFile(FHandle, ch, sizeof(ch), dwCharsWritten, nil);
                end;
        Result := dwCharsWritten = sizeof(ch);
end;

function TComm.WriteData(var data; size: integer): boolean;
var
        dwCharsWritten: DWord;
begin
        dwCharsWritten := 0;
        if IsOpen then
                begin
                        WriteFile(FHandle, data, size, dwCharsWritten, nil);
                end;
        Result := dwCharsWritten = size;
end;

// Reads a character from the port
function TComm.ReadByte: byte;
var
        cbCharsAvailable, cbCharsRead: DWord;
        ch: byte;
begin
        ch := Ord(' ');
        if IsOpen then
                begin
      cbCharsAvailable := GetInCount;
      if cbCharsAvailable > 0 then
        begin
          ReadFile(FHandle, ch, sizeof(ch), cbCharsRead, nil);
        end;
                end;
  result := ch;
end;

function TComm.ReadData(var data; size: integer): integer;
var
        cbCharsAvailable, cbCharsRead: DWord;
begin
        cbCharsRead := 0;
        if IsOpen then
                begin
      cbCharsAvailable := GetInCount;
      if cbCharsAvailable > 0 then
        begin
                if cbCharsAvailable < size then
                size := cbCharsAvailable;
          ReadFile(FHandle, data, size, cbCharsRead, nil);
        end;
                end;
  result := cbCharsRead;
end;

// Return the number of bytes waiting in the input queue
function TComm.GetInCount: LongInt;
var
        statPort: TCOMSTAT;
        dwErrorCode: DWord;
begin
        Result := 0;
        if IsOpen then
                begin
                        ClearCommError(FHandle, dwErrorCode, @statPort);
                        Result := statPort.cbInQue;
         end;
end;

// Return the number of bytes waiting in the output queue
function TComm.GetOutCount: LongInt;
var
        statPort: TCOMSTAT;
        dwErrorCode: DWord;
begin
        Result := 0;
        if IsOpen then
                begin
                        ClearCommError(FHandle, dwErrorCode, @statPort);
                        Result := statPort.cbOutQue;
         end;
end;

// Flush the port by reading any characters in the queue
procedure TComm.Flush;
begin
        if FHandle <> INVALID_HANDLE_VALUE then
                begin
        FlushFileBuffers(FHandle);
                        //PurgeComm(FHandle, PURGE_TXABORT or PURGE_RXABORT or
PURGE_TXCLEAR or PURGE_RXCLEAR);
                end;
end;

end.