[fpc-pascal] fpc and serial port

[Carsten Bager]

> May I have a few examples to access /dev/ttyS* using fpc?

---------------------------------------------------------------------
{$mode objfpc}
{$LONGSTRINGS OFF}
Unit uSio;


Interface

Type
  DataBuffer_typ=packed array[0..4095] of char;
  SendPacket_typ=Procedure(var b:DataBuffer_typ; len:longint);

  SioListen_typ=class(TObject)
  private
    sio:LongInt;
    Sio_BufLen:LongInt;
    Sio_buf:DataBuffer_typ;
    Sio_bufSize:LongInt;
    Debug:boolean;
    SendPacket:SendPacket_typ;
  protected
  public
    procedure Execute;
    Procedure SendCh(c:char);
    constructor Create(Sio_Device:shortstring; Sio_baud:word; 
pDebug:boolean; pSendPacket:SendPacket_typ);
    Destructor Destroy;  override;
  end;




Implementation

Uses
   sysutils,    {System }
   serial;      {Linux system}

Const
  cUnitVersion=' 1.00  ';

constructor SioListen_typ.Create(Sio_Device:shortstring; Sio_baud:word; 
pDebug:boolean; pSendPacket:SendPacket_typ);
Begin
  inherited Create;
  Debug:=pDebug;
  SendPacket:=pSendPacket;
  if Debug then
    WriteLn('SIO-device:',Sio_Device);
  sio:=serial.SerOpen(Sio_Device);
  serial.SerSetParams(sio,Sio_baud,8,NoneParity,1,[]);
  serial.SerSetDTR(sio,false);
  serial.SerSetRTS(sio,false);
  Sio_bufSize:=0;
End;

Destructor SioListen_typ.Destroy;
Begin
  if Debug then
    WriteLn('Destroying SIO-thread ...');
  serial.serClose(sio);
  if Debug then
    WriteLn('SIO-thread destroyed');
  inherited Destroy;
End;




Procedure SioListen_typ.Execute;
Begin
  Sio_bufSize:=0;
  repeat
    Sio_BufLen:=sizeof(DataBuffer_typ)-Sio_bufSize;
    Sio_BufLen:=serial.SerRead(sio,Sio_Buf[Sio_bufSize],Sio_BufLen);
    if Sio_BufLen<>0 then
    begin
      if Debug then
      begin
        WriteLn('Sio-read:',Sio_BufLen);
      end;
      Sio_bufSize:=Sio_bufSize+Sio_BufLen;
      if Debug then
      begin
        WriteLn('Packet (end) size:',Sio_bufSize);
      end;
    end;
    sleep(10);                          {Vent 1/100 sek pÕ at der kommer mere}
  until (Sio_BufLen=0) or (Sio_bufSize=sizeof(DataBuffer_typ));
  if Sio_bufSize<>0 then
    SendPacket(Sio_Buf,Sio_bufSize);
End;

Procedure SioListen_typ.SendCh(c:char);
Begin
  serial.SerWrite(sio,c,1);
End;

Begin
  Writeln('Unit (',{$I %FILE%}:21,') Unit Version:',cUnitVersion,' compiled at 
',{$I %TIME%},' US date:',{$I %DATE%},' By ',{$I %USER%},' Fpc: ',{$I 
%FPCVERSION%});
End.
Med venlig hilsen
Carsten Bager

BEAS A/S
Brørupvænget 10
DK-7650 Bøvlingbjerg
Tlf. : +45 9788 5222 Fax : +45 9788 5434
www.beas.dk