serialng.~pas

用SerialNG组件写的一个串口通信程序,在delphi7下测试通过

    // 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 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
    constructor Create(AOwner : TComponent); override; //Create the Component
    destructor Destroy; override; //Destroy
    procedure SendData (Data : Pointer; Size : DWord); //Send binary Data
    procedure SendString(S : String); //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); // e.g. WriteSettings('Software/DomIS','SerialNGAdvDemo') will save to HKEY_CURRENT_USER\Software\DomIS\SerialAdvDemo
    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 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;

// One part of the Clusterdefinition is here, please read carefully
// The "RTOCharDelayTime" is the Time that may delay between two received Chars
// This Time should be Computed depending from the Baudrate e.g. 9600 Baud -> 960 Chars per Second -> Delay 1ms
// You can use the CharDelayDefault Procedure to set RTOCharDelayTime and WTOCharDelayTime depending
// of the selected Baudrate!
    property RTOCharDelayTime : DWord read fRTOCharDelayTime write SetRTOCharDelayTime default dflt_RTOCharDelayTime;
// The "RTOExtraDelayTime" is the Time that may delay addionally once
// So if the (CharCount*RTOCharDelayTime)/1000 + RTOExtraDelayTime extends the measured Time, a Cluster will be build
    property RTOExtraDelayTime : Word read fRTOExtraDelayTime write SetRTOExtraDelayTime default dflt_RTOExtraDelayTime;
// Clustersize specify how long one Cluster could become max
    property ClusterSize : Word read fClusterSize write SetClusterSize default dflt_ClusterSize;
// RxQueueSize specify the amount of Chars that could be received without reading,
// this should be longer than the Cluster size to prevent overrun errors
    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 default dflt_ThreadQuietMode;
    //THIS FLAG SHOULD BE SET TO TRUE ONLY IN VERY SPECIAL CASES!!! No Syncromize call in the Thread if True.
    property AutoReadRequest : Boolean read fAutoReadRequest write fAutoReadRequest default dflt_AutoReadRequest;

    // 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; // RING, RING on falling edge of the RI Pin
    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;

// The TWorkThread class deals with several CommEvents and controll the receiving
// of Clusters and check the Sendprocess
// Under normal cirumstances You don't have to deal with
  TWorkThread = class(TThread)
  private
    Owner : TSerialPortNG;
    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 : TSerialPortNG);
    procedure Execute; override;
  end;

procedure Register;

implementation
uses Registry;


procedure Register;
begin
  RegisterComponents('System', [TSerialPortNG]);
end;


//
// TSerialCluster Component
//

constructor TSerialCluster.Create(Data : Pointer; Size : Integer; CCError : DWord);
begin
  inherited Create;
  ClusterData := Data; // Take the Pointer
  ClusterSize := Size; // Size of Data
  ClusterCCError := CCError;
end;

function TSerialCluster.GetCCError : DWord;
begin
  GetCCError := ClusterCCError;
end;

function TSerialCluster.GetSize : Integer;
begin
  GetSize := ClusterSize;
end;

procedure TSerialCluster.GetData(Dest : Pointer);
begin
  if Dest <> Nil then
    Move(ClusterData^, Dest^, ClusterSize);
end;

function TSerialCluster.GetDataAsString : String;
var S : String;
begin
  SetLength(S,ClusterSize);
  Move(ClusterData^, S[1], ClusterSize);
  GetDataAsString := S;
end;

function TSerialCluster.GetDataAsPChar(Dest : PChar) : PChar;
type TMaxSize = array[0..MaxLongInt-1] of Char;
     PMaxSize = ^TMaxSize;
begin
  if Dest <> Nil then
    begin
      Move(ClusterData^, Dest^, ClusterSize);
      PMaxSize(Dest)^[ClusterSize] := #0;
    end;
  GetDataAsPChar := Dest;
end;

destructor TSerialCluster.Destroy;
begin
  Dispose(ClusterData);
  inherited Destroy;
end;


//
// TSerialPortNG Component definition
//

//
// Serveral "Set..." procedure for the Property mapping

procedure TSerialPortNG.SetCommPort(value : ShortString);
begin
  if value <> fCommPort then
    begin
      fCommPort := value;
      PortWork(fActive);
    end;
end;

procedure TSerialPortNG.SetBaudRate(value : DWord);
begin
  if value <> fBaudRate then
    begin
      fBaudRate := value;
      if fXTOAuto then
        XTODefault; // Adjust the CharDelay Timeouts
      if fActive then
        SetupDCB;
    end;
end;

procedure TSerialPortNG.SetParityType(value : Byte);
begin
  if value <> fParityType then
    begin
      fParityType := value;
      if fActive then
        SetupDCB;
    end;
end;

procedure TSerialPortNG.SetParityErrorChar(value : Char);
begin
  if value <> fParityErrorChar then
    begin
      fParityErrorChar := value;
      if fActive then
        SetupDCB;
    end;
end;

procedure TSerialPortNG.SetParityErrorReplacement(value : Boolean);
begin
  if value <> fParityErrorReplacement then
    begin
      fParityErrorReplacement := value;
      if fActive then
        SetupDCB;
    end;
end;

procedure TSerialPortNG.SetStopBits(value : Byte);
begin
  if value <> fStopBits then
    begin
      fStopBits := value;
      if fActive then
        SetupDCB;
    end;
end;