unit serial;


interface 


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


// This is the Device Control Block record. 
// It is the structure that contains the 
// serial port setup parameters. This 
// structure must be initialized before the 
// serial port can be used.  It is declared 
// in the windows.pas unit and looks like this: 
{type TDCB = record 
        DCBLength:DWord; 
        Baudrate:DWord; 
        Flags:LongInt; 
        wReserved:Word; 
        XONLim:Word; 
        XOFFLim:Word; 
        ByteSize:Byte; 
        Parity:Byte; 
        StopBits:Byte; 
        XONChar:Char; 
        XOFFChar:Char; 
        ErrorChar:Char; 
        EOFChar:Char; 
        EvtChar:Char; 
        wReserved1:Word; 
end;} 


type 
   // You can't do anything without a comm port. 
//  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, fcXON_XOFF, fcRTS_CTS, fcDSR_DTR); 


   // Two new notify events. 
   TNotifyTXEvent = procedure(Sender : TObject; data : string) of object; 
   TNotifyRXEvent = procedure(Sender : TObject; data : string) of object; 


   // Set some constant defaults. 
// These are the qquivalent of 
// COM2:9600,N,8,1; 
const 
   dflt_CommPort = 1; 
   dflt_BaudRate = 9600; 
   dflt_ParityType = pcNone; 
   dflt_ParityErrorChecking = False; 
   dflt_ParityErrorChar = 0; 
   dflt_ParityErrorReplacement = False; 
   dflt_StopBits = 2; 
   dflt_DataBits = 8; 
   dflt_XONChar = $11;  {ASCII 11h} 
   dflt_XOFFChar = $13; {ASCII 13h} 
   dflt_XONLim = 1024; 
   dflt_XOFFLim = 2048; 
   dflt_ErrorChar = 0; // For parity checking. 
   dflt_FlowControl = fcNone; 
   dflt_StripNullChars = False; 
   dflt_EOFChar = 0; 


type 
   TSerialPort = class(TComponent) 
   private 
     hCommPort : THandle; // Handle to the serial port. 
     fCommPort : integer; 
     fBaudRate : Integer; 
     fParityType : TParityType; 
     fParityErrorChecking : Boolean; 
     fParityErrorChar : Byte; 
     fParityErrorReplacement : Boolean; 
     fStopBits : integer; 
     fDataBits : integer; 
     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; 
     fOnTransmit : TNotifyTXEvent; 
     fOnReceive : TNotifyRXEvent; 
     fAfterTransmit : TNotifyTXEvent; 
     fAfterReceive : TNotifyRXEvent; 
     ReadBuffer : String; // Where the results from the read goes. 
     procedure SetCommPort(value : integer); 
     procedure SetBaudRate(value : integer); 
     procedure SetParityType(value : TParityType); 
     procedure SetParityErrorChecking(value : Boolean); 
     procedure SetParityErrorChar(value : Byte); 
     procedure SetParityErrorReplacement(value : Boolean); 
     procedure SetStopBits(value : integer); 
     procedure SetDataBits(value : integer); 
     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; 
   protected 
   public 
     constructor Create(AOwner : TComponent); override; 
     destructor Destroy; override; 
     function OpenPort(MyCommPort : integer) : Boolean; 
     function ClosePort : boolean; 
     procedure SendData(data : PChar; size : DWord); 
     function GetData : String; 
     function InputBufferCount: LongInt; 
     function PortIsOpen : boolean; 
     procedure FlushTX; 
     procedure FlushRX; 
   published 
     property CommPort : integer read fCommPort 
                                   write SetCommPort 
                                   default dflt_CommPort; 
     property BaudRate : integer 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 : integer read fStopBits 
                                   write SetStopBits 
                                   default dflt_StopBits; 
     property DataBits : integer 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 OnTransmit : TNotifyTXEvent read fOnTransmit 
                                          write fOnTransmit; 
     property OnReceive : TNotifyRXEvent read fOnReceive 
                                         write fOnReceive; 
     property AfterTransmit : TNotifyTXEvent read fAfterTransmit 
                                             write fAfterTransmit; 
     property AfterReceive : TNotifyRXEvent read fAfterReceive 
                                             write fAfterReceive; 
   end; 


procedure Register; 


implementation 


// Public method to open the port and 
// assign the handle to it. 
function TSerialPort.OpenPort(MyCommPort : Integer) : Boolean; 
var 
   MyPort : PChar; 
begin 
   // Make sure that the port is Closed first. 
   ClosePort; 


   MyPort := PChar('COM' + IntToStr(fCommPort)); 
   hCommPort := CreateFile(MyPort, 
                           GENERIC_READ OR GENERIC_WRITE, 
                           0, 
                           nil, 
                           OPEN_EXISTING, 
                           0,0); 
   // Initialize the port. 
   Initialize_DCB; 
   // Was successful if not and invalid handle. 
   result := hCommPort <> INVALID_HANDLE_VALUE; 
end; 


// Public method to Close the port. 
function TSerialPort.ClosePort : boolean; 
begin 
   FlushTX; 
   FlushRX; 
   // Close the handle to the port. 
   result := CloseHandle(hCommPort); 
   hCommPort := INVALID_HANDLE_VALUE; 
end; 


// Public Send data method. 
procedure TSerialPort.SendData(data : PChar; size : DWord); 
var 
   NumBytesWritten : DWord; 
begin 
   if hCommPort = INVALID_HANDLE_VALUE then exit; 


   if assigned(fOnTransmit) then fONTransmit(self, Data); 


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


   // Fire the transmit event. 
   if assigned(fAfterTransmit) then fAfterTransmit(self, Data); 
end; 


function TSerialPort.InputBufferCount: LongInt; 
var 
     oStatus: TComStat; 
     dwErrorCode: DWord; 
begin 
     Result := 0; 


     if hCommPort = INVALID_HANDLE_VALUE then 
         Exit; 


     ClearCommError(hCommPort, dwErrorCode, @oStatus); 
         Result := oStatus.cbInQue; 
end; 


// Public Get data method. 
function TSerialPort.GetData : String; 
var 
   NumBytesRead : DWord; 
   // <<cbInQue>> Specifies the number 
   // of bytes received by the serial 
   // provider but not yet read by a 
   // ReadFile operation. 
   BytesInQueue : LongInt;  // Number of bytes in the input buffer 
         oStatus: TComStat;       // Variable for the ComStat structure. 
         dwErrorCode: DWord;      // Variable to put the error codes in. 
begin 
   if hCommPort = INVALID_HANDLE_VALUE then exit; 


   Readbuffer :=''; 


   if assigned(fOnReceive) then fONReceive(self, ReadBuffer); 
   // 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); 
                 ReadFile(hCommPort, 
                   PChar(ReadBuffer)^, 
                   BytesInQueue, 
                   NumBytesRead, 
                   nil); 


                 SetLength(ReadBuffer, StrLen(PChar(ReadBuffer))); 
         end; 


   if assigned(fAfterReceive) then fAfterReceive(self, ReadBuffer); 
   result := ReadBuffer; 
end; 


// Create method. 
constructor TSerialPort.Create(AOwner : TComponent); 
begin 
   inherited Create(AOwner); 
   // 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; 


// Destroy method. 
destructor TSerialPort.Destroy; 
begin 
   // Close the port first; 
   ClosePort; 
   inherited Destroy; 
end; 


// Initialize the device control block. 
procedure TSerialPort.Initialize_DCB; 
var 
   MyDCB : TDCB; 
   //file://MyCommTimeouts : TCommTimeouts; 
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); 


    MyDCB.BaudRate := fBaudrate; 
//  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; 
//  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; 
   end; 
   if fParityErrorChecking then inc(MyDCB.Flags, $0002); 
   if fParityErrorReplacement then inc(MyDCB.Flags, $0021); 
   MyDCB.ErrorChar := char(fErrorChar); 


   case fStopBits of 
     1 : MyDCB.StopBits := ONESTOPBIT; 
   //  sbOnePtFive : MyDCB.StopBits := ONE5STOPBITS; 
     2 : MyDCB.StopBits := TWOSTOPBITS; 
   end; 


     MyDCB.ByteSize := fDataBits; 
//  case fDataBits of 
//    db4 : MyDCB.ByteSize := 4; 
//    db5 : MyDCB.ByteSize := 5; 
//    db6 : MyDCB.ByteSize := 6; 
//    db7 : MyDCB.ByteSize := 7; 
//    db8 : MyDCB.ByteSize := 8; 
//  end; 


   // The 'flags' are bit flags, 
   // which means that the flags 
   // either turn on or off the 
   // desired flow control type. 
   case fFlowControl of 
     fcXON_XOFF : MyDCB.Flags := MyDCB.Flags or $0020 or $0018; 
     fcRTS_CTS : MyDCB.Flags := MyDCB.Flags or $0004 or 
$0024*RTS_CONTROL_HANDSHAKE; 
     fcDSR_DTR : MyDCB.Flags := MyDCB.Flags or $0008 or 
$0010*DTR_CONTROL_HANDSHAKE; 
   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 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; 


// Set the comm port. 
procedure TSerialPort.SetCommPort(value : Integer); 
begin 
   if fCommPort <> value then begin 
     fCommPort := value; 
     Initialize_DCB; 
   end; 
end; 


// Set the baud rate. 
procedure TSerialPort.SetBaudRate(value : Integer); 
begin 


   if fBaudRate <> value then begin 
     fBaudRate := value; 
     Initialize_DCB; 
   end; 
end; 


// Set the parity check type. 
procedure TSerialPort.SetParityType(value : TParityType); 
begin 
   if fParityType <> value then begin 
     fParityType := value; 
     Initialize_DCB; 
   end; 
end; 


// Do we want to do parity error checking? 
procedure TSerialPort.SetParityErrorChecking(value : Boolean); 
begin 
   if fParityErrorChecking <> value then begin 
     fParityErrorChecking := value; 
     Initialize_DCB; 
   end; 
end; 


// Set the parity error char. 
procedure TSerialPort.SetParityErrorChar(value : Byte); 
begin 
   if fParityErrorChar <> value then begin 
     fParityErrorChar := value; 
     Initialize_DCB; 
   end; 
end; 


// Set wether to replace parity errors with error char. 
procedure TSerialPort.SetParityErrorReplacement(value : Boolean); 
begin 
   if fParityErrorReplacement <> value then begin 
     fParityErrorReplacement := value; 
     Initialize_DCB; 
   end; 
end; 


// Set the stop bits. 
procedure TSerialPort.SetStopBits(value : integer); 
begin 
   if fStopBits <> value then begin 
     fStopBits := value; 
     Initialize_DCB; 
   end; 
end; 


// Set the data bits. 
procedure TSerialPort.SetDataBits(value : integer); 
begin 
   if fDataBits <> value then begin 
     fDataBits := value; 
     Initialize_DCB; 
   end; 
end; 


// Set the XON Char. 
procedure TSerialPort.SetXONChar(value : byte); 
begin 
   if fXONChar <> value then begin 
     fXONChar := value; 
     Initialize_DCB; 
   end; 
end; 


// Set the XOFF Char. 
procedure TSerialPort.SetXOFFChar(value : byte); 
begin 
   if fXOFFChar <> value then begin 
     fXOFFChar := value; 
     Initialize_DCB; 
   end; 
end; 


// Set the XON Limit. 
procedure TSerialPort.SetXONLim(value : word); 
begin 
   if fXONLim <> value then begin 
     fXONLim := value; 
     Initialize_DCB; 
   end; 
end; 


// Set the XOFF Limit. 
procedure TSerialPort.SetXOFFLim(value : word); 
begin 
   if fXOFFLim <> value then begin 
     fXOFFLim := value; 
     Initialize_DCB; 
   end; 
end; 


// Set the error character. 
procedure TSerialPort.SetErrorChar(value : byte); 
begin 
   if fErrorChar <> value then begin 
     fErrorChar := value; 
     Initialize_DCB; 
   end; 
end; 


// Set the type of flow control desired. 
procedure TSerialPort.SetFlowControl(value : TFlowControl); 
begin 
   if fFlowControl <> value then begin 
     fFlowControl := value; 
     Initialize_DCB; 
   end; 
end; 


// Do we want to strip off the null characters? 
procedure TSerialPort.SetStripNullChars(value : Boolean); 
begin 
   if fStripNullChars <> value then begin 
     fStripNullChars := value; 
     Initialize_DCB; 
   end; 
end; 


// Set the EOF char. 
procedure TSerialPort.SetEOFChar(value : Byte); 
begin 
   if fEOFChar <> value then begin 
     fEOFChar := value; 
     Initialize_DCB; 
   end; 
end; 


// Public function to check if the port is open. 
function TSerialPort.PortIsOpen : boolean; 
begin 
   Result := hCommPort <> INVALID_HANDLE_VALUE; 
end; 


// Public method to cancel and flush the receive buffer. 
procedure TSerialPort.FlushRx; 
begin 
   if hCommPort = INVALID_HANDLE_VALUE then exit; 
   PurgeComm(hCommPort, PURGE_RXABORT or PURGE_RXCLEAR); 
   ReadBuffer := ''; 
end; 


// Public method to cancel and flush the transmit buffer. 
procedure TSerialPort.FlushTx; 
begin 
   if hCommPort = INVALID_HANDLE_VALUE then exit; 
   PurgeComm(hCommPort, PURGE_TXABORT or PURGE_TXCLEAR); 
end; 


// Register the component in its own menu selection. 
procedure Register; 
begin 
   RegisterComponents('Misc', [TSerialPort]); 
end; 


end.