where : ibrtses delphi
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.

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.

plus the already known debug log showing the individual messages.

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.

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

sponsored links
Delphi
home
last updated 23.july.05, or perhaps later
Copyright (99,2005) Ing.Büro R.Tschaggelar