Serial bus (RS422) device server

Having multiple devices with an identical protocol on a RS422 bus requires a common resource handler that takes care of the serial port. Here the build of such a server is described. The devicehandler are called GUIs, and the serialport handler is called device_server.

the internal communication - overview

The serial bus is assumed a master slave bus here. The baudrate of the serial bus is the same for all devices since all follow the whole traffic. Each device on the bus has a unique ID. The communication is message based. Each command sent to the device is answered with a reply rather quickly, ideally immediately. The bus is considered locked between a command and a reply, unless a timeout is faster. The timeout is much longer than the longest delay for a reply. The physical media can be an RS422 or perhaps an RS485 line with a number of attached nodes.

The internal communication between the GUIs and the device_server is using the Ethernet protocol. The advantages are the portability to other PCs, and there may be a LAN between the GUI and the device_server. The protocol between GUI and device is connectionless. This quite fits with the connectionless property of UDP. For each command received, the device generates a reply. The GUI has to retry the command or not, depending on the functionality. In case the here described device_server is used, the device_server does the retry after a settable timeout.

UDP is the connectionless ethernet mode. Messages are just sent. If there is a receiver, fine, if there is no receiver, also fine. It is much faster and creates less overhead than TCP which includes retries and checks.

The device_server listens on one port for commands from the GUIs. The messages are built such that they contain the origin of the command, in this case the IP and the port where each GUI is listening for a reply. While the device_server listens on one port, the GUIs have to listen on different ports each.

The behaviour of the UDP sockets is such that a communication is only possible to equal port numbers. EG a client port can talk to a server port of the same number. Only server sockets are waiting and generate an event. When a client port is receiving, it is blocked until done. Thus for unblocked communication, the clients send, the servers receive.

The device_server application that handles the serial port for the RS422 bus thus consists of a UDP serversocket that listens on the device_server port eg. 3776, plus it need a UDP client socket for the communication to the GUIs. This clients UDP port is assigned on demand, since it is only sending, but to the different ports of the different GUIs.

the internal communication - in detail

receiving from the GUI

When the device_server receives a Command from a GUI, it is queued in to the message queue made for the serial port. This is necessary because the serial port is orders of magnitudes slower than the UDP, and the GUIs do not know how many others are talking over the serial bus. It is assumed that the traffic created by a single GUI is orders of magnitudes lower than the bandwidth of the serial bus. The datatype used over the sockets is shortstring, for which Delphi provides instant buffers. The format of the messages sent between the device_server and the GUI is

Origin + Command
IP_string, chr(0), lowbyte(port), highbyte(port), chr(0), command_string

Tearing this message appart is hidden in the functionity of a "RemoteDevice". A thread in the device_server takes one command from this queue sends it over the serial port, awaits timeout or reply and does the next.

receiving from the serial port

The nature of serial port messageing doesn't allow a thread to wait for bytes from the serial port. Instead the serial port generates events and an eventhandler has to process them. Here the serial handler knows the protocol and works as state machine. When a reply from a device is complete, the message to the corresponding GUI is assembled and sent. The thread responsible for the sending of serial port messages gets a flag that it may continue. A timeout is therefore just a timer rising this flag before the received message disables the timer.

Two flavours of device_server applications

The first version is plain and offers some debugging capabilities.
Multi Device Server 1

download (700k)

The second version displays the internal queue and thus gives better insight into which device communicates correctly. Here, the device handlers are running locally as can be seen by their IP. 127.0.0.1 is the local host.
Multi Device Server 2

plus the already known debug log showing the individual messages.
Multi Device Server 3

download (760k)

Selected pieces of code from the device server application

I hate those zipfiles just to pass the idea that may be contained in a single line. Therefore the code is published in an immediately readable form. Since HTML defines a special meaning to certain brackets, some browsers may omit certain parts of the code. Please have a look at the source of this page. Your browser (Internet Explorer, Firefox, Netscape, Opera, and such) does that with View, Source

The program - run only once

The use of the mutex, here systemwide named "MultiDeviceServer", prevents multiple instances.

program RS485Srv;

uses
  Windows,Forms,
  RS485Srv1 in 'RS485Srv1.pas' {Form1};

var Mutex:THandle;

{$R *.res}

begin
 Mutex := CreateMutex(nil, True, 'MultiDeviceServer');
 if (Mutex <> 0) and (GetLastError = 0) then begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
  if (Mutex <> 0) then CloseHandle(Mutex);
 end;
end.

The main unit - visual functionality

unit RS485Srv1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin, IdUDPServer, IdBaseComponent, IdComponent,
  IdUDPBase, IdUDPClient, ComCtrls, OoMisc, AdPort,CommThread,MyMsgQueue,
  IdSocketHandle,RemoteDevice;

type
  OrgEntryPtr=^OrgEntry;
  OrgEntry=record
   ip:shortstring;
   port:word;
   end;

  TForm1 = class(TForm)
    UDPC: TIdUDPClient;
    UDPS: TIdUDPServer;
    GroupBox1: TGroupBox;
    SpinEdit1: TSpinEdit;
    ComPortSetBtn: TButton;
    GroupBox2: TGroupBox;
    ServerPortSpin: TSpinEdit;
    Label1: TLabel;
    GroupBox3: TGroupBox;
    Timeoutspin: TSpinEdit;
    StatusBar1: TStatusBar;
    sp: TApdComPort;
    SetServer: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    stoploop: TLabel;
    TxTraceEnableCheck: TCheckBox;
    RxTraceEnableCheck: TCheckBox;
    TracePortEnablecheck: TCheckBox;
    FontSizeSpin: TSpinEdit;
    DebugLog: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ComPortSetBtnClick(Sender: TObject);
    procedure TxTraceEnableCheckClick(Sender: TObject);
    procedure RxTraceEnableCheckClick(Sender: TObject);
    procedure DebugLogDblClick(Sender: TObject);
    procedure UDPSUDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    procedure TracePortEnablecheckClick(Sender: TObject);
    procedure SetServerClick(Sender: TObject);
    procedure spTriggerAvail(CP: TObject; Count: Word);
    procedure stoploopClick(Sender: TObject);
    procedure TimeoutspinChange(Sender: TObject);
    procedure FontSizeSpinChange(Sender: TObject);
    procedure StatusBar1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
   MsgQueue:TSimpleMsgQueue;
   txstring:shortstring;
   txsent,rxrec,txq,rxq:integer;
   RxLen, RxPtr:byte;
   ComNr:byte;
   DeviceID:byte;
   tracerx,tracetx,traceport:boolean;
   RD:TRemoteDevice;
   OrgList:TList;
   function NewOrgEntry(ip:shortstring;port:word):integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses mystrings;

const
 PC_ID=0;
 defaultCom = 1;
 defaultMDSPortBase=3776;
 defaultMDServerHost='127.0.0.1';
 SYN=$16;
 STX=$02;
 sleeptime=10;  // in CommThread
 defaulttimeout=1000;

var
 CT:TCommThread;



procedure TForm1.FormCreate(Sender: TObject);
var u:shortstring;
begin
 ComNr:=defaultCom;
 if (paramcount>0) then begin
  u:=paramstr(1);
  if (u[1]='-')and(u[2]='c') then ComNr:=ord(u[3])-$30;
  end;
 DeviceId:=1;
 sp.ComNumber:=ComNr;
 sp.Open:=true;
 txsent:=0;rxrec:=0; txq:=0;rxq:=0;
 tracerx:=RxTraceEnableCheck.Checked;
 tracetx:=TxTraceEnableCheck.checked;
 traceport:=TracePortEnablecheck.checked;
 MsgQueue:=TSimpleMsgQueue.create;
 CommThread.Queue:=MsgQueue;
 OrgList:=TList.create;
 RD:=TRemoteDevice.create;
 RD.UDPClient:=UDPC;
 RD.UDPServer:=UDPS;
 RD.senderip:=defaultMDServerHost;
 RD.serverip:=defaultMDServerHost;
 RD.serverport:=defaultMDSPortBase;
 Rd.senderport:=defaultMDSPortBase+1;
 RD.InitClient;
 RD.InitServer;
 CT:=TCommThread.create(true);
 CommThread.sp:=self.sp;
 CommThread.queue:=MsgQueue;
 timeoutspin.value:=defaulttimeout;
 CommThread.mtimeout:=timeoutspin.value;
 CommThread.ErrorLog:=DebugLog;
 CT.resume;
 CommThread.rxcame:=true;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 CT. terminate;
 CT.WaitFor;
 if sp.open then sp.open:=false;
 if UDPC.Active then UDPC.Active:=false;
 if UDPS.Active then UDPS.Active:=false;
end;

procedure TForm1.ComPortSetBtnClick(Sender: TObject);
begin
if sp.open then sp.open:=false;
 sp.ComNumber:=ComNr;
 sp.open:=true;
end;

procedure TForm1.TxTraceEnableCheckClick(Sender: TObject);
begin
 tracetx:=TxTraceEnableCheck.Checked;
end;

procedure TForm1.RxTraceEnableCheckClick(Sender: TObject);
begin
 tracerx:=RxTraceEnableCheck.Checked;
end;

procedure TForm1.DebugLogDblClick(Sender: TObject);
begin
 DebugLog.Clear;
end;

// from clients incoming messages
procedure TForm1.UDPSUDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
  var u,v,orgip,h:shortstring;
  i,j,k:integer;
  orgport:word;
  p:TMyMsg;
begin
 v:=RD.readMsg(AData,orgip,orgport);
 i:=NewOrgEntry(orgip,orgport);
 p:=TMyMsg.create(length(v));
 p.asstring:=v;
 p.origin:=i;
 MsgQueue.queuein(p);
 inc(rxq);
 Statusbar1.panels[2].text:='PortRec '+inttostr(rxq);
 inc(TxSent);
 Statusbar1.panels[0].text:='TxSent '+inttostr(txsent);
 if traceport then begin
  u:='';
  u:='<< '+Rd.senderip+' '+inttostr(rd.senderport)+' '+BStr2HexStrNH(v);
  DebugLog.Lines.add(u);
 end;
 if (tracetx) then begin
  h:='>> '+BStr2HexStrNH(v);
  DebugLog.Lines.add(h);
  end;
end;

procedure TForm1.TracePortEnablecheckClick(Sender: TObject);
begin
 traceport:=TracePortEnablecheck.checked;
end;

procedure TForm1.SetServerClick(Sender: TObject);
begin
 if UDPS.Active then UDPS.Active:=false;
 UDPS.Active:=true;
end;

function TForm1.NewOrgEntry(ip:shortstring;port:word):integer;
var i,j:integer;
    found:boolean;
    p:OrgEntryPtr;
begin
 i:=0; found:=false;
 while (not found)and(i> '+RD.ServerIP+' '+
                  inttostr(RD.serverport)+' '+
                  BStr2HexStrNH(CommThread.RxString));
       CommThread.RxCame:=true;
       end;// len reached
     end;
   end; //case
  end; //for count
end;

procedure TForm1.StoploopClick(Sender: TObject);
begin
 MsgQueue.clear;
 Commthread.rxcame:=true;
end;

procedure TForm1.TimeoutspinChange(Sender: TObject);
begin
 CommThread.mtimeout:=timeoutspin.value;
end;

procedure TForm1.FontSizeSpinChange(Sender: TObject);
begin
 DebugLog.Font.Size:= FontSizeSpin.Value;
end;

procedure TForm1.StatusBar1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if (x>360)and (x<400) then begin
  DebugLog.lines.add('This Application waits for UDP messages to appear on ');
  DebugLog.lines.add('port '+inttostr(serverportspin.value)+'. The assumed format');
  DebugLog.lines.add('is : IP(string)+ chr(0)+ port as low/highbyte+chr(0)+serialmsg');
  DebugLog.lines.add('The reply is sent to there, also prefixed with IP and port');
  DebugLog.lines.add('The serialport can be choosen from the commandline -cN ');
  DebugLog.lines.add('http://www.ibrtses.com');

 end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
 if width < 411 then width:=411;
 if height< 267 then height:=267;
 PageControl1.Height:=clientheight-70;
 DebugLog.Height:=clientheight-135;

end;

end.

unit remotedevice - the UDP stuff

unit RemoteDevice;
{ encapsulates sending and receiving over UDP }
interface

uses
  SysUtils, Classes,idUDPClient,idUDPServer;

type
  TRemoteDevice = class(TObject)
  private
    { Private declarations }
   fsenderip,fserverip:shortstring;
   fsenderport,fserverport:word;
   fUDPC:TIdUDPClient;
   fUDPS:TIdUDPServer;
  protected
    { Protected declarations }
  public
    { Public declarations }
   constructor create;
   procedure InitClient;
   procedure InitServer;
   procedure writeMsg(u:shortstring); // sending to Device
   function readMsg(AData: TStream;var orgip:shortstring; var orgport:word):shortstring;      // retrieving a Msg
   function readCmdMsg(AData: TStream;var cmd:byte; var orgip:shortstring; var orgport:word):shortstring;      // retrieving a Msg
  published
    { Published declarations }
   property UDPClient:TIdUDPClient read fUDPC write fUDPC;
   property UDPServer:TIdUDPServer read fUDPS write fUDPS;
   property senderip:shortstring read fsenderip write fsenderip;
   property serverip:shortstring read fserverip write fserverip;
   property senderport:word read fsenderport write fsenderport;
   property serverport:word read fserverport write fserverport;
  end;

procedure Register;

implementation

constructor TRemoteDevice.create;
begin
 fsenderip:='';fserverip:='';
 fsenderport:=0;fserverport:=0;
 fUDPC:=nil;fUDPS:=nil;
end;

procedure TRemoteDevice.InitClient;
begin
 fUDPC.Active:=false;
 fUDPC.Host:=fserverip;
 fUDPC.Port:=fserverport;
 fUDPC.Active:=true;
end;

procedure TRemoteDevice.InitServer;
begin
 fUDPS.Active:=false;
 fUDPS.DefaultPort:=fsenderport;
 fUDPS.Active:=true;
end;

procedure TRemoteDevice.writeMsg(u:shortstring); // sending to Device
var h:shortstring;
    d:word;
    b:array[1..2]of byte absolute d;
begin
 d:=fsenderport;
 h:=fsenderip+chr(0)+chr(b[1])+chr(b[2])+chr(0)+u;
 fUDPC.send(h);
end;

//
// format of the message : '?? IP_string ??',chr(0),lowbyte(port), highbyte(port),chr(0),' com_string '
//
function TRemoteDevice.readMsg(AData: TStream;var orgip:shortstring; var orgport:word):shortstring;      // retrieving a Msg
var buf:array[0..127]of byte;
    h:shortstring;
    d:word;
    b:array[1..2]of byte absolute d;
    i,j:byte;
begin
 i:=AData.Read(buf,128);
 j:=0;h:='';
 result:=h;
 while((j < =i) and (buf[j] < > 0)) do begin
  h:=h+chr(buf[j]);
  inc(j);
  end;
 orgip:=h;
 inc(j); // pointing to port now
 if (j < (i-3)) then begin
  b[1]:=buf[j];
  inc(j);
  b[2]:=buf[j];
  inc(j);  // points to 0
  orgport:=d;
  h:='';
  inc(j);
  while j < i do begin
   h:=h+chr(buf[j]);
   inc(j);
   end;
  result:=h;
  end;
end;

//
// format of the message : cmd,'?? IP_string ??',chr(0),lowbyte(port), highbyte(port),chr(0),' com_string '
//
function TRemoteDevice.readCmdMsg(AData: TStream;var cmd:byte; var orgip:shortstring; var orgport:word):shortstring;      // retrieving a Msg
var buf:array[0..127]of byte;
    h:shortstring;
    d:word;
    b:array[1..2]of byte absolute d;
    i,j:byte;
begin
 i:=AData.Read(buf,128);
 j:=0;h:='';
 result:=h;
 cmd:=buf[0];
 j:=1;
 while((j < = i) and (buf[j] < > 0)) do begin
  h:=h+chr(buf[j]);
  inc(j);
  end;
 orgip:=h;
 inc(j); // pointing to port now
 if (j < (i-3)) then begin
  b[1]:=buf[j];
  inc(j);
  b[2]:=buf[j];
  inc(j);  // points to 0
  orgport:=d;
  h:='';
  inc(j);
  while j< i do begin
   h:=h+chr(buf[j]);
   inc(j);
   end;
  result:=h;
  end;
end;

procedure Register;
begin
  //RegisterComponents('Samples', [TRemoteDevice]);
end;

end.

The CommThread - messagebased sending

{
formcreate:
 CQ:=TSimpleMsgQueue.create;
 CommThread.queue:=CQ;
 CommThread.sp:=sp;
 Commthread.lostpackets:=0;
 CS:=TCommThread.create(false);
 rxcame:=true;

procedure TForm1.SendClick(Sender: TObject);
var u:TMyMsg;
    s,v:shortstring;
    i,j:integer;
begin
 s:=chr($01);
 v:=chr(STX)+chr(length(s)+6)+chr(PCID)+chr($04)+s;
 calcWCRC(v);
 v:=chr(SYN)+v;
 i:=length(v);
 u:=TMyMsg.create(i);
 u.asstring:=v;
 u.delay:=0;
 CQ.queuein(u);
end;

procedure TForm1.MakeDelayClick(Sender: TObject);
var u:TMyMsg;
    i,j:integer;
begin
 u:=TMyMsg.create(0);
 u.delay:=1000;
 CQ.queuein(u);
end;

}

unit CommThread;

interface

uses
  Windows,Classes,StdCtrls,MyMsgQueue,OoMisc,Adport;

const
 //mtimeout=500;
 sleeptime=50;

type
  TCommThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
    procedure send;
  end;

VAR queue:TSimpleMsgQueue;
 sp: TApdComPort;
 h:shortstring;
 rxcame:boolean;
 rxstring:shortstring;
 rxstate:integer;
 lostpackets:integer;
 mtimeout:integer;
 ErrorLog:TMemo;
 PacketOrigin:integer;

implementation

uses mystrings;

{ Important: Methods and properties of objects in VCL can only be used in a
  method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure TCommThread.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }

{ TCommThread }

procedure TCommThread.send;
begin
 sp.putstring(h);
end;


procedure TCommThread.Execute;
var p:TMyMsg;
 tcount:integer;
 z:shortstring;
begin
  { Place thread code here }
  tcount:=0;
 while not terminated do begin
  if (queue.count<>0)and(rxcame) then begin
   //rxcame:=false;
      p:=queue.queueout;
      h:=p.asstring;
      PacketOrigin:=p.origin;
      if (h<>'') then rxcame:=false; // empty packets are a delay only
      rxstring:='';
      rxstate:=0;
      tcount:=0;
      sleep(p.delay);   // wait before send
      sleep(50);
      synchronize(send);
      p.destroy;
     end;
  sleep(sleeptime);
  if (not rxcame) then begin
   inc(tcount);
   if ((tcount*sleeptime)>mtimeout) then begin
   // rxcame:=true;
    inc(lostpackets);
    tcount:=0;
    if assigned(errorlog) then begin
      z:='*'+BStr2HexStr(h);
      errorlog.lines.add(z);
     end;
    synchronize(send);
    end;
   end;
 end; // while
end;

end.

A look at the device handler application

A sample application, the TEC, lets the user select either serial port or the MultiDeviceServer.

a TEC user interface

additional code in the device handler

Here, the "UseMultiSrv.Checked" is true for the MultiDeviceServer. And the "Rd." of "Rd.writeMsg(txstring);" is the above described TRemoteDevice.

procedure TForm1.MakeMsg(u:shortstring);
var h:shortstring;
    p:TMyMsg;
begin
 h:=chr(STX)+chr(length(u)+6)+chr(PC_ID)+chr(DeviceID)+u;
 CalcWCRC(h);
 txstring:=chr(SYN)+chr(SYN)+h;
 p:=TMyMsg.create(length(txstring));
 p.asstring:=txstring;
 p.delay:=100;
 if UseMultiSrv.Checked then begin
   Rd.writeMsg(txstring);
   if PortTrace then
    DebugLog.Lines.Add(BStr2HexStrNH(txstring));
   p.destroy;
  end
 else begin
  MsgQueue.queuein(p);
  end;
 if (tracetx) then begin
  h:='>> '+BStr2HexStrNH(txstring);
  DebugLog.Lines.add(h);
 end;
 inc(TxSent);
 Statusbar1.panels[0].text:='TxSent '+inttostr(txsent);
end;


procedure TForm1.UDPSUDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
  var s:shortstring;
      orgip:shortstring;
      orgport:word;
begin
 s:=RD.readMsg(AData,orgip,orgport);
 if PortTrace then
   DebugLog.Lines.Add(BStr2HexStrNH(s));
 CommThread.RxString:=s;
 ProcessRx;
end;

For questions,comments, feedback
just a tag

sponsored links

Delphi
home

last updated 23.july.05, or perhaps later

Copyright (99,2005) Ing.Büro R.Tschaggelar