synaser.pas

Synapse The synchronyous socket library. File content: 1.) About Synapse 2.) Distribution pa

{==============================================================================|
| Project : Ararat Synapse                                       | 007.000.001 |
|==============================================================================|
| Content: Serial port support                                                 |
|==============================================================================|
| Copyright (c)2001-2006, Lukas Gebauer                                        |
| All rights reserved.                                                         |
|                                                                              |
| Redistribution and use in source and binary forms, with or without           |
| modification, are permitted provided that the following conditions are met:  |
|                                                                              |
| Redistributions of source code must retain the above copyright notice, this  |
| list of conditions and the following disclaimer.                             |
|                                                                              |
| Redistributions in binary form must reproduce the above copyright notice,    |
| this list of conditions and the following disclaimer in the documentation    |
| and/or other materials provided with the distribution.                       |
|                                                                              |
| Neither the name of Lukas Gebauer nor the names of its contributors may      |
| be used to endorse or promote products derived from this software without    |
| specific prior written permission.                                           |
|                                                                              |
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
| DAMAGE.                                                                      |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)2001-2006.                |
| All Rights Reserved.                                                         |
|==============================================================================|
| Contributor(s):                                                              |
|  (c)2002, Hans-Georg Joepgen (cpom Comport Ownership Manager and bugfixes)   |
|==============================================================================|
| History: see HISTORY.HTM from distribution package                           |
|          (Found at URL: http://www.ararat.cz/synapse/)                       |
|==============================================================================}

{: @abstract(Serial port communication library)
This unit contains a class that implements serial port communication for Windows
 or Linux. This class provides numerous methods with same name and functionality
  as methods of the Ararat Synapse TCP/IP library.

The following is a small example how establish a connection by modem (in this
case with my USB modem):
@longcode(#
  ser:=TBlockSerial.Create;
  try
    ser.Connect('COM3');
    ser.config(460800,8,'N',0,false,true);
    ser.ATCommand('AT');
    if (ser.LastError <> 0) or (not ser.ATResult) then
      Exit;
    ser.ATConnect('ATDT+420971200111');
    if (ser.LastError <> 0) or (not ser.ATResult) then
      Exit;
    // you are now connected to a modem at [phone]
    // you can transmit or receive data now
  finally
    ser.free;
  end;
#)
}

{$IFDEF FPC}
  {$MODE DELPHI}
  {$IFDEF WIN32}
    {$ASMMODE intel}
  {$ENDIF}
{$ENDIF}
{$Q-}
{$H+}
{$M+}

unit synaser;

interface

uses
{$IFNDEF WIN32}
  Libc, KernelIoctl,
  {$IFDEF FPC}
  synafpc, termio,
  {$ELSE}
  Types,
  {$ENDIF}
{$ELSE}
  Windows, registry,
  {$IFDEF FPC}
  winver,
  {$ENDIF}
{$ENDIF}
  Classes, SysUtils, synautil;

const
  CR = #$0d;
  LF = #$0a;
  CRLF = CR + LF;
  cSerialChunk = 8192;

  LockfileDirectory = '/var/lock'; {HGJ}
  PortIsClosed = -1;               {HGJ}
  ErrAlreadyOwned = 9991;          {HGJ}
  ErrAlreadyInUse = 9992;          {HGJ}
  ErrWrongParameter = 9993;        {HGJ}
  ErrPortNotOpen = 9994;           {HGJ}
  ErrNoDeviceAnswer =  9995;       {HGJ}
  ErrMaxBuffer = 9996;
  ErrTimeout = 9997;
  ErrNotRead = 9998;
  ErrFrame = 9999;
  ErrOverrun = 10000;
  ErrRxOver = 10001;
  ErrRxParity = 10002;
  ErrTxFull = 10003;

  dcb_Binary = $00000001;
  dcb_ParityCheck = $00000002;
  dcb_OutxCtsFlow = $00000004;
  dcb_OutxDsrFlow = $00000008;
  dcb_DtrControlMask = $00000030;
  dcb_DtrControlDisable = $00000000;
  dcb_DtrControlEnable = $00000010;
  dcb_DtrControlHandshake = $00000020;
  dcb_DsrSensivity = $00000040;
  dcb_TXContinueOnXoff = $00000080;
  dcb_OutX = $00000100;
  dcb_InX = $00000200;
  dcb_ErrorChar = $00000400;
  dcb_NullStrip = $00000800;
  dcb_RtsControlMask = $00003000;
  dcb_RtsControlDisable = $00000000;
  dcb_RtsControlEnable = $00001000;
  dcb_RtsControlHandshake = $00002000;
  dcb_RtsControlToggle = $00003000;
  dcb_AbortOnError = $00004000;
  dcb_Reserveds = $FFFF8000;

  {:stopbit value for 1 stopbit}
  SB1 = 0;
  {:stopbit value for 1.5 stopbit}
  SB1andHalf = 1;
  {:stopbit value for 2 stopbits}
  SB2 = 2;

{$IFNDEF WIN32}
const
  INVALID_HANDLE_VALUE = THandle(-1);
  CS7fix = $0000020;

type
  TDCB = packed 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;
  PDCB = ^TDCB;

const
  MaxRates = 30;
  Rates: array[0..MaxRates, 0..1] of cardinal =
  (
    (0, B0),
    (50, B50),
    (75, B75),
    (110, B110),
    (134, B134),
    (150, B150),
    (200, B200),
    (300, B300),
    (600, B600),
    (1200, B1200),
    (1800, B1800),
    (2400, B2400),
    (4800, B4800),
    (9600, B9600),
    (19200, B19200),
    (38400, B38400),
    (57600, B57600),
    (115200, B115200),
    (230400, B230400),
    (460800, B460800),
    (500000, B500000),
    (576000, B576000),
    (921600, B921600),
    (1000000, B1000000),
    (1152000, B1152000),
    (1500000, B1500000),
    (2000000, B2000000),
    (2500000, B2500000),
    (3000000, B3000000),
    (3500000, B3500000),
    (4000000, B4000000)
    );
{$ENDIF}

const
  sOK = 0;
  sErr = integer(-1);

type

  {:Possible status event types for @link(THookSerialStatus)}
  THookSerialReason = (
    HR_SerialClose,
    HR_Connect,
    HR_CanRead,
    HR_CanWrite,
    HR_ReadCount,
    HR_WriteCount,
    HR_Wait
    );

  {:procedural prototype for status event hooking}
  THookSerialStatus = procedure(Sender: TObject; Reason: THookSerialReason;
    const Value: string) of object;

  {:@abstract(Exception type for SynaSer errors)}
  ESynaSerError = class(Exception)
  public
    ErrorCode: integer;
    ErrorMessage: string;
  end;

  {:@abstract(Main class implementing all communication routines)}
  TBlockSerial = class(TObject)
  protected
    FOnStatus: THookSerialStatus;
    Fhandle: THandle;
    FTag: integer;
    FDevice: string;
    FLastError: integer;
    FLastErrorDesc: string;
    FBuffer: string;
    FRaiseExcept: boolean;
    FRecvBuffer: integer;
    FSendBuffer: integer;
    FModemWord: integer;
    FRTSToggle: Boolean;
    FDeadlockTimeout: integer;
    FInstanceActive: boolean;      {HGJ}
    FTestDSR: Boolean;
    FTestCTS: Boolean;
    FLastCR: Boolean;
    FLastLF: Boolean;
    FMaxLineLength: Integer;
    FLinuxLock: Boolean;
    FMaxSendBandwidth: Integer;
    FNextSend: ULong;
    FMaxRecvBandwidth: Integer;
    FNextRecv: ULong;
    FConvertLineEnd: Boolean;
    FATResult: Boolean;
    FAtTimeout: integer;
    FInterPacketTimeout: Boolean;
    FComNr: integer;
{$IFDEF WIN32}
    FPortAddr: Word;
    function CanEvent(Event: dword; Timeout: integer): boolean;
    procedure DecodeCommError(Error: DWord); virtual;
    function GetPortAddr: Word;  virtual;
    function ReadTxEmpty(PortAddr: Word): Boolean; virtual;
{$ENDIF}
    procedure SetSizeRecvBuffer(size: integer); virtual;
    function GetDSR: Boolean; virtual;
    procedure SetDTRF(Value: Boolean); virtual;
    function GetCTS: Boolean; virtual;
    procedure SetRTSF(Value: Boolean); virtual;
    function GetCarrier: Boolean; virtual;
    function GetRing: Boolean; virtual;
    procedure DoStatus(Reason: THookSerialReason; const Value: string); virtual;
    procedure GetComNr(Value: string); virtual;
    function PreTestFailing: boolean; virtual;{HGJ}
    function TestCtrlLine: Boolean; virtual;
{$IFNDEF WIN32}
    procedure DcbToTermios(const dcb: TDCB; var term: libc.termios); virtual;
    procedure TermiosToDcb(const term: libc.termios; var dcb: TDCB); virtual;
{$ENDIF}
{$IFDEF LINUX}
    function ReadLockfile: integer; virtual;
    function LockfileName: String; virtual;
    procedure CreateLockfile(PidNr: integer); virtual;
{$ENDIF}
    procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: ULong); virtual;
    procedure SetBandwidth(Value: Integer); virtual;
  public
    {: data Control Block with communication parameters. Usable only when you
     need to call API directly.}
    DCB: Tdcb;
{$IFNDEF WIN32}
    TermiosStruc: libc.termios;
{$ENDIF}
    {:Object constructor.}
    constructor Create;
    {:Object destructor.}
    destructor Destroy; override;

    {:Returns a string containing the version number of the library.}
    class function GetVersion: string; virtual;

    {:Destroy handle in use. It close connection to serial port.}
    procedure CloseSocket; virtual;

    {:Reconfigure communication parameters on the fly. You must be connected to
     port before!
     @param(baud Define connection speed. Baud rate can be from 50 to 4000000
      bits per second. (it depends on your hardware!))
     @param(bits Number of bits in communication.)
     @param(parity Define communication parity (N - None, O - Odd, E - Even, M - Mark or S - Space).)
     @param(stop Define number of stopbits. Use constants @link(SB1),
      @link(SB1andHalf) and @link(SB2).)
     @param(softflow Enable XON/XOFF handshake.)
     @param(hardflow Enable CTS/RTS handshake.)}
    procedure Config(baud, bits: integer; parity: char; stop: integer;
      softflow, hardflow: boolean); virtual;

    {:Connects to the port indicated by comport. Comport can be used in Windows
     style (COM2), or in Linux style (/dev/ttyS1). When you use windows style
     in Linux, then it will be converted to Linux name. And vice versa! However
     you can specify any device name! (other device names then standart is not
     converted!)

     After successfull connection the DTR signal is set (if you not set hardware
     handshake, then the RTS signal is set, too!)

     Connection parameters is predefined by your system configuration. If you
     need use another parameters, then you can use Config method after.
     Notes:

      - Remember, the commonly used serial Laplink cable does not support
       hardware handshake.

      - Before setting any handshake you must be sure that it is supported by
       your hardware.

      - Some serial devices are slow. In some cases you must wait up to a few
       seconds after connection for the device to respond.

      - when you connect to a modem device, then is best to test it by an empty
       AT command. (call ATCommand('AT'))}
    procedure Connect(comport: string); virtual;

    {:Set communication parameters from the DCB structure (the DCB structure is
     simulated under Linux).}
    procedure SetCommState; virtual;

    {:Read communication parameters into the DCB structure (DCB structure is
     simulated under Linux).}
    procedure GetCommState; virtual;

    {:Sends Length bytes of data from Buffer through the connected port.}
    function SendBuffer(buffer: pointer; length: integer): integer; virtual;

    {:One data BYTE is sent.}
    procedure SendByte(data: byte); virtual;

    {:Send the string in the data parameter. No terminator is appended by this
     method. If you need to send a string with CR/LF terminator, you must append
     the CR/LF characters to the data string!

     Since no terminator is appended, you can use this function for sending
     binary data too.}
    procedure SendString(data: string); virtual;

    {:send four bytes as integer.}
    procedure SendInteger(Data: integer); virtual;

    {:send data as one block. Each block begins with integer value with Length
     of block.}
    procedure SendBlock(const Data: string); virtual;

    {:send content of stream from current position}
    procedure SendStreamRaw(const Stream: TStream); virtual;

    {:send content of stream as block. see @link(SendBlock)}
    procedure SendStream(const Stream: TStream); virtual;

    {:send content of stream as block, but this is compatioble with Indy library.
     (it have swapped lenght of block). See @link(SendStream)}
    procedure SendStreamIndy(const Stream: TStream); virtual;

    {:Waits until the allocated buffer is filled by received data. Returns number
     of data bytes received, which equals to the Length value under normal
     operation. If it is not equal, the communication channel is possibly broken.

     This method not using any internal buffering, like all others receiving
     methods. You cannot freely combine this method with all others receiving
     methods!}
    function RecvBuffer(buffer: pointer; length: integer): integer; virtual;

    {:Method waits until data is received. If no data is received within
     the Timeout (in milliseconds) period, @link(LastError) is set to
     @link(ErrTimeout). This method is used to read any amount of data
     (e. g. 1MB), and may be freely combined with all receviving methods what
     have Timeout parameter, like the @link(RecvString), @link(RecvByte) or
     @link(RecvTerminated) methods.}
    function RecvBufferEx(buffer: pointer; length: integer; timeout: integer): integer; virtual;

    {:It is like recvBufferEx, but data is readed to dynamicly allocated binary
     string.}
    function RecvBufferStr(Length: Integer; Timeout: Integer): string; virtual;

    {:Read all available data and return it in the function result string. This
     function may be combined with @link(RecvString), @link(RecvByte) or related
     methods.}
    function RecvPacket(Timeout: Integer): string; virtual;

    {:Waits until one data byte is received which is returned as the function
     result. If no data is received within the Timeout (in milliseconds) period,
     @link(LastError) is set to @link(ErrTimeout).}
    function RecvByte(timeout: integer): byte; virtual;

    {:This method waits until a terminated data string is received. This string
     is terminated by the Terminator string. The resulting string is returned
     without this termination string! If no data is received within the Timeout
     (in milliseconds) period, @link(LastError) is set to @link(ErrTimeout).}
    function RecvTerminated(Timeout: Integer; const Terminator: string): string; virtual;

    {:This method waits until a terminated data string is received. The string
     is terminated by a CR/LF sequence. The resulting string is returned without
     the terminator (CR/LF)! If no data is received within the Timeout (in
     milliseconds) period, @link(LastError) is set to @link(ErrTimeout).