Processing Server data - delphi

Question

I have an Indy TCPServer that connects a device with several clients.
When device-data arrives, the server sends it to every client.
When client-data arrives, it is sent to the device. (And the device will send it to the server again (echo)).
I only process 2 bytes per cycle.
The above works perfect.
Now i want to process/save that data.
Only when data arrives via the device port, i want to 'Translate' the data.
I need to save the data to a clientdatset.
Then i want to take the bytes apart and compare them with som other info
...
The translated data is also saved in another clientdataset.
unit BusServer;
interface
uses
Winapi.Windows, Winapi.Messages,
System.SysUtils, System.Classes, System.Variants,
Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs,
IdContext, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
IdCustomTCPServer, IdTCPServer,
Data.DB, Datasnap.DBClient;
type
TBus_Server = class(TService)
tcpBusDataServer: TIdTCPServer;
IdAntiFreeze1: TIdAntiFreeze;
cdsBusMonitor: TClientDataSet;
cdsBusMonitorNr: TIntegerField;
cdsBusMonitorDate: TStringField;
cdsBusMonitorTime: TStringField;
cdsBusMonitorAad: TIntegerField;
cdsBusMonitorAgr: TIntegerField;
cdsBusMonitorAName: TStringField;
cdsBusMonitorAFct: TStringField;
cdsBusMonitorOrigin: TStringField;
cdsIncoming: TClientDataSet;
cdsMemberState: TClientDataSet;
cdsMemberStateMemberID: TStringField;
cdsMemberStateState: TStringField;
cdsMemberStateDateTime: TDateTimeField;
cdsMemberStateTotaal: TFloatField;
procedure tcpBusDataServerExecute(AContext: TIdContext);
procedure ServiceCreate(Sender: TObject);
private
{ Private declarations }
functionmon: String;
DevicePort: Integer;
ClientPort: Integer;
ClientLSB, ClientMSB: Byte;
DeviceLSB, DeviceMSB: Byte;
FunctionList: TStringList;
procedure TranslateData;
function CodeValue: String;
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
var
Bus_Server: TBus_Server;
implementation
uses
CodesiteLogging;
{$R *.dfm}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Bus_Server.Controller(CtrlCode);
end;
function TBus_Server.CodeValue: String;
begin
if (cdsIncoming.FieldbyName('MemberType').AsInteger = 11) or
(cdsIncoming.FieldbyName('MemberType').AsInteger = 22)or
(cdsIncoming.FieldbyName('MemberType').AsInteger = 33) then
begin
Result := FunctionMon
end
else
begin
// TODO:
end
end;
function TBus_Server.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TBus_Server.ServiceCreate(Sender: TObject);
var
DataSetName: String;
begin
DevicePort := 10001;
ClientPort := 10012;
tcpBusDataServer.Bindings.Clear;
tcpBusDataServer.Bindings.Add.Port := DevicePort;
tcpBusDataServer.Bindings.Add.Port := ClientPort;
tcpBusDataServer.Active := True;
FunctionList := TStringList.Create;
FunctionList.Add('Null');
FunctionList.Add('Reset');
FunctionList.Add('Toggle');
FunctionList.Add('Set');
FunctionList.Add('Misc');
FunctionList.Add('Status');
FunctionList.Add('Timer/Direct');
FunctionList.Add('Value');
FunctionList.Add('Dimmer');
FunctionList.Add('Readout');
FunctionList.Add('Teller');
FunctionList.Add('System');
FunctionList.Add('Settings');
FunctionList.Add('Select');
FunctionList.Add('Data');
FunctionList.Add('Program');
ForceDirectories('c:\Test\');
DataSetName := 'c:\Test\BusMonitor' + FormatDateTime('YYYY-MM-DD', Now) + '.xml';
if cdsBusMonitor.Active then
cdsBusMonitor.Close;
cdsBusMonitor.Filename := DataSetName;
if not System.SysUtils.FileExists(DataSetName) then
begin
cdsBusMonitor.CreateDataSet;
cdsBusMonitor.SaveToFile
end;
DataSetName := 'c:\Test\MemberState' + FormatDateTime('YYYY-MM-DD', Now) + '.xml';
if cdsMemberState.Active then
cdsMemberState.Close;
cdsMemberState.Filename := DataSetName;
if not System.SysUtils.FileExists(DataSetName) then
begin
cdsMemberState.CreateDataSet;
cdsMemberState.SaveToFile
end;
end;
procedure TBus_Server.tcpBusDataServerExecute(AContext: TIdContext);
var
Ctx: TIdContext;
List: TList;
begin
if AContext.Binding.Port = ClientPort then // Client
begin
DeviceLSB := AContext.Connection.IOHandler.ReadByte;
DeviceMSB := AContext.Connection.IOHandler.ReadByte;
List := tcpBusDataServer.Contexts.LockList;
try
for var i := 0 to List.count - 1 do
begin
Ctx := TIdContext(List[I]);
if (Ctx <> AContext) and (Ctx.Binding.Port = DevicePort) then
begin
Ctx.Connection.IOHandler.Write(DeviceLSB);
Ctx.Connection.IOHandler.Write(DeviceMSB);
// Since only 1 has to be written to
Break
end
end
finally
tcpBusDataServer.Contexts.UnlockList
end
end
else
begin
if AContext.Binding.Port = DevicePort then // Device
begin
ClientLSB := AContext.Connection.IOHandler.ReadByte;
ClientMSB := AContext.Connection.IOHandler.ReadByte;
List := tcpBusDataServer.Contexts.LockList;
try
for var i := 0 to List.count - 1 do
begin
Ctx := TIdContext(List[I]);
if (Ctx <> AContext) and (Ctx.Binding.Port = ClientPort) then
begin
Ctx.Connection.IOHandler.Write(ClientLSB);
Ctx.Connection.IOHandler.Write(ClientMSB)
end
end
finally
TIdNotify.NotifyMethod(TranslateData);
tcpBusDataServer.Contexts.UnlockList
end
end
end
end;
procedure TBus_Server.TranslateData;
const {$J+}
LastSave: TDateTime = 0;
type
TProgramState = (psNone,psProgram,psIgnore1,psIgnore2);
const
ProgramState: TProgramState = psNone;
const
ValueMode: Boolean = False;
var
i: Integer;
fct: Integer;
GroupMon: Integer;
AddressMon: Integer;
CorrecteSettings: Boolean;
TmpStr: String;
begin
fct := 0;
// Functie uit MSB halen
if ClientMSB >= 128 then
begin
ClientMSB := ClientMSB - 128;
fct := 8
end;
if ClientMSB >= 64 then
begin
ClientMSB := ClientMSB - 64;
fct := fct + 4
end;
if ClientMSB >= 32 then
begin
ClientMSB := ClientMSB - 32;
fct := fct + 2
end;
if ClientMSB >= 16 then
begin
ClientMSB := ClientMSB - 16;
fct := fct + 1
end;
// Variabelen voor monitor bepalen
functionMon := FunctionList[fct];
if cdsBusMonitor.Active then
begin
cdsBusMonitor.Filtered := False;
cdsBusMonitor.Append;
cdsBusMonitor.FieldByName('Nr').AsInteger := cdsBusMonitor.RecordCount + 1;
cdsBusMonitor.FieldByName('AFct').Asstring := functionMon;
cdsBusMonitor.FieldByName('Aad').AsInteger := ClientLSB;
cdsBusMonitor.FieldByName('Agr').AsInteger := ClientMSB;
cdsBusMonitor.FieldByName('Time').Asstring := TimeToStr(Now);
cdsBusMonitor.FieldByName('Origin').AsString := 'Van de Bus: '{ + UserPeerIP};
cdsBusMonitor.Post;
end;
if ProgramState = psNone then
begin
CodeSite.Send('New situation...');
try
if cdsIncoming.Locate('Group;Address', VarArrayOf([IntToStr(DeviceMsb),IntToStr(DeviceLsb)]), []) then
begin
CodeSite.Send('After locate...');
if cdsMemberState.Locate('MemberID', cdsIncoming.FieldByName('MemberID').AsString, []) then
cdsMemberState.Edit
else
cdsMemberState.Append;
if cdsMemberStateState.AsString = Codevalue then
begin
CodeSite.Send('New state ' + Codevalue + ' already known');
cdsMemberState.Cancel
end
else
begin
CodeSite.Send('New state ' + Codevalue);
cdsMemberStateState.AsString := Codevalue;
if Codevalue.ToLower = 'reset' then
cdsMemberStateTotaal.AsFloat := cdsMemberStateTotaal.AsFloat + (Now - cdsMemberStateDateTime.AsDateTime);
cdsMemberStateDateTime.AsDateTime := Now;
cdsMemberState.Post
end
end
else
CodeSite.SendError('ServerMethodsBServer.cdsIncoming Locate Fail');
except
on E: Exception do
CodeSite.SendException(E);
end
end;
if ((cdsBusMonitor.RecordCount mod 100) = 0) or ((Now - LastSave) > (1/24/60)) then
begin
LastSave := Now;
cdsBusMonitor.MergeChangeLog;
cdsBusMonitor.SaveToFile;
cdsMemberState.MergeChangeLog;
cdsMemberState.SaveToFile
end
end;
In the clientdataset, i occasionally see "wrong data", meaning:
First i have a correct record, followed by a record with the same lsb and a wrong msb.
I split up the msb in the procedure(Translatedata) in a 'high nibble' and a 'low nibble'.
So now i'm trying to find out where this comes from.
As you can see in my code i call the procedure via TIdNotify.NotifyMethod(TranslateData);
Is this te correct way?
Could appending/posting data in a clientdataset (whilst in the serverthread) be a problem?
Is this a timing issue?
Has anyone an idea of what could be wrong?

Answer 1

Your code is not very thread-safe. You are not protecting your data values from concurrent access across thread boundaries, if multiple clients send data to the server at the same time.
Also, you should not be doing all of your service initializations in the OnCreate event, use the OnStart event instead. The OnCreate event is triggered whenever your TService object is created for any reason, which includes not only running the service, but also (un)installing the service.
Try something more like this:
unit BusServer;
interface
uses
Winapi.Windows, Winapi.Messages,
System.SysUtils, System.Classes, System.Variants,
Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs,
IdContext, IdBaseComponent, IdComponent,
IdCustomTCPServer, IdTCPServer, IdThreadSafe,
Data.DB, Datasnap.DBClient, System.SyncObjs;
type
TBus_Server = class(TService)
tcpBusDataServer: TIdTCPServer;
cdsBusMonitor: TClientDataSet;
cdsBusMonitorNr: TIntegerField;
cdsBusMonitorDate: TStringField;
cdsBusMonitorTime: TStringField;
cdsBusMonitorAad: TIntegerField;
cdsBusMonitorAgr: TIntegerField;
cdsBusMonitorAName: TStringField;
cdsBusMonitorAFct: TStringField;
cdsBusMonitorOrigin: TStringField;
cdsIncoming: TClientDataSet;
cdsMemberState: TClientDataSet;
cdsMemberStateMemberID: TStringField;
cdsMemberStateState: TStringField;
cdsMemberStateDateTime: TDateTimeField;
cdsMemberStateTotaal: TFloatField;
procedure tcpBusDataServerExecute(AContext: TIdContext);
procedure ServiceStart(Sender: TObject; var Started: Boolean);
procedure ServiceStop(Sender: TObject; var Stopped: Boolean);
procedure ServiceShutdown(Sender: TObject);
private
{ Private declarations }
FunctionMon: TIdThreadSafeString;
DevicePort: Integer;
ClientPort: Integer;
DeviceLSB, DeviceMSB: Byte;
DeviceDataLock: TCriticalSection;
FunctionList: TStringList;
procedure TranslateData(ClientLSB, ClientMSB: Byte);
function CodeValue: String;
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
var
Bus_Server: TBus_Server;
implementation
uses
CodesiteLogging;
{$R *.dfm}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Bus_Server.Controller(CtrlCode);
end;
function TBus_Server.CodeValue: String;
begin
case cdsIncoming.FieldByName('MemberType').AsInteger of
11, 22, 33: begin
Result := FunctionMon.Value;
end;
else
// TODO
Result := '';
end;
end;
function TBus_Server.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TBus_Server.ServiceStart(Sender: TObject; var Started: Boolean);
var
DataSetName: String;
begin
DevicePort := 10001;
ClientPort := 10012;
DeviceDataLock := TCriticalSection.Create;
FunctionMon := TIdThreadSafeString.Create;
FunctionList := TStringList.Create;
FunctionList.Add('Null');
FunctionList.Add('Reset');
FunctionList.Add('Toggle');
FunctionList.Add('Set');
FunctionList.Add('Misc');
FunctionList.Add('Status');
FunctionList.Add('Timer/Direct');
FunctionList.Add('Value');
FunctionList.Add('Dimmer');
FunctionList.Add('Readout');
FunctionList.Add('Teller');
FunctionList.Add('System');
FunctionList.Add('Settings');
FunctionList.Add('Select');
FunctionList.Add('Data');
FunctionList.Add('Program');
ForceDirectories('c:\Test\');
DataSetName := 'c:\Test\BusMonitor' + FormatDateTime('YYYY-MM-DD', Now) + '.xml';
if cdsBusMonitor.Active then
cdsBusMonitor.Close;
cdsBusMonitor.Filename := DataSetName;
if not System.SysUtils.FileExists(DataSetName) then
begin
cdsBusMonitor.CreateDataSet;
cdsBusMonitor.SaveToFile;
end;
DataSetName := 'c:\Test\MemberState' + FormatDateTime('YYYY-MM-DD', Now) + '.xml';
if cdsMemberState.Active then
cdsMemberState.Close;
cdsMemberState.Filename := DataSetName;
if not System.SysUtils.FileExists(DataSetName) then
begin
cdsMemberState.CreateDataSet;
cdsMemberState.SaveToFile;
end;
tcpBusDataServer.Bindings.Clear;
tcpBusDataServer.Bindings.Add.Port := DevicePort;
tcpBusDataServer.Bindings.Add.Port := ClientPort;
tcpBusDataServer.Active := True;
Started := True;
end;
procedure TBus_Server.ServiceStop(Sender: TObject; var Stopped: Boolean);
begin
ServiceShutdown(Sender);
Stopped := True;
end;
procedure TBus_Server.ServiceShutdown(Sender: TObject);
begin
tcpBusDataServer.Active := False;
cdsBusMonitor.Close;
cdsMemberState.Close;
DeviceDataLock.Free;
FunctionMon.Free;
FunctionList.Free;
end;
procedure TBus_Server.tcpBusDataServerExecute(AContext: TIdContext);
var
LSB, MSB: Byte;
List: TList;
Ctx: TIdContext;
begin
LSB := AContext.Connection.IOHandler.ReadByte;
MSB := AContext.Connection.IOHandler.ReadByte;
if AContext.Binding.Port = ClientPort then // Client
begin
DeviceDataLock.Enter;
try
DeviceLSB := LSB;
DeviceMSB := MSB;
finally
DeviceDataLock.Leave;
end;
List := tcpBusDataServer.Contexts.LockList;
try
for var i := 0 to List.count - 1 do
begin
Ctx := TIdContext(List[I]);
if (Ctx <> AContext) and (Ctx.Binding.Port = DevicePort) then
begin
Ctx.Connection.IOHandler.Write(LSB);
Ctx.Connection.IOHandler.Write(MSB);
// Since only 1 has to be written to
Break;
end;
end;
finally
tcpBusDataServer.Contexts.UnlockList;
end;
end
else if AContext.Binding.Port = DevicePort then // Device
begin
List := tcpBusDataServer.Contexts.LockList;
try
for var i := 0 to List.count - 1 do
begin
Ctx := TIdContext(List[I]);
if (Ctx <> AContext) and (Ctx.Binding.Port = ClientPort) then
begin
Ctx.Connection.IOHandler.Write(LSB);
Ctx.Connection.IOHandler.Write(MSB)
end;
end
finally
tcpBusDataServer.Contexts.UnlockList;
TThread.Queue(nil,
procedure
begin
TranslateData(LSB, MSB);
end
);
end;
end;
end;
procedure TBus_Server.TranslateData(ClientLSB, ClientMSB: Byte);
const {$J+}
LastSave: TDateTime = 0;
type
TProgramState = (psNone,psProgram,psIgnore1,psIgnore2);
const
ProgramState: TProgramState = psNone;
const
ValueMode: Boolean = False;
var
i: Integer;
fct: Integer;
GroupMon: Integer;
AddressMon: Integer;
CorrecteSettings: Boolean;
TmpFunc, TmpCodeValue: string;
TmpDeviceLSB, TmpDeviceMSB: Byte;
begin
fct := 0;
// Functie uit MSB halen
if ClientMSB >= 128 then
begin
Dec(ClientMSB, 128);
fct := 8;
end;
if ClientMSB >= 64 then
begin
Dec(ClientMSB, 64);
Inc(fct, 4);
end;
if ClientMSB >= 32 then
begin
Dec(ClientMSB, 32);
Inc(fct, 2);
end;
if ClientMSB >= 16 then
begin
Dec(ClientMSB, 16);
Inc(fct, 1);
end;
// Variabelen voor monitor bepalen
TmpFunc := FunctionList[fct];
FunctionMon.Value := TmpFunc;
if cdsBusMonitor.Active then
begin
cdsBusMonitor.Filtered := False;
cdsBusMonitor.Append;
try
cdsBusMonitor.FieldByName('Nr').AsInteger := cdsBusMonitor.RecordCount + 1;
cdsBusMonitor.FieldByName('AFct').Asstring := TmpFunc;
cdsBusMonitor.FieldByName('Aad').AsInteger := ClientLSB;
cdsBusMonitor.FieldByName('Agr').AsInteger := ClientMSB;
cdsBusMonitor.FieldByName('Time').AsString := TimeToStr(Now);
cdsBusMonitor.FieldByName('Origin').AsString := 'Van de Bus: '{ + UserPeerIP};
cdsBusMonitor.Post;
except
cdsBusMonitor.Cancel;
raise;
end;
end;
if ProgramState = psNone then
begin
CodeSite.Send('New situation...');
try
DeviceDataLock.Enter;
try
TmpDeviceLSB := DeviceLSB;
TmpDeviceMSB := DeviceMSB;
finally
DeviceDataLock.Leave;
end;
if cdsIncoming.Locate('Group;Address', VarArrayOf([IntToStr(TmpDeviceMSB),IntToStr(TmpDeviceLSB)]), []) then
begin
CodeSite.Send('After locate...');
if cdsMemberState.Locate('MemberID', cdsIncoming.FieldByName('MemberID').AsString, []) then
cdsMemberState.Edit
else
cdsMemberState.Append;
try
TmpCodeValue := CodeValue;
if cdsMemberStateState.AsString = TmpCodeValue then
begin
CodeSite.Send('New state ' + TmpCodeValue + ' already known');
cdsMemberState.Cancel;
end
else
begin
CodeSite.Send('New state ' + TmpCodeValue);
cdsMemberStateState.AsString := TmpCodeValue;
if TmpCodeValue = 'Reset' then
cdsMemberStateTotaal.AsFloat := cdsMemberStateTotaal.AsFloat + (Now - cdsMemberStateDateTime.AsDateTime);
cdsMemberStateDateTime.AsDateTime := Now;
cdsMemberState.Post;
end;
except
cdsMemberState.Cancel;
raise;
end;
end
else
CodeSite.SendError('ServerMethodsBServer.cdsIncoming Locate Fail');
except
on E: Exception do
CodeSite.SendException(E);
end
end;
if ((cdsBusMonitor.RecordCount mod 100) = 0) or ((Now - LastSave) > (1/24/60)) then
begin
LastSave := Now;
cdsBusMonitor.MergeChangeLog;
cdsBusMonitor.SaveToFile;
cdsMemberState.MergeChangeLog;
cdsMemberState.SaveToFile;
end;
end;