synaser.pas

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

     If @link(ConvertLineEnd) is used, then the CR/LF sequence may not be exactly
     CR/LF. See the description of @link(ConvertLineEnd).

     This method serves for line protocol implementation and uses its own
     buffers to maximize performance. Therefore do NOT use this method with the
     @link(RecvBuffer) method to receive data as it may cause data loss.}
    function Recvstring(timeout: integer): string; virtual;

    {:Waits until four data bytes are received which is returned as the function
     integer result. If no data is received within the Timeout (in milliseconds) period,
     @link(LastError) is set to @link(ErrTimeout).}
    function RecvInteger(Timeout: Integer): Integer; virtual;

    {:Waits until one data block is received. See @link(sendblock). If no data
     is received within the Timeout (in milliseconds) period, @link(LastError)
     is set to @link(ErrTimeout).}
    function RecvBlock(Timeout: Integer): string; virtual;

    {:Receive all data to stream, until some error occured. (for example timeout)}
    procedure RecvStreamRaw(const Stream: TStream; Timeout: Integer); virtual;

    {:receive requested count of bytes to stream}
    procedure RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer); virtual;

    {:receive block of data to stream. (Data can be sended by @link(sendstream)}
    procedure RecvStream(const Stream: TStream; Timeout: Integer); virtual;

    {:receive block of data to stream. (Data can be sended by @link(sendstreamIndy)}
    procedure RecvStreamIndy(const Stream: TStream; Timeout: Integer); virtual;

    {:Returns the number of received bytes waiting for reading. 0 is returned
     when there is no data waiting.}
    function WaitingData: integer; virtual;

    {:Same as @link(WaitingData), but in respect to data in the internal
     @link(LineBuffer).}
    function WaitingDataEx: integer; virtual;

    {:Returns the number of bytes waiting to be sent in the output buffer.
     0 is returned when the output buffer is empty.}
    function SendingData: integer; virtual;

    {:Enable or disable RTS driven communication (half-duplex). It can be used
     to communicate with RS485 converters, or other special equipment. If you
     enable this feature, the system automatically controls the RTS signal.

     Notes:

     - On Windows NT (or higher) ir RTS signal driven by system driver.

     - On Win9x family is used special code for waiting until last byte is
      sended from your UART.

     - On Linux you must have kernel 2.1 or higher!}
    procedure EnableRTSToggle(value: boolean); virtual;

    {:Waits until all data to is sent and buffers are emptied.
     Warning: On Windows systems is this method returns when all buffers are
     flushed to the serial port controller, before the last byte is sent!}
    procedure Flush; virtual;

    {:Unconditionally empty all buffers. It is good when you need to interrupt
     communication and for cleanups.}
    procedure Purge; virtual;

    {:Returns @True, if you can from read any data from the port. Status is
     tested for a period of time given by the Timeout parameter (in milliseconds).
     If the value of the Timeout parameter is 0, the status is tested only once
     and the function returns immediately. If the value of the Timeout parameter
     is set to -1, the function returns only after it detects data on the port
     (this may cause the process to hang).}
    function CanRead(Timeout: integer): boolean; virtual;

    {:Returns @True, if you can write any data to the port (this function is not
     sending the contents of the buffer). Status is tested for a period of time
     given by the Timeout parameter (in milliseconds). If the value of
     the Timeout parameter is 0, the status is tested only once and the function
     returns immediately. If the value of the  Timeout parameter is set to -1,
     the function returns only after it detects that it can write data to
     the port (this may cause the process to hang).}
    function CanWrite(Timeout: integer): boolean; virtual;

    {:Same as @link(CanRead), but the test is against data in the internal
    @link(LineBuffer) too.}
    function CanReadEx(Timeout: integer): boolean; virtual;

    {:Returns the status word of the modem. Decoding the status word could yield
     the status of carrier detect signaland other signals. This method is used
     internally by the modem status reading properties. You usually do not need
     to call this method directly.}
    function ModemStatus: integer; virtual;

    {:Send a break signal to the communication device for Duration milliseconds.}
    procedure SetBreak(Duration: integer); virtual;

    {:This function is designed to send AT commands to the modem. The AT command
     is sent in the Value parameter and the response is returned in the function
     return value (may contain multiple lines!).
     If the AT command is processed successfully (modem returns OK), then the
     @link(ATResult) property is set to True.

     This function is designed only for AT commands that return OK or ERROR
     response! To call connection commands the @link(ATConnect) method.
     Remember, when you connect to a modem device, it is in AT command mode.
     Now you can send AT commands to the modem. If you need to transfer data to
     the modem on the other side of the line, you must first switch to data mode
     using the @link(ATConnect) method.}
    function ATCommand(value: string): string; virtual;

    {:This function is used to send connect type AT commands to the modem. It is
     for commands to switch to connected state. (ATD, ATA, ATO,...)
     It sends the AT command in the Value parameter and returns the modem's
     response (may be multiple lines - usually with connection parameters info).
     If the AT command is processed successfully (the modem returns CONNECT),
     then the ATResult property is set to @True.

     This function is designed only for AT commands which respond by CONNECT,
     BUSY, NO DIALTONE NO CARRIER or ERROR. For other AT commands use the
     @link(ATCommand) method.

     The connect timeout is 90*@link(ATTimeout). If this command is successful
     (@link(ATresult) is @true), then the modem is in data state. When you now
     send or receive some data, it is not to or from your modem, but from the
     modem on other side of the line. Now you can transfer your data.
     If the connection attempt failed (@link(ATResult) is @False), then the
     modem is still in AT command mode.}
    function ATConnect(value: string): string; virtual;

    {:If you "manually" call API functions, forward their return code in
     the SerialResult parameter to this function, which evaluates it and sets
     @link(LastError) and @link(LastErrorDesc).}
    function SerialCheck(SerialResult: integer): integer; virtual;

    {:If @link(Lasterror) is not 0 and exceptions are enabled, then this procedure
     raises an exception. This method is used internally. You may need it only
     in special cases.}
    procedure ExceptCheck; virtual;

    {:Set Synaser to error state with ErrNumber code. Usually used by internal
     routines.}
    procedure SetSynaError(ErrNumber: integer); virtual;

    {:Raise Synaser error with ErrNumber code. Usually used by internal routines.}
    procedure RaiseSynaError(ErrNumber: integer); virtual;
{$IFDEF LINUX}
    function  cpomComportAccessible: boolean; virtual;{HGJ}
    procedure cpomReleaseComport; virtual; {HGJ}
{$ENDIF}
    {:True device name of currently used port}
    property Device: string read FDevice;

    {:Error code of last operation. Value is defined by the host operating
     system, but value 0 is always OK.}
    property LastError: integer read FLastError;

    {:Human readable description of LastError code.}
    property LastErrorDesc: string read FLastErrorDesc;

    {:Indicates if the last @link(ATCommand) or @link(ATConnect) method was successful}
    property ATResult: Boolean read FATResult;

    {:Read the value of the RTS signal.}
    property RTS: Boolean write SetRTSF;

    {:Indicates the presence of the CTS signal}
    property CTS: boolean read GetCTS;

    {:Use this property to set the value of the DTR signal.}
    property DTR: Boolean write SetDTRF;

    {:Exposes the status of the DSR signal.}
    property DSR: boolean read GetDSR;

    {:Indicates the presence of the Carrier signal}
    property Carrier: boolean read GetCarrier;

    {:Reflects the status of the Ring signal.}
    property Ring: boolean read GetRing;

    {:indicates if this instance of SynaSer is active. (Connected to some port)}
    property InstanceActive: boolean read FInstanceActive; {HGJ}

    {:Defines maximum bandwidth for all sending operations in bytes per second.
     If this value is set to 0 (default), bandwidth limitation is not used.}
    property MaxSendBandwidth: Integer read FMaxSendBandwidth Write FMaxSendBandwidth;

    {:Defines maximum bandwidth for all receiving operations in bytes per second.
     If this value is set to 0 (default), bandwidth limitation is not used.}
    property MaxRecvBandwidth: Integer read FMaxRecvBandwidth Write FMaxRecvBandwidth;

    {:Defines maximum bandwidth for all sending and receiving operations
     in bytes per second. If this value is set to 0 (default), bandwidth
     limitation is not used.}
    property MaxBandwidth: Integer Write SetBandwidth;

    {:Size of the Windows internal receive buffer. Default value is usually
     4096 bytes. Note: Valid only in Windows versions!}
    property SizeRecvBuffer: integer read FRecvBuffer write SetSizeRecvBuffer;
  published
    {:Returns the descriptive text associated with ErrorCode. You need this
     method only in special cases. Description of LastError is now accessible
     through the LastErrorDesc property.}
    class function GetErrorDesc(ErrorCode: integer): string;

    {:Freely usable property}
    property Tag: integer read FTag write FTag;

    {:Contains the handle of the open communication port.
    You may need this value to directly call communication functions outside
    SynaSer.}
    property Handle: THandle read Fhandle write FHandle;

    {:Internally used read buffer.}
    property LineBuffer: string read FBuffer write FBuffer;

    {:If @true, communication errors raise exceptions. If @false (default), only
     the @link(LastError) value is set.}
    property RaiseExcept: boolean read FRaiseExcept write FRaiseExcept;

    {:This event is triggered when the communication status changes. It can be
     used to monitor communication status.}
    property OnStatus: THookSerialStatus read FOnStatus write FOnStatus;

    {:If you set this property to @true, then the value of the DSR signal
     is tested before every data transfer. It can be used to detect the presence
     of a communications device.}
    property TestDSR: boolean read FTestDSR write FTestDSR;

    {:If you set this property to @true, then the value of the CTS signal
     is tested before every data transfer. It can be used to detect the presence
     of a communications device. Warning: This property cannot be used if you
     need hardware handshake!}
    property TestCTS: boolean read FTestCTS write FTestCTS;

    {:Use this property you to limit the maximum size of LineBuffer
     (as a protection against unlimited memory allocation for LineBuffer).
     Default value is 0 - no limit.}
    property MaxLineLength: Integer read FMaxLineLength Write FMaxLineLength;

    {:This timeout value is used as deadlock protection when trying to send data
     to (or receive data from) a device that stopped communicating during data
     transmission (e.g. by physically disconnecting the device).
     The timeout value is in milliseconds. The default value is 30,000 (30 seconds).}
    property DeadlockTimeout: Integer read FDeadlockTimeout Write FDeadlockTimeout;

    {:If set to @true (default value), port locking is enabled (under Linux only).
     WARNING: To use this feature, the application must run by a user with full
     permission to the /var/lock directory!}
    property LinuxLock: Boolean read FLinuxLock write FLinuxLock;

    {:Indicates if non-standard line terminators should be converted to a CR/LF pair
     (standard DOS line terminator). If @TRUE, line terminators CR, single LF
     or LF/CR are converted to CR/LF. Defaults to @FALSE.
     This property has effect only on the behavior of the RecvString method.}
    property ConvertLineEnd: Boolean read FConvertLineEnd Write FConvertLineEnd;

    {:Timeout for AT modem based operations}
    property AtTimeout: integer read FAtTimeout Write FAtTimeout;

    {:If @true (default), then all timeouts is timeout between two characters.
     If @False, then timeout is overall for whoole reading operation.}
    property InterPacketTimeout: Boolean read FInterPacketTimeout Write FInterPacketTimeout;
  end;

{:Returns list of existing computer serial ports. Working properly only in Windows!}
function GetSerialPortNames: string;

implementation

constructor TBlockSerial.Create;
begin
  inherited create;
  FRaiseExcept := false;
  FHandle := INVALID_HANDLE_VALUE;
  FDevice := '';
  FComNr:= PortIsClosed;               {HGJ}
  FInstanceActive:= false;             {HGJ}
  Fbuffer := '';
  FRTSToggle := False;
  FMaxLineLength := 0;
  FTestDSR := False;
  FTestCTS := False;
  FDeadlockTimeout := 30000;
  FLinuxLock := True;
  FMaxSendBandwidth := 0;
  FNextSend := 0;
  FMaxRecvBandwidth := 0;
  FNextRecv := 0;
  FConvertLineEnd := False;
  SetSynaError(sOK);
  FRecvBuffer := 4096;
  FLastCR := False;
  FLastLF := False;
  FAtTimeout := 1000;
  FInterPacketTimeout := True;
end;

destructor TBlockSerial.Destroy;
begin
  CloseSocket;
  inherited destroy;
end;

class function TBlockSerial.GetVersion: string;
begin
	Result := 'SynaSer 6.3.5';
end;

procedure TBlockSerial.CloseSocket;
begin
  if Fhandle <> INVALID_HANDLE_VALUE then
  begin
    Purge;
    RTS := False;
    DTR := False;
    FileClose(integer(FHandle));
  end;
  if InstanceActive then
  begin
    {$IFDEF LINUX}
    if FLinuxLock then
      cpomReleaseComport;
    {$ENDIF}
    FInstanceActive:= false
  end;
  Fhandle := INVALID_HANDLE_VALUE;
  FComNr:= PortIsClosed;
  SetSynaError(sOK);
  DoStatus(HR_SerialClose, FDevice);
end;

{$IFDEF WIN32}
function TBlockSerial.GetPortAddr: Word;
begin
  Result := 0;
  if Win32Platform <> VER_PLATFORM_WIN32_NT then
  begin
    EscapeCommFunction(FHandle, 10);
    asm
      MOV @Result, DX;
    end;
  end;
end;

function TBlockSerial.ReadTxEmpty(PortAddr: Word): Boolean;
begin
  Result := True;
  if Win32Platform <> VER_PLATFORM_WIN32_NT then
  begin
    asm
      MOV DX, PortAddr;
      ADD DX, 5;
      IN AL, DX;
      AND AL, $40;
      JZ @K;
      MOV AL,1;
    @K: MOV @Result, AL;
    end;
  end;
end;
{$ENDIF}

procedure TBlockSerial.GetComNr(Value: string);
begin
  FComNr := PortIsClosed;
  if pos('COM', uppercase(Value)) = 1 then
    FComNr := StrToIntdef(copy(Value, 4, Length(Value) - 3), PortIsClosed + 1) - 1;
  if pos('/DEV/TTYS', uppercase(Value)) = 1 then
    FComNr := StrToIntdef(copy(Value, 10, Length(Value) - 9), PortIsClosed - 1);
end;

procedure TBlockSerial.SetBandwidth(Value: Integer);
begin
  MaxSendBandwidth := Value;
  MaxRecvBandwidth := Value;
end;

procedure TBlockSerial.LimitBandwidth(Length: Integer; MaxB: integer; var Next: ULong);
var
  x: ULong;
  y: ULong;
begin
  if MaxB > 0 then
  begin
    y := GetTick;
    if Next > y then
    begin
      x := Next - y;
      if x > 0 then
      begin
        DoStatus(HR_Wait, IntToStr(x));
        sleep(x);
      end;
    end;
    Next := GetTick + Trunc((Length / MaxB) * 1000);
  end;
end;

procedure TBlockSerial.Config(baud, bits: integer; parity: char; stop: integer;
  softflow, hardflow: boolean);
begin
  FillChar(dcb, SizeOf(dcb), 0);
  dcb.DCBlength := SizeOf(dcb);
  dcb.BaudRate := baud;
  dcb.ByteSize := bits;
  case parity of
    'N', 'n': dcb.parity := 0;
    'O', 'o': dcb.parity := 1;
    'E', 'e': dcb.parity := 2;
    'M', 'm': dcb.parity := 3;
    'S', 's': dcb.parity := 4;
  end;
  dcb.StopBits := stop;
  dcb.XonChar := #17;
  dcb.XoffChar := #19;
  dcb.XonLim := FRecvBuffer div 4;
  dcb.XoffLim := FRecvBuffer div 4;
  dcb.Flags := dcb_Binary;
  if softflow then
    dcb.Flags := dcb.Flags or dcb_OutX or dcb_InX;
  if hardflow then
    dcb.Flags := dcb.Flags or dcb_OutxCtsFlow or dcb_RtsControlHandshake
  else
    dcb.Flags := dcb.Flags or dcb_RtsControlEnable;
  dcb.Flags := dcb.Flags or dcb_DtrControlEnable;
  if dcb.Parity > 0 then
    dcb.Flags := dcb.Flags or dcb_ParityCheck;
  SetCommState;
end;

procedure TBlockSerial.Connect(comport: string);
{$IFDEF WIN32}
var
  CommTimeouts: TCommTimeouts;
{$ENDIF}
begin
  // Is this TBlockSerial Instance already busy?
  if InstanceActive then           {HGJ}
  begin                            {HGJ}
    RaiseSynaError(ErrAlreadyInUse);
    Exit;                          {HGJ}
  end;                             {HGJ}