xcom.pas

the best serial port component for delphi application. you can send receive serial port datas as

// Last Modification dates:
//   by Yusuf IZGI on 17th Jul 2002
//                 on 23th Dec 2002
unit XCom;
{$BOOLEVAL OFF}
interface

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

const
  BaudRateCount = 15;
  BaudRates : array[0..BaudRateCount-1] of DWord =
    (CBR_110, CBR_300, CBR_600, CBR_1200, CBR_2400, CBR_4800, CBR_9600 , CBR_14400, CBR_19200, CBR_38400, CBR_56000, CBR_57600, CBR_115200, CBR_128000, CBR_256000);
  XTOCharDelayDef : array [0..BaudRateCount-1] of DWord =
(100000, 37000, 18000, 9000, 4500, 2300, 1100, 760, 570, 290, 200, 190, 95, 85, 43);
const
  bmfBinary = $0001;          // binary mode, no EOF check
  bmfParity = $0002;          // enable parity checking
  bmfOutxCtsFlow = $0004;      // CTS output flow control
  bmfOutxDsrFlow = $0008;      // DSR output flow control
// DTR Control Flow Values  DTR_CONTROL_DISABLE = 0;  DTR_CONTROL_ENABLE = 1;  DTR_CONTROL_HANDSHAKE = 2;
  bmfDtrControlEnable = $0010;       // DTR Enable
  bmfDtrControlHandshake = $0020;       // DTR Handshake
  bmfDsrSensitivity = $0040;   // DSR sensitivity
  bmfTXContinueOnXoff = $0080; // XOFF continues Tx
  bmfOutX = $0100;            // XON/XOFF out flow control
  bmfInX = $0200;             // XON/XOFF in flow control
  bmfErrorChar = $0400;       // enable error replacement
  bmfNull = $0800;            // enable null stripping
// RTS Control Flow Values  RTS_CONTROL_DISABLE = 0;  RTS_CONTROL_ENABLE = 1;  RTS_CONTROL_HANDSHAKE = 2;  RTS_CONTROL_TOGGLE = 3;
  bmfRtsControlEnable = $1000;       // RTS Enable
  bmfRtsControlHandshake = $2000;       // RTS Enable
  bmfRtsControlToggle = $3000;       // RTS Enable
  bmfAbortOnError = $4000;     // abort reads/writes on error

// Basic FlowControlModes
const
  fcNone = 0;
  fcXON_XOFF = bmfOutX or bmfInX or  bmfTXContinueOnXoff;
  fcRTS_CTS = bmfOutxCtsFlow or bmfRtsControlHandshake;
  fcDSR_DTR = bmfOutxDsrFlow or bmfDtrControlHandshake;
  fcClearFlowCtrl = Not (fcXON_XOFF or fcRTS_CTS or fcDSR_DTR or bmfDtrControlEnable or bmfRtsControlEnable);
const BasicFlowModes : array[0..3] of Word = (fcNone, fcXON_XOFF, fcRTS_CTS, fcDSR_DTR);

const
  enError = 0;   // Errors like unable to Open Port
  enWarning = 1; // Warnings like cant pause Thread
  enMsg = 2;     // Messages like starting with Port opening
  enDebug = 3;   // Debughelpermessage like im am here or there
  enAll = 255;   // Show all

const
// Set some constant defaults.
// These are the equivalent of COM2:9600,N,8,1;
  dflt_CommPort = 'COM1';
  dflt_BaudRate = CBR_9600;
  dflt_DeviceAdr = 1;
  dflt_Stx = 4;
  dflt_ParityType = NOPARITY;
  dflt_ParityErrorChar = #0;
  dflt_ParityErrorReplacement = False;
  dflt_StopBits = ONESTOPBIT;
  dflt_DataBits = 8;
  dflt_XONChar = #$11;  {ASCII 11h}
  dflt_XOFFChar = #$13; {ASCII 13h}
  dflt_XONLimDiv = 33; // Set the XONLimit to dflt_XONLimDiv/100*RxQueueSize
  dflt_XOFFLimDiv = 33; // Set the XONLimit to dflt_XONLimDiv/100*RxQueueSize
  dflt_FlowControl = fcNone;
  dflt_StripNullChars = False;
  dflt_BinaryMode = True;
  dflt_EventChar = #0;
// Timeout defaults, fits only to 9600 Baud!
// Look that CharDelay is in micro, ExtraDely in milli Seconds!
  dflt_RTOCharDelayTime  = 1100; // 1100microsec (1100E-06 secs)
  dflt_RTOExtraDelayTime = 250;  // 250msec      ( 250E-03 secs)
  dflt_WTOCharDelayTime  = 1100; // 1100microsec (1100E-06 secs)
  dflt_WTOExtraDelayTime = 250;  // 1000msec     ( 250E-03 secs)
  dflt_XTOAuto = True; // lets the Component adjust CharDelay timing on every Baudrate change
  dflt_ClusterSize = 3072; //Max Clustersize
  dflt_RTSState = False;
  dflt_DTRState = True;
  dflt_ErrorNoise = enMsg;
  dflt_BREAKState = False;
  dflt_RxQueueSize = 4096;
  dflt_TxQueueSize = 4096;
  dflt_ThreadQuietMode = False;

type

// Special Event function for the Error and Warning
  TNotifyErrorEvent = procedure(Sender : TObject;Place, Code: DWord; Msg : String; Noise : Byte) of object;

  PSerialCluster = ^TSerialCluster;
  TSerialCluster = class (TObject)
    private
      ClusterData : Pointer; // Pointer to Data
      ClusterSize : Integer; // How many Bytes in Datafield
      ClusterCCError : DWord; // This Value comes from the ClearCommError function and is a Bitfield
    public
    constructor Create(Data : Pointer; Size : Integer; CCError : DWord);
    function GetCCError : DWord;
    function GetSize : Integer;
    procedure GetData(Dest : Pointer);
    function GetDataAsString : String;
    function GetDataAsPChar(Dest : PChar) : PChar;
    destructor Destroy; override;
  end;

  TXCom = class(TComponent)
  private
    fCommPort : ShortString;
    fBaudRate : DWord;
    fDeviceAdr: Byte;
    fRCPStx: Byte;
    fParityType : Byte;
    fParityErrorChar : Char;
    fParityErrorReplacement : Boolean;
    fStopBits : Byte;
    fDataBits : Byte;
    fXONChar : Char;
    fXOFFChar : Char;
    fXONLimDiv : Byte; // 0..100
    fXOFFLimDiv : Byte; // 0..100
    fFlowControl : LongInt;
    fStripNullChars : Boolean;  // Strip null chars?
    fEventChar : Char;
    fErrorNoise : Byte;
    // These fields are set in the EventThread
    fCommStateFlags : TComStateFlags;
    fCommStateInQueue : DWord;
    fCommStateOutQueue : DWord;
    fCommError : DWord;
    fCommEvent : DWord;
    fModemState : DWord;
    // TimeOut definitions
    fRTOCharDelayTime : DWord;     // in 祍 max: 4.294.967.295祍 aprox 1h 20min
    fRTOExtraDelayTime : Word;    // in ms
    fWTOCharDelayTime : DWord;     // in 祍
    fWTOExtraDelayTime : Word;    // in ms
    fXTOAuto : Boolean;
    fActive : Boolean;
    fRTSState : Boolean;
    fDTRState : Boolean;
    fBREAKState : Boolean;
    fCTSState : Boolean;
    fDSRState : Boolean;
    fRLSDState : Boolean;
    fRingState : Boolean;
    fClusterSize : Word;
    fRxQueueSize : Word;
    fTxQueueSize : Word;
    fReadRequest : Boolean; // Force Thread to Read the Queue
    fWrittenBytes : DWord;
    fThreadQuietMode : Boolean;
    // Eventvariables
    fOnTxQueueEmptyEvent : TNotifyEvent;
    fOnCommEvent : TNotifyEvent;
    fOnCommStat : TNotifyEvent;
    fOnBreakEvent : TNotifyEvent;
    fOnCTSEvent : TNotifyEvent;
    fOnDSREvent : TNotifyEvent;
    fOnLineErrorEvent : TNotifyEvent;
    fOnRingEvent : TNotifyEvent;
    fOnRIEvent : TNotifyEvent;
    fOnRLSDEvent : TNotifyEvent;
    fOnRxClusterEvent : TNotifyEvent;
    fOnRxCharEvent : TNotifyEvent;
    fOnRxEventCharEvent : TNotifyEvent;
    fOnWriteDone : TNotifyEvent;
    fOnProcessError : TNotifyErrorEvent;

    hCommPort : THandle; // Handle to the port.
    WriteOverlapped : TOverlapped; //Overlapped field for Write
    ReadOverlapped : TOverlapped;  //Overlapped field for Read
    StatusOverlapped : TOverlapped; //Overlapped field for Status
    BytesToWrite : DWord;
    WriteStartTime : DWord;
    WorkThread : TThread;
    WorkThreadIsRunning : Boolean;
    WorkThreadIsTerminated : Boolean;
    ShutdownInProgress : Boolean;
    RxDClusterList : TList;
    LastErr : Integer;
    Platform : Integer; // 0 Win32s on Win3.11, 1 Win 9x, 2 WinNT
    CriticalSection: TRTLCriticalSection;
    // Procedures for setting the variables, refrenced in the Properties
    procedure SetCommPort(value : ShortString);
    procedure SetBaudRate(value : DWord);
    procedure SetDeviceAdr(value : Byte);
    procedure SetStx(value : Byte);
    procedure SetParityType(value : Byte);
    procedure SetParityErrorChar(value : Char);
    procedure SetParityErrorReplacement(value : Boolean);
    procedure SetStopBits(value : Byte);
    procedure SetDataBits(value : Byte);
    procedure SetXONChar(value : Char);
    procedure SetXOFFChar(value : Char);
    procedure SetXONLimDiv(value : Byte);
    procedure SetXOFFLimDiv(value : Byte);
    procedure SetFlowControl(value : LongInt);
    procedure SetStripNullChars(value : Boolean);
    procedure SetEventChar(value : Char);
    procedure SetRTOCharDelayTime(value : DWord);
    procedure SetRTOExtraDelayTime(value : Word);
    procedure SetWTOCharDelayTime(value : DWord);
    procedure SetWTOExtraDelayTime(value : Word);
    procedure SetXTOAuto(value : Boolean);
    procedure SetClusterSize(value : Word);
    procedure SetRxQueueSize(value : Word);
    procedure SetTxQueueSize(value : Word);
    procedure SetErrorNoise(value : Byte);
    procedure SetSignalRTS(State : Boolean);
    procedure SetSignalDTR(State : Boolean);
    procedure SetSignalBREAK(State : Boolean);
    procedure SetReadRequest(value : Boolean);
    procedure SetActive(NewState : Boolean);
    // Rest of Procedures
    procedure InitOverlapped(var Overlapped : TOverlapped);
    procedure ResetOverlapped(var Overlapped : TOverlapped);
    procedure SetOverlapped(var Overlapped : TOverlapped);
    procedure SetupDCB;
    procedure PortWork (ReOpen : Boolean); //If ReOpen is True the Port will be (Re-) Opened, otherwise closed. The ActiveFlag will bes Set!
    procedure EnableEvents;
    procedure ProcessError(Place, Code : DWord; Msg : String; Noise : Byte);
    procedure WorkThreadDone(Sender: TObject);
    procedure WaitForThreadNotRunning(Counter : Integer);
  protected
  public
    // Procedures for external calling
    fSendInProgress : Boolean;
    constructor Create(AOwner : TComponent); override; //Create the Component
    destructor Destroy; override; //Destroy
    procedure SendData (Data : Pointer; Size : DWord); //Send binary Data
    procedure SendArray(S : array of Byte;L : Integer); //Send Array Data
    procedure SendString(S : string;L : Integer); //Send String Data
    // Clusterfunctions works on received Datapackages
    function NextClusterSize : Integer;
    function NextClusterCCError : DWord;
    function ReadNextCluster(var ClusterSize : Integer; var CCError : DWord) : Pointer;
    function ReadNextClusterAsString : String;
    function ReadNextClusterAsPChar(Dest : PChar) : PChar;
    // Clears the Queues
    procedure ClearTxDQueue;
    procedure ClearRxDQueue;
    // Sets the Timingfields in depedecy to the Baudrate
    procedure XTODefault;
    // Save and retrieves the Setting to/from the registry
    procedure WriteSettings(Regkey, RegSubKey : String);
    procedure ReadSettings(Regkey, RegSubKey : String);
  published
    //If You set Active to True, the component tries to Open the Port, if Opened the state remains True.
    property Active : Boolean read FActive write SetActive default False;
    property ComHandle : THandle read hCommPort default INVALID_HANDLE_VALUE;
    property CommPort : ShortString read fCommPort write SetCommPort;
    property BaudRate :  DWord read fBaudRate write SetBaudRate default dflt_BaudRate;
    property DeviceAdress: Byte read fDeviceAdr write SetDeviceAdr default dflt_DeviceAdr;
    property StartofText: Byte read fRCPStx write SetStx default dflt_Stx;
    property ParityType : Byte read fParityType write SetParityType default dflt_ParityType;
    property ParityErrorChar : Char read fParityErrorChar write SetParityErrorChar default dflt_ParityErrorChar;
    property ParityErrorReplacement :  Boolean read fParityErrorReplacement  write SetParityErrorReplacement  default dflt_ParityErrorReplacement;
    property StopBits : Byte read fStopBits write SetStopBits default dflt_StopBits;
    property DataBits : Byte read fDataBits write SetDataBits default dflt_DataBits;
    property XONChar : Char read fXONChar  write SetXONChar  default dflt_XONChar;
    property XOFFChar : Char read fXOFFChar write SetXOFFChar  default dflt_XOFFChar;
    property XONLimDiv : Byte read fXONLimDiv  write SetXONLimDiv default dflt_XOnLimDiv;
    property XOFFLimDiv : Byte read fXOFFLimDiv  write SetXOFFLimDiv default dflt_XOffLimDiv;
    property FlowControl : LongInt read fFlowControl write SetFlowControl default dflt_FlowControl;
    property StripNullChars : Boolean read fStripNullChars write SetStripNullChars default dflt_StripNullChars;
    property EventChar : Char read fEventChar write SetEventChar default dflt_EventChar;

    property RTOCharDelayTime : DWord read fRTOCharDelayTime write SetRTOCharDelayTime default dflt_RTOCharDelayTime;
    property RTOExtraDelayTime : Word read fRTOExtraDelayTime write SetRTOExtraDelayTime default dflt_RTOExtraDelayTime;
    property ClusterSize : Word read fClusterSize write SetClusterSize default dflt_ClusterSize;
    property RxQueueSize : Word read fRxQueueSize write SetRxQueueSize default dflt_RxQueueSize;
    property TxQueueSize : Word read fTxQueueSize write SetTxQueueSize default dflt_TxQueueSize;

    property WTOCharDelayTime : DWord read fWTOCharDelayTime write SetWTOCharDelayTime default dflt_WTOCharDelayTime;
    property WTOExtraDelayTime : Word read fWTOExtraDelayTime write SetWTOExtraDelayTime default dflt_WTOExtraDelayTime;
    property XTOAuto : Boolean read fXTOAuto write SetXTOAuto default dflt_XTOAuto;
    property RTSState : Boolean read fRTSState write SetSignalRTS default dflt_RTSState;
    property DTRState : Boolean read fDTRState write SetSignalDTR default dflt_DTRState;
    property BREAKState : Boolean read fBREAKState write SetSignalBREAK default dflt_BreakState;
    property CTSState : Boolean read fCTSState;
    property DSRState : Boolean read fDSRSTate;
    property RLSDState : Boolean read fRLSDState;
    property RingState : Boolean read fRingState;
    property ErrorNoise : Byte read fErrorNoise write SetErrorNoise default dflt_ErrorNoise;
    property ReadRequest : Boolean read fReadRequest write SetReadRequest default False;
    property SendInProgress : Boolean read fSendInProgress;
    property CommError : DWord read fCommError;
    property CommStateFlags : TComStateFlags read fCommStateFlags;
    property CommStateInQueue: DWord read fCommStateInQueue;
    property CommStateOutQueue : DWord read fCommStateOutQueue;
    property ModemState : DWord read fModemState;
    property CommEvent : DWord read fCommEvent;
    property WrittenBytes : DWord read fWrittenBytes;
    property ThreadQuietMode : Boolean read fThreadQuietMode write fThreadQuietMode;
    // Event Properties
    property OnCommEvent : TNotifyEvent read fOnCommEvent write fOnCommEvent;
    property OnCommStat : TNotifyEvent read fOnCommStat write fOnCommStat;
    property OnTxQueueEmptyEvent : TNotifyEvent read fOnTxQueueEmptyEvent write fOnTxQueueEmptyEvent;
    property OnWriteDone : TNotifyEvent read fOnWriteDone write fOnWriteDone;
    property OnBreakEvent : TNotifyEvent read fOnBreakEvent write fOnBreakEvent;
    property OnCTSEvent : TNotifyEvent read fOnCTSEvent write fOnCTSEvent;
    property OnDSREvent : TNotifyEvent read fOnDSREvent write fOnDSREvent;
    property OnLineErrorEvent : TNotifyEvent read fOnLineErrorEvent write fOnLineErrorEvent;
    property OnRingEvent : TNotifyEvent read fOnRingEvent write fOnRingEvent;
    property OnRIEvent : TNotifyEvent read fOnRIEvent write fOnRIEvent;       // on every change of the RI Pin
    property OnRLSDEvent : TNotifyEvent read fOnRLSDEvent write fOnRLSDEvent;
    property OnRxClusterEvent : TNotifyEvent read fOnRxClusterEvent write fOnRxClusterEvent;
    property OnRxCharEvent : TNotifyEvent read fOnRxCharEvent write fOnRxCharEvent;
    property OnRxEventCharEvent : TNotifyEvent read fOnRxEventCharEvent write fOnRxEventCharEvent;
    property OnProcessError : TNotifyErrorEvent read fOnProcessError write fOnProcessError;
  end;

  TWorkThread = class(TThread)
  private
    Owner : TXCom;
    Place, Code : DWord;
    Msg : String;
    Noise : Byte;
    Cluster : TSerialCluster;
    procedure ThreadSynchronize(Method: TThreadMethod);
    procedure SetProcessError(APlace, ACode : DWord; AMsg : String; ANoise : Byte);
    procedure ProcessError;
    procedure RxClusterEvent;
    procedure CommEvent;
    procedure CommStatEvent;
    procedure BreakEvent;
    procedure CTSEvent;
    procedure DSREvent;
    procedure LineErrorEvent;
    procedure RingEvent;
    procedure RIEvent;
    procedure RLSDEvent;
    procedure RxCharEvent;
    procedure RxEventCharEvent;
    procedure TxQueueEmptyEvent;
    procedure WriteDone;

  protected
  public
    constructor Create(AOwner : TXCom);
    procedure Execute; override;
  end;

procedure Register;
procedure GetPortList(Strings : TStrings);

implementation
uses Registry;

var VersionInfo : TOSVersionInfo;

procedure Register;
begin
  RegisterComponents('FreeWare', [TXCom]);
end;

// Help function for OS Detection
function CheckOS(var VersionInfo : TOSVersionInfo) : Integer;
begin
{
    dwOSVersionInfoSize: DWORD;
    dwMajorVersion: DWORD;
    dwMinorVersion: DWORD;
    dwBuildNumber: DWORD;
    dwPlatformId: DWORD;
    szCSDVersion: array[0..127] of AnsiChar; // Maintenance string for PSS usage
}
  VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo);
  if GetVersionEx(VersionInfo) then