serialng.pas

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

unit SerialNG;
// DomIS Internet Solutions http://www.domis.de
// Visit SerialNG Homepage http://www.domis.de/serialng.htm

// This Source is distributed under the terms of Open-Source
// This mean You can use this Source free for Open-Source development
// Additionally I allow the use for any inhouse Projects
// If You want to make a Closed-Source Project with this Source,
// You have to reference Back to the Source and have to distribute the Source
// Any changes should be marked and this header should remain here
// Under all circumstances it is prohibited to use this source for military Products!!!
// Refer the readme.txt

// This is Version 2 of the Basic Communication Component
// I've made a complete redesign of the whole Component
// So the Component is incompatible with the Version 1
// News:
// Using Overlapped features for Windows Platform Compatiblity
// Using CommEvents for state detection
// More (and more meaningfull) Events
// Sending will not block the main Program

// Support the development of SerialNG with a donation. Any amount will be welcome
// You may transmit the Money to my  Bank-Account
//  Kto. 654130-604, Postbank Frankfurt/M, BLZ 500 100 60, Kennwort SerialNG
// for International transmission, use the IBAN Code
// IBAN DE 56 5001 0060 0654 1306 04
// You may also use Paypal if You like
// Link for EURO transmission
// https://www.paypal.com/xclick/business=paypal%40domis.de&item_name=Support+SerialNG+Development&item_number=SerialNG-EUR&tax=0&currency_code=EUR
// Link for USD transmission
// https://www.paypal.com/xclick/business=paypal%40domis.de&item_name=Support+SerialNG+Development&item_number=SerialNG-USD&tax=0&currency_code=USD
// Thank You for using and supporting SerialNG!

// Installation
// You have to register this component with the Delphi funktion "Component/Install Component"
// create a new component library and add this component
// the TSerialNG component appears in the "Samples" part of the component toolbar
// See http://domis.de/serialnginst.htm

// Usage
// Please take a look to the Demofiles.
// Start with SerialNGBasicDemo.dpr, this contains a very simple approach to the component

// The Base of the Version 1.X of this unit is taken from "TSerialPort: Basic Serial Communications in Delphi"
// created by Jason "Wedge" Perry, but I could not find him again

// PC serial port Pins are as follows
// Name Dir  9Pin 25Pin
// DCD   In   1    8
// RXD   In   2    3
// TXD   Out  3    2
// DTR   Out  4    20
// GND   -    5    7
// DSR   In   6    6
// RTS   Out  7    4
// CTS   In   8    5
// RI    In   9    22
// Dir means the direction from the ports view (e.g. DCD is an input, You can read this port)

// Version History
// All Version are available at http://www.domis.de/serialng.htm
// 2.0.0  28. Aug 2001, Basic stable Version
// 2.0.1  30. Aug 2001, Fixing Thread stoperror in PortWord
// 2.0.2  17. Sep 2001, Deleting double declared Property Error, use instead CommError
//                      Changed declaration of procedure GetCommNames(CommNames : TStrings);
//                      prevent duplicate Entries in this function
// 2.0.3   9. Nov 2001, Changed Cardinal type to DWORD in TWorkThread.Execute for
//                      Delphi 3 backcompatibility
// 2.0.4  28. Nov 2001, Problem in not Active Mode fixed (
//                      sleep(200) prevent consuming 100% of cpu-time in inactive mode)
// 2.0.5   8. Jan 2002, Problem in GetDataAsPChar fixed (
//                      The pending Zero was not patched in the right place)
// 2.0.6   4. Apr 2002, Changed *all* Cardinal type to DWORD and made several Changes in
//                      Demo Forms for Delphi 3 backcompatibility
// 2.0.7  16. Apr 2002, Found and fixed the norty Error which occours sometimes after
//                      the Termination of the Threads (the Overlapped Result wrote into undefined Memory)
//                      The Thread waits now until everything Pending Overlapped is done
// 2.0.8  13. Mai 2002, Correct Error with the default timing settings (Thanks to Hynek Cernoch)
// 2.0.9  27. Mai 2002, Patched an "\\.\" in front of Comportname to allow connection to virtual Comports
// 2.0.10 27. Aug 2002, Function for finding the CommPorts in the Registry created and placed in
//                      Unit CommPortList. The CheckOS function is moved into theis Unit too.
// 2.0.11  6. Sep 2002, Again or Finally? Found and fixed the norty Error which occours sometimes after
//                      the Termination of the Threads (the Overlapped Result wrote into undefined Memory)
//                      Now the WaitCommEvent Overlapped is manually Terminated, by Setting (!) the hEvent manually
//                      Some minor cleanups in Destroy and PortWork. It seem (!) to run now!
// 2.0.12 10. Sep 2002, Again! Small, but significant Error in PortWork. Closing the Handles to the Overlapped
//                      Records should not be there - fixed and running. Thanks to Jens G鰄ring
// 2.0.13 25. Sep 2002, Fixed a Problem for multi instancing, e.g. running two or more SerialNGPorts at the same time
//                      The Names of the Overlapped Events are allway the same, so the second Port used the event from
//                      the previous instanced Port instead creating a new event
// 2.0.14  1. Okt 2002, Made a more robust solution for creating the Eventnames. There is now a 1:200000 chance that
//                      the program can not create a Eventname. This occours only on Multiport installation.
//                      The 1:200000 chance is a compromise between hangup the program in an endless loop and returning an Error.
// 2.0.15 17. Okt 2002, A Ssmall change in the ReadSettings from Registry Procedure suggested by Ron Hoving
//                      After reading the Settings they are used now instantly
// 2.0.16 14. Nov 2002, Patched an suggestion from Krystian (Poland)
//                      The Linestates CTS, DSR and RLSD are now updated, even if no Event is assigned
// 2.0.17 25. Mrz 2003  GetStatus is now (and must!) called prior to DoCommEvent, to ensure the actual state is used
//                      Prozesserror gives the Self pointer (instead the wrong Owner pointer)
//                      The silly Eventname stuff removed
// 2.0.18 24. Jun 2003  Changes on the RI behaviour:
//                      The RI Linestate is now updated at the same place as CTS,DSR and RLSD and valid in the OnCommEvent
//                      The RI Event is now on Win9x/mE simulated as NT/2K/XP does, on the falling RI edge only!!!
//                      Thus the OnRingEvent is called *only* on the falling edge of the signal
//                      Additionally a new OnRIEvent has been inserted. This Event is manually generated if a
//                      change in the RI Signal has been detected.
//                      If Your Program should show a 'RING' ... 'RING' because a Modem is attached use the OnRingEvent
//                      If Your Program will track the RI Pin State use the OnRIEvent
// 2.0.19 07. Okt 2003  New Parameterlist fpr processerror, reinstall of component neccessary
// 2.0.20 15. Okt 2003  Fixing a Thread error: StartTime was uninitilized in the case of receiving Chars between
//                      the opening of the Port and the first 'ReadNoWait'.
//                      Probably this Error will occour only in Debugsessions
// 2.0.21 01. Dec 2003  Made some changes for (more) compatibility to francois piette's ICS.
//                      If in a 'OnDataAvailable' Event of the TWSocket the SerialNG Thread calls 'Synchronize'
//                      the Thread is locked, and the 'SendInProgress' Flag will never become reset.
//                      This behaviour results (probably) in the WndProc work of ICS.
//                      I made a work around: A new Property 'ThreadQuiteMode' is now integrated.
//                      If this Flag become True the Thread will not call synchronize.
//                      Be careful with this Flag, since You receive no messages, you may been misleaded.
//                      You have to Poll incoming data by Yourself.
// 2.0.22 13. Jan 2004  Fixed an Error in QuieteMode using Enter and LeaveCriticalSection. This is made
//                      to add and remove the Data securily without the need of Threadsynchronize
// 2.0.23 13. Mrz 2004  Found and fixed a Problem under fast (2.4GHz) Win2K and XP Computers:
//                      Windows seems to send the EventCharEvent before the received Chars are moved into
//                      the WindowsQueue. So the CommStatus.cbInQue contains an invalid char amount
//                      I now call the ClearCommError at least twice until no changes in the results
// 2.0.24 16. Nov 2004  Fixed a Problem occours under Win2K: wrong result out of GetOverlappedResult
//                      Thanks to Phil Young (62Nds), and ThomasD
// I am working on a Multiport-Single-Thread version, this will cause some incompatiblities to the current version
// This will become Version 2.1.0

interface
{$BOOLEVAL OFF}
uses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs;

  // Definitions for the DCB found in windows.pas for reference only
  // All of the baud rates that the DCB supports.
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);
// The business with the TimeOuts during sending Data, and esspeccialy during
// reception of Data depends on the selected Baudrate.
// while on 9600 Baud every 1ms a Char is received, is this time on 256KBaud only 4祍
// Strange enough, windows support only 1ms as shortest Intervall!
// Below some standard TimeOuts for the given Baudrates in 祍
  XTOCharDelayDef : array [0..BaudRateCount-1] of DWord =
(100000, 37000, 18000, 9000, 4500, 2300, 1100, 760, 570, 290, 200, 190, 95, 85, 43);
  // Parity types for parity error checking
  // NOPARITY = 0;  ODDPARITY = 1;  EVENPARITY = 2;  MARKPARITY = 3;  SPACEPARITY = 4;
  // Stopbits
  // ONESTOPBIT = 0;   ONE5STOPBITS = 1;  TWOSTOPBITS = 2;
  // Bitmasks for the "Flags" Field of the DCB record
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
// You may declare more _exotic_ Modes, like Sending RTS/CTS, receiving XOn/XOff :-)
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);

// Constants for using in the ErrorNoise Property
// I tried to catch Errors, send Warnings or sometimes Messages for Your convinience.
// If You set the ErrorNoise Property to one of the Values this kind of Messages will be reported
// while those with higher Numbers not
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 = 'COM2';
  dflt_BaudRate = CBR_9600;
  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 = True;
  dflt_DTRState = True;
  dflt_ErrorNoise = enMsg;
  dflt_BREAKState = False;
  dflt_RxQueueSize = 4096;
  dflt_TxQueueSize = 4096;
  dflt_ThreadQuietMode = False;
  dflt_AutoReadRequest = False;
type

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

// TSerialCluster is a Object for the Receiving Process.
// If You just want to receive some Data, don't care
// Under normal circumstances You have not to deal with this Object

// I decided to realize the receiving Process as follow:
// Between two cycles in the WorkThread may the SerialPort receive more than one Character.
// Basicly those Chars are named "Cluster" (and not "Telegram", as You might expect)
// How many Chars are stored in one TSerialCluster depeds on, User controlled,  Conditions
// 1. the ClusterSize is reched
// 2. the Receivingtime is reached
// 3. an (Line-) Error occoured
// 4. The Program set the "ReadRequest" Property to "True"
// If the condition is met, the received Chars are Stored as a Cluster into the ClusterList

  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
//  CE_RXOVER = 1;        { Receive Queue overflow }
//  CE_OVERRUN = 2;       { Receive Overrun Error }
//  CE_RXPARITY = 4;      { Receive Parity Error }
//  CE_FRAME = 8;         { Receive Framing error }
//  CE_BREAK = $10;       { Break Detected }
//  CE_TXFULL = $100;     { TX Queue is full }
//  CE_MODE = $8000;      { Requested mode unsupported }

    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;

// TSerialPortNG is the Heart of the Job, everything what has to do with the
// SerialPort should be done with this Component
// The Concept is as follows:
// After instancing the Port is still closed
// You should set the Property "CommPort" to the full Name of the Port e.g. 'COM1'
// After this set the "Active" Property to "True"
// Sending Data ist performed with the SendData or the SendString procedures
// since Sendig is "Overlapped" the procedures returns immidiatly and You can do
// some other Jobs in Your main Programm
// You should not reentry this Procedures until they done there Job (Will give a warning).
// If send is done the component call the "OnWriteDone" Event.
// You also can ask the "SendInProgress" Property.
// Reading Data is fairly simple, just Read the Data with one of the "ReadNextCluster..." functions
// You place the read Access into the "OnRxClusterEvent".
// See sample Programs for more Information
  TSerialPortNG = class(TComponent)
  private
    // Variables holding Values for Properties
    fCommPort : ShortString;
    fBaudRate : DWord;
    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
    fSendInProgress : Boolean;
    fWrittenBytes : DWord;
    fThreadQuietMode : Boolean;
    fAutoReadRequest : Boolean;