> {quote:title=Remy Lebeau (TeamB) wrote:}{quote}
Okay, I messed around a bit more, and I now get to the stage where I get the connection, but immediately a disconnect occurs and a OnException with an Access violation somewhere in the Windows kernel.
I attach the complete source of the unit (all 4000+ lines...); I do not see where I go wrong.
I would be very grateful if you could have a look and see what is happening...
Thanks, Bart
{code}
unit DTBU;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Graphics,
Forms, IdContext, IdBaseComponent, IdComponent,
IdCustomTCPServer, IdTCPServer, IdYarn, ContNrs, IdTCPConnection, DataU, PeopleU, EquipmentU,
DTBUsersU, StationDataU, ObjectU, MessagesU, LogFormU,
TeamsU;
type
TDataStreams = class(TObjectList)
private
function GetRecord(AIndex: integer): TMemoryStream;
procedure SetRecord(AIndex: integer; const AValue: TMemoryStream);
public
property Items[AIndex: integer]: TMemoryStream read GetRecord write SetRecord; default;
function AddStream(Item: TMemoryStream): integer;
function CopyStream(AStream:TMemoryStream):TMemoryStream;
end;
TDTBContextClient = class(TIdServerContext)
destructor Destroy; override;
public
DataStreams : TDataStreams;
Callsign: string;
GroupID: integer;
LoginName: string;
// IP: string;
OpsName: string;
IsActiveOps: boolean;
Command: string;
AccessLevel: integer;
ClientVersion: integer; // NO SAVE: DebugLog only.
ClientErrors: integer; // NO SAVE
DatabaseList: TStringList;
RXPacketCount,
TXPacketCount,
AverageCount: int64;
constructor Create(
AConnection: TIdTCPConnection;
AYarn: TIdYarn;
AList: TIdContextThreadList = nil
); override;
procedure AddDatabase(ADatabase:string);
function WantsDatabase(ADatabase:string; AFromCall:string):boolean;
procedure RemoveDatabase(ADatabase:string);
end;
PDTBTransferRecord = ^TDTBTransferRecord;
TDTBTransferRecord = record
ThreadID : Cardinal;
AStream : TMemoryStream;
DTBClient: TDTBContextClient;
end;
// Ths Global Settings for each Group.
TGlobalSetting = class(TObject)
private
const FVersion = 1;
public
GroupID: integer; // The GroupID associated with the settings in this record. One for each SAR Group.
ActiveOpsName: string; // The Active Operation for this SAR Group
DTBCallsign: string; // The Station which updated this record.
MaxTrackParts: integer;
TrackWidth: integer;
PeopleAvailableColor,
PeopleUnavailableColor,
PeopleArrivedColor,
PeopleAssignedColor: integer;
Footer: integer;
procedure Defaults;
procedure Assign(AGlobalSetting:TGlobalSetting);
procedure LoadStream(Reader: TReader );
procedure SaveStream(Writer: TWriter );
end;
TGlobalSettings = class(TObjectList)
private
function GetRecord(AIndex: integer): TGlobalSetting;
procedure SetRecord(AIndex: integer; const AValue: TGlobalSetting);
public
HasChanged: boolean;
property Items[AIndex: integer]: TGlobalSetting read GetRecord write SetRecord; default;
function AddGlobalSetting(AGlobalSetting: TGlobalSetting):boolean;
function GetGlobalSetting(AGroupID:integer):TGlobalSetting;
function LoadFromDisk:boolean;
function SaveToDisk:boolean;
end;
TDTBEventHandlers = class
// Event handlers:
class procedure IdTCPServer1Execute(AContext: TIdContext);
class procedure IdTCPServer1Exception(AContext: TIdContext;
AException: Exception);
class procedure IdTCPServer1ListenException(AThread: TIdListenerThread; AException: Exception);
class procedure IdTCPServer1Connect(AContext: TIdContext);
class procedure IdTCPServer1Disconnect(AContext: TIdContext);
class procedure IdTCPServer1Status(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
end;
procedure DTBThreadMessage(var AMessag
e : TMessage); // message TH_MESSAGE;
procedure LocalLog(AText:string; debuglevel:byte=D_DTB);
// procedure NotifyAllForms(DTBCommand:TDTBCommand); overload;
// procedure NotifyAllForms(ADestCall, AFromCall, ADatabase, AKey:string; AConfirmationID:integer; AReplyStr, ASpareStr:string); overload;
function DTBLoadCommand(AnsiReader: TAnsiReader):boolean; // RX
function DTBUpdateGlobalSettings(AnsiReader: TAnsiReader):boolean; // RX
procedure ProcessIncomingData(DTBTransferRecord : PDTBTransferRecord); // RX
function DTBLoadBinary(AnsiReader: TAnsiReader; AStream:TMemoryStream;AGroupID:integer;ADestCall:string):boolean; // RX
procedure SendAllDatabases(DTBCommand: TDTBCommand); // TX
procedure ProcessLogin(ADTBClient: TDTBContextClient; AStream: TMemoryStream); // RX
procedure ServerTransfer(AStream:TmemoryStream; ADTBClient: TDTBContextClient);
procedure RebuildTracks(AGlobalSetting:TGlobalSetting);
procedure SaveGlobalSettings;
procedure ServerToAllClients(AStream:TMemoryStream; AFromCall, ADestCall: string; AGroupID:integer; AOpsname:string); // TX
procedure ServerToClient(AStream: TMemoryStream; ADestCall: string; AGroupID:integer; AOpsname:string); // TX
procedure DTBTransmitAllStations(DTBCommand:TDTBCommand); // TX
procedure DTBTransmit(ADTBUser:TDTBUser;AGroupID:integer; DestCall:string); overload; // TX
procedure DTBTransmit(APeople:TPeople; ADestCall:string;AgroupId:integer; InitialLoad:boolean); overload; // TX
procedure DTBTransmitPeopleStatus(APeople: TPeople; ADestCall: string; AGroupID: integer);
procedure DTBTransmitALLPeopleStatus(APeopleList: TPeopleList; ADestCall: string; AGroupID: integer);
procedure DTBTransmitPeople(DTBCommand:TDTBCommand); // TX
procedure DTBTransmit(AEquipment:TEquipment;AGroupId:integer;DestCall:string); overload;
procedure DTBTransmitAllEquipment(DTBCommand:TDTBCommand);
procedure DTBTransmit(BinStream:TMemoryStream; AGroupId: integer; AFilename: string; ADestCall:string; AConfirmationID:integer); overload; // TX
procedure DTBTransmitPeoplePhoto(DTBCommand:TDTBCommand); // TX
procedure DTBTransmitCapabilityList(DTBCommand:TDTBCommand); // TX
procedure DTBTransmitEquipmentNameList(DTBCommand:TDTBCommand);
procedure DTBTransmit(AGlobalSetting:TGlobalSetting); overload;
procedure DTBTransmitAllObjects(DTBCommand:TDTBCommand; AlsoTracks:boolean); // TX
procedure DTBTransmitDTBUsers(DTBCommand:TDTBCommand); // TX
procedure ClientOpsChange(DTBCommand:TDTBCommand); // RX; Internal.
procedure OpsListRequest(DTBCommand:TDTBCommand); // RX
function DTBSendCommand(DTBCommand:TDTBCommand):boolean; overload;
function DTBSendCommand(AFromCall, ADestCall: string; AGroupID: integer;
AOpsName, ADatabase, ACommand, AKey: string; AConfirmationID: integer;
AFromTimestamp:int64; AReplyStr: string):boolean; overload;
procedure DatabaseMessage(DTBCommand:TDTBCommand);
procedure DTBProcessCommand(var DTBCommand:TDTBCommand); // RX
procedure StartStopDTBServer(Start:boolean);
function StreamTypeToText(AStreamType:integer):string;
function CopyDTBCommand(ADTBCommand:TDTBCommand):TDTBCommand;
procedure DTBInit;
procedure DTBShutdown;
var
IdTCPServer1: TIdTCPServer;
GlobalSettings: TGlobalSettings;
TmpBool: boolean; // Used when the boolean must be read from stream, but not used in function.
GlobalStream : TMemoryStream;
TmpInt: integer; // Used to load integers not required by database (Compiler warning issue)
SpareInt1, SpareInt2: integer; // Same here
SpareStr1, SpareStr2: string; // Same here
const
DTBReleaseTimeout = 3600000; // Release Databases after 1 hour.
// Server Status messages:
// ssUnknown = 0;
ssFound = 1;
ssNotFound = 0;
MAXCLIENTERRORS = 4;
// Note: The order is linked to a pulldown box in SARTrack!
ulInvalidCallsign = -4;
ulInvalidLogin = -3;
ulInvalidVersionLow = -2;
ulInvalidVersionHigh =
-1;
ulNotLoggedIn = 0;
ulReadOnly = 5;
ulDataEntry = 10;
ulOperations = 15;
ulSupervisor = 20;
ulSARTrack = 25;
resourcestring
stServerNotRespond =
'*** The Database Server failed to respond.***'+sLineBreak
+'You record has not been updated.'+sLineBreak
+'Make sure you are connected to the Database Server,'+sLineBreak
+'The try to save the record again.'+sLineBreak
+'If the problem persists, try restart SARTrack.';
implementation
uses IOFormU, APRSMain, ToolsU, BroadcastU, SARExceptionU, CapabilityU, DebugLogU,
TimeLineU;
var
TmpStr: string;
TmpDouble: double;
function StreamTypeToText(AStreamType:integer):string;
begin
if AStreamType = StreamType_Station then result := 'Station' else
if AStreamType = StreamType_Object then result := 'Object' else
if AStreamType = StreamType_Message then result := 'Message' else
if AStreamType = StreamType_SARLog then result := 'SARLog' else
if AStreamType = StreamType_SARLogUpdate then result := 'SARLogUpdate' else
if AStreamType = StreamType_TrackParts then result := 'TrackPart' else
if AStreamType = StreamType_Login then result := 'Login' else
if AStreamType = StreamType_ConnectStatus then result := 'ConnectStatus' else
if AStreamType = StreamType_Command then result := 'Command' else
if AStreamType = StreamType_DTBUsers then result := 'DTBUsers' else
if AStreamType = StreamType_GlobalSettings then result := 'GlobalSettings' else
if AStreamType = StreamType_References then result := 'References' else
if AStreamType = StreamType_People then result := 'People' else
if AStreamType = StreamType_CapabilityList then result := 'CapabilityList' else
if AStreamType = StreamType_Binary then result := 'Binary' else
if AStreamType = StreamType_StationDetails then result := 'StationDetails' else
if AStreamType = StreamType_Equipment then result := 'Equipment' else
if AStreamType = StreamType_EquipmentName then result := 'EquipmentName' else
if AStreamType = StreamType_ClientUpdateRequest then result := 'ClientUpdateRequest'
else result := '*UNKNOWN*: '+IntToStr(AStreamType);
end;
function CopyDTBCommand(ADTBCommand:TDTBCommand):TDTBCommand;
begin
result.GroupID := ADTBCommand.GroupID;
result.OpsName := ADTBCommand.OpsName;
result.DTBCallsign := ADTBCommand.DTBCallsign;
result.DestCallsign := ADTBCommand.DestCallsign;
result.Command := ADTBCommand.Command;
result.Database := ADTBCommand.Database;
result.Keyword := ADTBCommand.Keyword;
result.FromTimeStamp := ADTBCommand.FromTimeStamp;
result.ConfirmationID := ADTBCommand.ConfirmationID;
result.ReplyStr := ADTBCommand.ReplyStr;
result.SpareStr2 := ADTBCommand.SpareStr2;
end;
// THREAD!!! Called from ServerExecute
procedure DTBMakeGroupDirectories(AGlobalSetting: TGlobalSetting);
var
GroupDir: string;
begin
try
GroupDir := IncludeTrailingPathDelimiter(DatabaseDir+IntToStr(AGlobalSetting.GroupID));
if not DirectoryExists(GroupDir) then
begin
LocalLog('DTBMakeGroupDirectories: Forcing: '+GroupDir);
ForceDirectories(GroupDir);
end;
// Binaries:
if not DirectoryExists(GroupDir+'Binaries') then
begin
LocalLog('DTBMakeGroupDirectories: Forcing: '+GroupDir+'Binaries');
ForceDirectories(GroupDir+'Binaries');
end;
// TempDir:
if not DirectoryExists(GroupDir+'Temp') then
begin
LocalLog('DTBMakeGroupDirectories: Forcing: '+GroupDir+'Temp');
ForceDirectories(GroupDir+'Temp');
end;
except
on E:Exception do LocalLog('DTBMakeGroupDirectories: '+E.Message,d_error);
end;
end;
function GetContextClient(ACallsign:string):TDTBContextClient;
var
i: integer;
LockList : TList;
begin
result := nil;
LockList := IdTCPServer1.Contexts.LockList;
try
for i := 0 to LockList.Count-1 do
begin
if TDTBContextClient(LockList[i]).Callsign = ACallsign then
begin
Result := TDTBContextClient(LockList[i]);
Exit;
end;
end;
finally
IdTCPServer1.Contexts.UnlockList;
end;
end;
function CheckAccessLevel(RequiredLevel:integer; ACallsign:string):boolean;
var
ADTBClient: TDTBContextClient;
begin
result := false;
ADTBClient := GetContextClient(ACallsign);
if ADTBClient = nil then
begin
Log('CheckAccessLevel: Client not found! '+ACallsign,d_error);
exit;
end;
Log('CheckAccessLevel: Required='+AccessLevelToText(RequiredLevel)
+' DTBSelectedLevel='+AccessLevelToText(ADTBClient.AccessLevel));
if SARSettings.DTBSelectedLevel < RequiredLevel then
begin
Log('CheckAccessLevel: Not allowed for '+ACallsign);
exit;
end;
result := true;
end;
function SafetyCheck(ADTBClient: TDTBContextClient):boolean;
begin
result := false;
if ADTBClient.Callsign = '' then
begin
Log('SafetyCheck: Client Callsign = ""!',D_error);
exit;
end;
if ADTBClient.GroupID > 25599 then
begin
Log('SafetyCheck: Client GroupID out of range!',D_error);
exit;
end;
{if not assigned(ADTBClient) then
begin
Log('SafetyCheck: AContect not assigned!',D_error);
exit;
end;}
if ADTBClient.OpsName = '' then
begin
Log('SafetyCheck: Opsname = ""!',D_error);
exit;
end;
if ADTBClient.ClientErrors > MAXCLIENTERRORS then
begin
Log('SafetyCheck: To many errors for this Client: '+IntToStr(ADTBClient.ClientErrors),d_error);
exit;
end;
result := true;
end;
// -------------- DATASTREAMS --------------------------------------------------
function TDataStreams.AddStream(Item: TMemoryStream): integer;
begin
result := Add(Item);
end;
function TDataStreams.CopyStream(AStream:TMemoryStream):TMemoryStream;
var
NewStream: TMemoryStream;
begin
NewStream := TMemoryStream.Create;
NewStream.CopyFrom(AStream,0);
AddStream(NewStream);
result := NewStream;
// Log('DataStreams.CopyStream: NewStream.Size='+IntToStr(NewStream.Size)+' DataStreams.Count='+IntToStr(self.Count));
end;
procedure TDataStreams.SetRecord(AIndex: integer; const AValue: TMemoryStream);
begin
Put(AIndex, AValue);
end;
function TDataStreams.GetRecord(AIndex: integer):TMemoryStream;
begin
result := Get(AIndex);
end;
//------------- DTBCLIENT ------------------------------------------------------
constructor TDTBContextClient.Create;
begin
inherited;
DataStreams := TDataStreams.Create;
DatabaseList := TStringList.Create;
end;
destructor TDTBContextClient.Destroy;
begin
try
if assigned(self.DataStreams) then FreeAndNil(DataStreams);
except
on E:Exception do Log('DTBClient.Destroy (1): '+E.Message,d_error);
end;
try
if assigned(self.DatabaseList) then FreeAndNil(DatabaseList);
except
on E:Exception do Log('DTBClient.Destroy (2): '+E.Message,d_error);
end;
inherited;
end;
procedure TDTBContextClient.AddDatabase(ADatabase: string);
var i: integer;
begin
for i := 0 to DatabaseList.Count-1 do
begin
if DatabaseList[i] = ADatabase then
begin
// Log('DTBClient.AddDatabase: Already exists: "'+ADatabase+'" for '+Callsign);
exit;
end;
end;
DatabaseList.Add(ADatabase);
Log('DTBClient.AddDatabase: Added: "'+ADatabase+'" for '+Callsign);
end;
function TDTBContextClient.WantsDatabase(ADatabase: string; AFromCall:string):boolean;
var i: integer;
begin
result := false;
if self.Callsign = AFromCall then exit; // Packet came from myself, do not return it.
result := true;
for i := 0 to DatabaseList.Count-1 do
begin
if DatabaseList[i] = ADatabase then
begin
// Log('DTBClient.WantsDatabase: Yes: "'+ADatabase+'" for '+Callsign);
exit;
end;
end;
result := false;
end;
procedure TDTBContextClient.RemoveDatabase(ADatabase: string);
var i: integer;
begin
for i := 0 to DatabaseList.Count-1 do
begin
if DatabaseList[i] = ADatabase then
begin
Log('DTBClient.RemoveDatabase: Removing: "'+ADatabase+'" for '+Callsign);
Datab
aseList.Delete(i);
exit;
end;
end;
end;
{
function TDTBClientList.Add(AOutputBuffer: TDTBClient): integer;
begin
result := inherited Add(AOutputBuffer);
end;
function TDTBClientList.GetRecord(AIndex: integer):TDTBClient;
begin
result := Get(AIndex);
end;
procedure TDTBClientList.SetRecord(AIndex: integer; const AValue: TDTBClient);
begin
Put(AIndex, AValue);
end;
// THREAD!
function TDTBClientList.GetClient(ACallsign: string):TDTBClient;
var i: integer;
begin
result := nil;
for i := self.Count-1 downto 0 do
begin
if self[i].Callsign = ACallsign then
begin
result := self[i];
// Log('GetClient(ACallsign): Found at Index '+IntToStr(i));
exit;
end;
end;
end;
// THREAD!
// WARNING this is called 1000+ times per second!
function TDTBClientList.GetClient(AContext: TIdContext;var Index:integer):TDTBClient;
var i : integer;
begin
result := nil;
for i := self.Count-1 downto 0 do
begin
if self[i].AContext = AContext then
begin
result := self[i];
index := i;
// LocalLog('GetClient(AContext): Found at Index '+IntToStr(i));
exit;
end;
end;
end;
procedure TDTBClientList.Clear;
begin
inherited;
end;
procedure TDTBClientList.Delete(Index:integer);
begin
try
inherited Delete(Index);
except
on E:Exception do Log('DTBClients.Delete('+IntToStr(Index)+') Inherited: '+E.Message,d_error);
end;
end;
}
//----------- GLOBAL SETTINGS --------------------------------------------------
procedure TGlobalSetting.Defaults;
begin
GroupID := 0;
ActiveOpsName := 'NONE';
DTBCallsign := SARSettings.DTBServerCallsign;
PeopleAvailableColor := $FFFF80;
PeopleUnavailableColor := clRed;
PeopleArrivedColor := clLime;
PeopleAssignedColor := $0080FF; // Orange
MaxTrackParts := 1000;
TrackWidth := 4;
end;
procedure TGlobalSetting.Assign(AGlobalSetting: TGlobalSetting);
begin
if not assigned(AGlobalSetting) then exit;
GroupID := AGlobalSetting.GroupID;
ActiveOpsName := AGlobalSetting.ActiveOpsName;
DTBCallsign := AGlobalSetting.DTBCallsign;
MaxTrackParts := AGlobalSetting.MaxTrackParts;
TrackWidth := AGlobalSetting.TrackWidth;
PeopleAvailableColor := AGlobalSetting.PeopleAvailableColor;
PeopleUnavailableColor := AGlobalSetting.PeopleUnavailableColor;
PeopleArrivedColor := AGlobalSetting.PeopleArrivedColor;
PeopleAssignedColor := AGlobalSetting.PeopleAssignedColor;
end;
// NOTE: Every GlobalSetting is specific for every SAR Group(ID).
procedure TGlobalSetting.LoadStream(Reader: TReader);
var
AVersion, i: integer;
AMaxTrackParts,ATrackWidth: integer;
begin
try
AVersion := Reader.ReadInteger;
if AVersion >= 1 then
begin
Log('GlobalSetting.LoadStream: AVersion='+IntToStr(AVersion));
GroupID := Reader.ReadInteger;
Log('GlobalSetting.LoadStream: GroupID='+IntToStr(GroupID));
ActiveOpsName := Reader.Readstring;
Log('GlobalSetting.LoadStream: ActiveOpsName='+ActiveOpsName);
DTBCallsign := Reader.Readstring;
Log('GlobalSetting.LoadStream: DTBCallsign='+DTBCallsign);
AMaxTrackParts := Reader.ReadInteger;
if AMaxTrackParts > 0 then MaxTrackParts := AMaxTrackParts;
Log('GlobalSetting.Load: MaxTrackParts=' + IntToStr(AMaxTrackParts));
ATrackWidth := Reader.ReadInteger;
if ATrackWidth > 0 then TrackWidth := ATrackWidth;
Log('GlobalSetting.Load: TrackWidth=' + IntToStr(ATrackWidth));
PeopleAvailableColor := Reader.ReadInteger;
PeopleUnavailableColor := Reader.ReadInteger;
PeopleArrivedColor := Reader.ReadInteger;
PeopleAssignedColor := Reader.ReadInteger;
for i := 1 to 20 do TmpInt := Reader.ReadInteger;
for i := 1 to 20 do TmpStr := Reader.ReadString;
for i := 1 to 10 do TmpDouble := Reader.ReadDouble;
Footer := Reader.ReadInteger;
end;
except
on E:exception do Raise;
end;
end;
procedure TGlobalSetting.SaveStream(Write
r: TWriter);
var i: integer;
begin
try
Writer.WriteInteger(FVersion);
Writer.WriteInteger(GroupID);
Writer.WriteString(ActiveOpsName);
Writer.WriteString(DTBCallsign);
Writer.WriteInteger(MaxTrackParts);
Writer.WriteInteger(TrackWidth);
Writer.WriteInteger(PeopleAvailableColor);
Writer.WriteInteger(PeopleUnavailableColor);
Writer.WriteInteger(PeopleArrivedColor);
Writer.WriteInteger(PeopleAssignedColor);
for i := 1 to 20 do Writer.WriteInteger(0);
for i := 1 to 20 do Writer.WriteString('');
for i := 1 to 10 do Writer.WriteDouble(0);
Writer.WriteInteger(StreamType_GlobalSettingsFooter);
except
on E:exception do Raise;
end;
end;
function TGlobalSettings.GetRecord(AIndex: integer): TGlobalSetting;
begin
result := inherited Get(AIndex);
end;
procedure TGlobalSettings.SetRecord(AIndex: integer; const AValue: TGlobalSetting);
begin
inherited Put(AIndex, AValue);
end;
function TGlobalSettings.AddGlobalSetting(AGlobalSetting: TGlobalSetting):boolean;
begin
result := false;
try
if not assigned(AGlobalSetting) then exit;
if GetGlobalSetting(AGlobalSetting.GroupID) <> nil then
begin
Log('AGlobalSetting: Duplicate GroupID!',d_error);
exit;
end;
inherited Add(AGlobalSetting);
result := true;
except
raise;
end;
end;
// THREAD!! When called from ServerExecute!
function TGlobalSettings.GetGlobalSetting(AGroupID:integer):TGlobalSetting;
var
i: integer;
begin
result := nil;
for i := 0 to self.Count-1 do
begin
if self[i].GroupID = AGroupID then
begin
result := self[i];
LocalLog('GetGlobalSetting: Found for GroupID: '+IntToStr(self[i].GroupID)+' ActiveOps='+self[i].ActiveOpsName
+' MaxTrackParts='+IntToStr(self[i].MaxTrackParts)+' TrackWidth='+IntToStr(self[i].TrackWidth));
exit;
end;
end;
end;
(*
function TGlobalSettings.GetGlobalSetting(AOpsName:string):TGlobalSetting;
var
i: integer;
begin
result := nil;
AOpsName := lowercase(AOpsName);
for i := 0 to self.Count-1 do
begin
if lowercase(self[i].ActiveOpsName) = AOpsName then
begin
result := self[i];
exit;
end;
end;
end;
*)
// Called from Server Thread
function TGlobalSettings.SaveToDisk:boolean;
var i: integer;
Stream: TMemoryStream;
AnsiWriter: TAnsiWriter;
begin
result := false;
if Count = 0 then exit;
if NOT HasChanged then exit;
LocalLog('GlobalSettings.SaveToDisk: Count='+IntToStr(self.count),d_4);
Stream := TMemoryStream.Create;
AnsiWriter := TAnsiWriter.Create(Stream, 4096);
try
try
AnsiWriter.WriteListBegin;
for i:= 0 to self.count-1 do
begin
LocalLog('GlobalSettings.SaveToDisk: OpsName='+self[i].ActiveOpsName,d_4);
if self[i].ActiveOpsName <> '' then self[i].SaveStream(AnsiWriter);
end;
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
Stream.SaveToFile(GlobalSettingsFilename);
HasChanged := false;
result := true;
except
on E:exception do LocalLog('GlobalSettings.SaveToDisk: '+E.Message,d_error);
end;
finally
AnsiWriter.free;
Stream.Free;
end;
end;
// NOT a thread; Called from Init.
function TGlobalSettings.LoadFromDisk;
var
Reader: TReader;
Stream : TMemoryStream;
AGlobalSetting: TGlobalSetting;
begin
result := false;
if not FileExists(GlobalSettingsFilename) then
begin
Log('GlobalSettings.LoadFromDisk: File not found: '+GlobalSettingsFilename);
exit;
end;
Stream := TMemoryStream.Create;
Reader:= TReader.Create(Stream, 4096 );
try
try
Log('GlobalSettings.LoadFromDisk: Loading: '+GlobalSettingsFilename);
Stream.LoadFromFile(GlobalSettingsFilename);
Stream.Seek(0, soBeginning);
Reader.ReadListBegin;
while not Reader.EndOfList Do
begin
AGlobalSetting := TGlobalSetting.Create;
try
AGlobalSetting.LoadStream(Reader);
sel
f.AddGlobalSetting(AGlobalSetting);
Log('GlobalSettings.LoadFromDisk: ActiveOpsName='+AGlobalSetting.ActiveOpsName);
except
on E:exception do
begin
AGlobalSetting.Free;
raise;
end;
end;
end;
Reader.ReadListEnd;
Log('GlobalSettings.LoadFromDisk: Loaded: '+IntToStr(self.Count));
except
on E:Exception do
begin
log('GlobalSettings.LoadFromDisk: Error reading file: '+E.ClassName+': '+E.Message,D_ERROR);
end;
end;
finally
Reader.free;
Stream.Free;
end;
end;
procedure LocalLog(AText:string; debuglevel:byte=D_DTB);
var TransferRecord : PTransferRecord;
begin
if debuglevel < 100 then inc(debuglevel,100);
New(TransferRecord);
TransferRecord^.UniData := '[DTBSERVER] '+AText;
TransferRecord^.ThreadID := GetCurrentThreadID;
PostMessage(SARTrackForm.Handle, TH_DebugLogMessage, debuglevel, LPARAM(TransferRecord));
end;
//Not a thread- called from ProcessIncomingData in DTBForm
function DTBLoadCommand(AnsiReader: TAnsiReader):boolean;
var
AVersion, Footer: integer;
DTBCommand: TDTBCommand;
begin
result := false;
fillchar(DTBCommand,sizeof(DTBCommand),#0);
try
AVersion := AnsiReader.ReadInteger;
if AVersion >= 1 then
with DTBCommand do
begin
GroupID := AnsiReader.ReadInteger;
OpsName := AnsiReader.Readstring;
DTBCallsign := AnsiReader.Readstring;
DestCallsign := AnsiReader.Readstring;
Command := AnsiReader.Readstring;
Database := AnsiReader.Readstring;
Keyword := AnsiReader.Readstring;
FromTimeStamp := AnsiReader.ReadInt64;
ConfirmationID := AnsiReader.ReadInteger;
ReplyStr := AnsiReader.Readstring;
SpareStr2 := AnsiReader.Readstring;
ErrorCode := AnsiReader.ReadInteger;
Footer := AnsiReader.ReadInteger;
if Footer <> StreamType_CommandFooter then
begin
Log('DTBLoadCommand: Wrong Footer! '+IntToStr(Footer),d_error);
fillchar(DTBCommand,sizeof(DTBCommand),#0);
exit;
end;
end;
{if (NOT SARSettings.IsDTBServer) then
begin
result := true;
fillchar(DTBCommand,sizeof(DTBCommand),#0);
exit;
end;}
if {(NOT DTBInitialLoad) and} (DTBCommand.DTBCallsign = SARSettings.DTBServerCallsign) then
begin
Log('DTBLoadCommand: Received my own data, Skipping',d_error);
result := true;
fillchar(DTBCommand,sizeof(DTBCommand),#0);
exit;
end;
DTBProcessCommand(DTBCommand); // Both Server and Clients must process this
except
on E:Exception do
begin
Log('DTBLoadCommand: '+E.Message,d_error);
exit;
end;
end;
result := true;
end;
//Not a thread- called from ProcessIncomingData in DTBForm
// Change of Active Operation is done here, also other settings.
function DTBUpdateGlobalSettings(AnsiReader: TAnsiReader):boolean;
var
AGlobalSetting, NewGlobalSetting: TGlobalSetting;
i: integer;
OpsNameHasChanged,
MaxTrackPartsChanged: boolean;
LockList : TList;
begin
result := false;
OpsNameHasChanged := false;
MaxTrackPartsChanged := false;
AGlobalSetting := TGlobalSetting.Create;
LockList := IdTCPServer1.Contexts.LockList;
// Log('DTBUpdateGlobalSettings...');
try
try
TmpBool := AnsiReader.ReadBoolean; // InitialLoad
AGlobalSetting.LoadStream(AnsiReader);
if AGlobalSetting.Footer <> StreamType_GlobalSettingsFooter then
begin
Log('DTBUpdateGlobalSettings: Wrong Footer! '+IntToStr(AGlobalSetting.Footer),d_error);
AGlobalSetting.Free;
exit; // Abort all.
end;
if AGlobalSetting.MaxTrackParts <= 0 then
begin
AGlobalSetting.MaxTrackParts := 1000;
MaxTrackPartsChanged := true;
Log('DTBUpdateGlobalSettings: Error: MaxTrackParts='+IntToStr(AGlobalSetting.MaxTrackParts),d_error);
end;
if AGlobalSetting.TrackWidth <= 0 t
hen
begin
AGlobalSetting.TrackWidth := 4;
MaxTrackPartsChanged := true;
Log('DTBUpdateGlobalSettings: Error: TrackWidth = 0!',d_error);
end;
// More here later
// Server:
NewGlobalSetting := GlobalSettings.GetGlobalSetting(AGlobalSetting.GroupID);
if NewGlobalSetting = nil then
begin
GlobalSettings.AddGlobalSetting(AGlobalSetting);
NewGlobalSetting := AGlobalSetting;
OpsNameHasChanged := true;
Log('DTBUpdateGlobalSettings: NEW for GroupID: '+IntToStr(AGlobalSetting.GroupID)+' ActiveOps='+AGlobalSetting.ActiveOpsName
+' MaxTrackParts='+IntToStr(AGlobalSetting.MaxTrackParts)+' TrackWidth='+IntToStr(AGlobalSetting.TrackWidth));
end else
begin
if AGlobalSetting.ActiveOpsName <> NewGlobalSetting.ActiveOpsName then OpsNameHasChanged := true;
if AGlobalSetting.MaxTrackParts <> NewGlobalSetting.MaxTrackParts then MaxTrackPartsChanged := true;
NewGlobalSetting.Assign(AGlobalSetting);
Log('DTBUpdateGlobalSettings: Changing for GroupID: '+IntToStr(AGlobalSetting.GroupID)+' ActiveOps='+AGlobalSetting.ActiveOpsName
+' MaxTrackParts='+IntToStr(AGlobalSetting.MaxTrackParts)+' TrackWidth='+IntToStr(AGlobalSetting.TrackWidth));
end;
if OpsNameHasChanged then
begin
for i := 0 to LockList.Count-1 do // The connected Clients
begin
if TDTBContextClient(LockList[i]).GroupID = NewGlobalSetting.GroupID then
begin
TDTBContextClient(LockList[i]).OpsName := NewGlobalSetting.ActiveOpsName;
end;
end;
Log('DTBUpdateGlobalSettings: Changing Active Operation for DTBClients: '+AGlobalSetting.DTBCallsign+' to '+NewGlobalSetting.ActiveOpsName);
end;
if MaxTrackPartsChanged then
begin
RebuildTracks(NewGlobalSetting);
end;
GlobalSettings.HasChanged := true;
GlobalSettings.SaveToDisk;
DTBTransmit(NewGlobalSetting); // Update to ALL Clients with same GroupID.
result := true;
except
on E:Exception do
begin
Log('DTBUpdateGlobalSettings: '+E.Message,d_error);
exit;
end;
end;
finally
IdTCPServer1.Contexts.UnlockList;
AGlobalSetting.Free;
end;
end;
//Not a thread- called from ProcessIncomingData in DTBForm
// If the receiver is a Client, it will save the file to disk in the Temp directory.
// If this is the Server, it will also save the file to disk, but to keep it permanently.
// If it is a Client, it will then wait for the DTBCommand packet which follows it,
// so that it can confirm the binary exists, and the filename, so it can load it.
function DTBLoadBinary(AnsiReader: TAnsiReader;AStream:TMemoryStream;AGroupID:integer;ADestCall:string):boolean;
var
AVersion, Footer: integer;
BinStream: TMemoryStream;
ASize, AConfirmationID: integer;
AFilename, AltFilename: string;
DTBCommand : TDTBCommand;
BinaryDir: string;
begin
result := false;
try
AConfirmationID := AnsiReader.ReadInteger;
AVersion := AnsiReader.ReadInteger;
if AVersion >= 1 then
begin
ASize := AnsiReader.ReadInteger;
AFilename := AnsiReader.Readstring;
Log('DTBLoadBinary: '+AFilename);
if ASize > 0 then
begin
BinStream := TMemoryStream.Create;
AnsiReader.FlushBuffer;
try
BinStream.CopyFrom(AStream,ASize);
if AFilename <> '' then
begin
BinaryDir := DatabaseDir+IntToStr(AGroupID)+'\Binaries\';
// Delete any variations JPG or PNG of the binary file, else the Photo load will default to the first one found (.jpg)
AltFilename := copy(AFilename,1,length(AFilename)-4)+'.jpg';
if FileExists(BinaryDir+AltFilename) then DeleteFile(BinaryDir+AltFilename);
AltFilename := copy(AFilename,1,length(AFilename)-4)+'.png';
if FileExists(BinaryDir+AltFilename) then DeleteFile(Bina
ryDir+AltFilename);
BinStream.SaveToFile(BinaryDir+AFilename);
Log('DTBLoadBinary: Saving to file: '+BinaryDir+AFilename);
end else Log('DTBLoadBinary: Filename=empty! BinStream.Size='+IntToStr(BinStream.Size),d_DTBERROR);
finally
BinStream.Free;
end;
end;
Footer := AnsiReader.ReadInteger;
if Footer <> StreamType_BinaryFooter then
begin
Log('DTBLoadBinary: Wrong Footer! '+IntToStr(Footer),d_error);
exit;
end;
end;
//Log('DTBLoadBinary: Calling NotifyAllForms: ConfirmationID='+IntToStr(AConfirmationID));
//NotifyAllForms(ADestCall, SARSettings.DTBServerCallsign, 'binary','NoKey',AConfirmationID, AFilename,'');
DTBCommand.DTBCallsign := SARSettings.DTBServerCallsign;
DTBCommand.DestCallsign := ADestCall;
DTBCommand.GroupID := AGroupID;
DTBCommand.Database := 'people-photo';
DTBCommand.Command := 'response';
DTBCommand.Keyword := 'NoKey';
DTBCommand.ReplyStr := AFilename;
DTBCommand.ConfirmationID := AConfirmationID;
DTBSendCommand(DTBCommand);
except
on E:Exception do
begin
Log('DTBLoadBinary: '+E.Message,d_error);
exit;
end;
end;
result := true;
end;
// NOT a Thread.. Called from DTBThreadMessage in Client AND Server
procedure ProcessIncomingData(DTBTransferRecord : PDTBTransferRecord);
var
AFromCall, ADestCall, AOpsName: string;
AGroupID, ADTBMultiStream, i: integer;
AnsiReader: TAnsiReader; //AStream : TMemoryStream;
StreamType, MultiConfirmationID: integer;
ReTransmitStream: TMemoryStream;
ADTBClient: TDTBContextClient; // Debug situation only
T1, T2: cardinal;
LockList: TList;
begin
// Log('ProcessIncomingData...');
if ShutdownInProgress then exit;
AGroupID := 0;
LockList := IdTCPServer1.Contexts.LockList;
try
CheckTime('', T1, T2, false);
if not assigned(GlobalStream) then GlobalStream := TMemoryStream.Create;
if assigned(DTBTransferRecord.AStream) then
if DTBTransferRecord.AStream.Size > 0 then
begin
try
GlobalStream.CopyFrom(DTBTransferRecord.AStream,0);
except
on E:Exception do
begin
Log('ProcessIncomingData: GlobalStream.CopyFrom: '+E.Message+' Size='+IntToStr(DTBTransferRecord.AStream.Size),d_DTBerror);
exit;
end;
end;
end else
begin
Log('ProcessIncomingData: DTBTransferRecord.AStream not assigned!',d_DTBerror);
exit;
end;
try
AnsiReader := TAnsiReader.Create(GlobalStream, 4096 );
except
on E:Exception do
begin
Log('ProcessIncomingData: Creating Reader: '+E.Message,d_DTBerror);
exit;
end;
end;
try
GlobalStream.Seek(0,soBeginning);
AnsiReader.Position := 0;
AnsiReader.ReadListBegin;
AnsiReader.Position := GlobalStream.Size-1;
// Log('Looking for ReadListEnd at position '+IntToStr(AnsiReader.Position));
AnsiReader.ReadListEnd;
// Log('ReadListEnd found at position '+IntToStr(AnsiReader.Position));
except
on E: Exception do
begin
Log('ProcessIncomingData: End of List not found. GlobalStream kept.',d_DTBwarning);
Log('ProcessIncomingData: GlobalStream.Size='+IntToStr(GlobalStream.Size),d_DTBwarning);
GlobalStream.Seek(0,soEnd);
exit; // Next time, GlobalStream should get added to by the next read.
end;
end;
ADTBClient := DTBTransferRecord.DTBClient;
if ADTBClient = nil then
begin
Log('ProcessIncomingData: DTBClient is nil!! Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_error);
exit;
end;
try
try
GlobalStream.Position := 0;
AnsiReader.Position := 0;
AnsiReader.ReadListBegin;
AFromCall := AnsiReader.ReadString;
ADestCall := AnsiReader.ReadString;
AGroupID := AnsiReader.ReadInteger;
AOpsName := AnsiReader.ReadString;
ADTBMultiStream := AnsiReader.ReadInteger;
// if ADTBMultiStream <> 0 then Log('ProcessIncomingData: DTBMultiStream='+IntToStr(ADTBMultiStream));
if AFromCall = SARSettings.DTBServerCallsign then
begin
Log('ProcessIncomingData: Stream from me, Skipping.',d_DTBerror);
exit;
end;// else Log('GlobalStream: AFromCall='+AFromCall+' Processing.');
// if Superuser then Log('ProcessIncomingData: START Stream.Size='+IntToStr(GlobalStream.Size)); // DTBDEBUG
{$ifNdef CONSOLE}
inc(RXAverage); // Debug Stats
{$endif}
//This loops, reading the StreamType after each load of a record, until EndOfStream;
while not AnsiReader.EndOfList do
begin
if ShutdownInProgress then exit;
StreamType := AnsiReader.ReadInteger;
if StreamType = StreamType_ConnectStatus then
begin
Log('ProcessIncomingData: Loading ConnectStatus, but I am the server... Very BAD.',d_DTBError);
break; // Reload the StreamType next iteration
end else
if StreamType = StreamType_GlobalSettings then
begin
Log('ProcessIncomingData: Loading GlobalSetting');
if not DTBUpdateGlobalSettings(AnsiReader) then
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (GlobalSettings). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
if StreamType = StreamType_Command then
begin
// Log('ProcessIncomingData: Loading Command',d_DTB);
if not DTBLoadCommand(AnsiReader) then
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (Command). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
if StreamType = StreamType_DTBUsers then
begin
Log('ProcessIncomingData: Loading DTBUser(s)',D_DTB);
if not DTBLoadDTBUsers(AnsiReader,AGroupID) then
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (DTBUsers). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
if StreamType = StreamType_Station then
begin
// Log('ProcessIncomingData: Loading Station');
if not DTBUpdateStation(AnsiReader,AGroupID,AOpsname) then // One at the time
begin
ADTBClient := GetContextClient(AFromCall); // NOTE: Risky, it could be NIL.
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (Stations). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
if StreamType = StreamType_StationDetails then
begin
// Log('ProcessIncomingData: Loading Station');
if not DTBUpdateStationDetails(AnsiReader,AGroupID,AOpsname) then // One at the time
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (StationDetails). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
if StreamType = StreamType_Object then
begin
// Log('ProcessIncomingData: Loading Object');
if not DTBUpdateMarker(AnsiReader,AGroupID,AOpsname) then // One at the time
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (Objects). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
if StreamType = StreamType_Message then
begin
// Log('ProcessIncomingData: Loading Message');
if not DTBAddMessage(AnsiReader,AGroupID,AOpsname) then // One at the time
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (Messages). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
if StreamType = StreamType_References then
begin
// Log('ProcessIncomingData: Loading References');
if not DTBUpdateReference(AnsiReader,AGroupID,AOpsname) then // One at the time
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (References). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
if StreamType = StreamType_SARLog then
begin
// Log('ProcessIncomingData: Loading SARLog');
if not DTBAddSARLog(AnsiReader,AGroupID,AOpsname,AFromCall) then // One at the time
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (SARLog). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
if StreamType = StreamType_SARLogUpdate then
begin
Log('ProcessIncomingData: Loading SARLogUpdate');
if not DTBUpdateSARLog(AnsiReader,AGroupID,AOpsname,AFromCall) then // One at the time
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (SARLogUpdate). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
if StreamType = StreamType_People then
begin
// Log('ProcessIncomingData: Loading a People');
if not DTBUpdatePeople(AnsiReader,AGroupID,AOpsname,AFromCall) then // One at the time
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (People). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
if StreamType = StreamType_PeopleStatus then
begin
// Log('ProcessIncomingData: Loading People Status: DTBMultiStream='+IntToStr(ADTBMultiStream));
if not DTBUpdatePeopleStatus(AnsiReader,AGroupID,AOpsname,AFromCall,ADTBMultiStream,MultiConfirmationID) then // One at the time
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (People Status). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
if StreamType = Strea
mType_CapabilityList then
begin
if not DTBLoadCapabilityList(AnsiReader,AGroupId,AFromcall) then // One at the time
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (CapabilityList). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
if StreamType = StreamType_Binary then
begin
if not DTBLoadBinary(AnsiReader,GlobalStream,AGroupID,AFromCall) then // One at the time
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (Binary). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
if StreamType = StreamType_Equipment then
begin
if not DTBLoadEquipment(AnsiReader,AGroupId,AFromcall,ADTBMultiStream,MultiConfirmationID) then // One at the time
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (Equipment). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
if StreamType = StreamType_EquipmentName then
begin
if not DTBLoadEquipmentNameList(AnsiReader,AGroupID,AFromCall,ADTBMultiStream,MultiConfirmationID) then // One at the time
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (EquipmentName). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
if StreamType = StreamType_Timeline then
begin
if not DTBLoadTimeline(AnsiReader,AGroupId,AOpsname,AFromcall) then // One at the time
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData: Error in Stream (Timeline). Aborting. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
exit;
end;
continue; // Reload the StreamType next iteration
end else
// Stream error?
begin
inc(ADTBClient.ClientErrors);
LocalLog('ProcessIncomingData: Unknown Streamtype! '+IntToStr(StreamType)+'. From='+AFromCall+' GroupID='+IntToStr(AGroupID)+' ClientVersion='+IntToStr(ADTBClient.ClientVersion),d_DTBerror);
break;
end;
end; // While
AnsiReader.ReadListEnd;
if not SafetyCheck(ADTBClient) then // Something went wrong. Exit before retransmitting the data.
begin
try
if assigned(ADTBClient) then ADTBClient.Connection.Disconnect; // This will also delete it from the DTBClientList!
except
on E:Exception do Log('After SafetyCheck, Disconnecting DTBCLient: '+E.Message,d_error);
end;
exit;
end;
if ADestCall = '' then // ONLY when NOT directed to a single Station (or the Server):
begin
// Transmit the whole stream to all other clients:
// Log('ProcessIncomingData: Calling ServerToAllClients, FromCall='+AFromCall);
ReTransmitStream := TMemoryStream.Create;
ReTransmitStream.CopyFrom(GlobalStream,0);
ServerToAllClients(ReTransmitStream,AFromCall,ADestCall,AGroupID,AOpsName);
end;
if (ADTBMultiStream = MultiStreamPeopleStatus)
or (ADTBMultiStream = MultiStreamPeople) then // The entire Stream is a stream of Peopl
e(status)
begin
if MultiConfirmationID > 0 then
DTBSendCommand(SARSettings.DTBServerCallsign,AFromCall,AGroupID,'','people','response','NoKey',MultiConfirmationID,0,'');
ReTransmitStream := TMemoryStream.Create;
ReTransmitStream.CopyFrom(GlobalStream,0);
// Log('MultiStreamPeopleStatus received, processing clients');
for i := 0 to LockList.Count-1 do
begin
if TDTBContextClient(LockList[i]).WantsDatabase('people',AFromCall) then
begin
Log('ProcessIncomingData: Forwarding People Multi stream to '+TDTBContextClient(LockList[i]).Callsign+' Stream.Size='+IntToStr(ReTransmitStream.Size));
ServerToClient(ReTransmitStream,TDTBContextClient(LockList[i]).Callsign,TDTBContextClient(LockList[i]).GroupID,AOpsName);
end;
end;
end;
if (ADTBMultiStream = MultiStreamEquipment) then // The entire Stream is a stream of Equipment (status)
begin
if MultiConfirmationID > 0 then
DTBSendCommand(SARSettings.DTBServerCallsign,AFromCall,AGroupID,'','equipment','response','NoKey',MultiConfirmationID,0,'');
ReTransmitStream := TMemoryStream.Create;
ReTransmitStream.CopyFrom(GlobalStream,0);
// Log('MultiStreamEquipment received, processing clients');
for i := 0 to LockList.Count-1 do
begin
if TDTBContextClient(LockList[i]).WantsDatabase('equipment',AFromCall) then
begin
Log('ProcessIncomingData: Forwarding Equipment Multi stream to '+TDTBContextClient(LockList[i]).Callsign+' Stream.Size='+IntToStr(ReTransmitStream.Size));
ServerToClient(ReTransmitStream,TDTBContextClient(LockList[i]).Callsign,TDTBContextClient(LockList[i]).GroupID,AOpsName);
end;
end;
end;
if (ADTBMultiStream = MultiStreamEquipmentName) then // The entire Stream is a stream of EquipmentNames
begin
if MultiConfirmationID > 0 then
DTBSendCommand(SARSettings.DTBServerCallsign,AFromCall,AGroupID,'','equipmentname','response','NoKey',MultiConfirmationID,0,'');
ReTransmitStream := TMemoryStream.Create;
ReTransmitStream.CopyFrom(GlobalStream,0);
// Log('MultiStreamEquipment received, processing clients');
for i := 0 to LockList.Count-1 do
begin
if TDTBContextClient(LockList[i]).WantsDatabase('equipmentname',AFromCall) then
begin
Log('ProcessIncomingData: Forwarding EquipmentName Multi stream to '+TDTBContextClient(LockList[i]).Callsign+' Stream.Size='+IntToStr(ReTransmitStream.Size));
ServerToClient(ReTransmitStream,TDTBContextClient(LockList[i]).Callsign,TDTBContextClient(LockList[i]).GroupID,AOpsName);
end;
end;
end;
except
on E:Exception do
begin
Log('ProcessIncomingData (final): '+E.Message+'. From='+AFromCall+' GroupID='+IntToStr(AGroupID),d_DTBerror);
if ADTBClient <> nil then
begin
inc(ADTBClient.ClientErrors);
Log('ProcessIncomingData (final): ClientErrors='+IntToStr(ADTBClient.ClientErrors),d_DTBERROR);
end;
exit;
end;
end;
finally
AnsiReader.Free;
FreeAndNil(GlobalStream); // It was processed
CheckTime('ProcessIncomingData', T1, T2, true);
end;
finally
IdTCPServer1.Contexts.UnlockList;
end;
end;
procedure DTBThreadMessage(var AMessage : TMessage);
var DTBTransferRecord : PDTBTransferRecord;
begin
try
if AMessage.LParam <> 0 then
begin
DTBTransferRecord := PDTBTransferRecord(AMessage.LParam);
end else
begin
Log('DTBThreadMessage: Pointer is null!',d_error);
exit;
end;
except
on E:Exception do
begin
Log('DTBThreadMessage: Bad TransferRecord: '+E.Message,d_error);
exit;
end;
end;
try
try
case AMessage.WParam of
{TH_DTBCLIENTRXDATA : // Client From Server
begin
/
/ Log('DTBThreadMessage: Client From Server');
if not assigned(DTBTransferRecord.AStream) then
begin
Log('DTBThreadMessage: Thread not assigned!',d_error);
exit;
end;
// Log('DTBThreadMessage (Client mode): data received: Stream.Size='+IntToStr(DTBTransferRecord.AStream.Size));
ProcessIncomingData(DTBTransferRecord);
FreeAndNil(DTBTransferRecord.AStream);
end; }
TH_DTBSERVERRXDATA: // Server received from connected Client
begin
if not assigned(DTBTransferRecord.AStream) then
begin
Log('DTBThreadMessage: Thread not assigned!',d_error);
exit;
end;
ProcessIncomingData(DTBTransferRecord);
FreeAndNil(DTBTransferRecord.AStream);
end;
end;
except
on E:Exception do Log('DTBThreadMessage: '+E.Message,d_error);
end;
finally
Dispose(DTBTransferRecord);
AMessage.LParam := 0;
end;
end;
procedure StartStopDTBServer(Start:boolean);
begin
if Start then
begin
IdTCPServer1.Active := true;
// IdTCPServer1.IOHandler.
Log('Starting DTB Server');
end else
begin
IdTCPServer1.Active := false;
Log('Stopping DTB Server');
end;
end;
// THREAD!
class procedure TDTBEventHandlers.IdTCPServer1Connect(AContext: TIdContext);
begin
AContext.Connection.IOHandler.LargeStream := false;
AContext.Binding.SetKeepAliveValues(true,5000,5000);
//AContext.IP := AContext.Binding.PeerIP;
//ADTBClient.AccessLevel := 0;
LocalLog('Client Connect: IP='+AContext.Binding.PeerIP); // << Remy: I do not see this since the change.
end;
// THREAD!
class procedure TDTBEventHandlers.IdTCPServer1Disconnect(AContext: TIdContext);
begin
LocalLog('Client Disconnected'); //: '+AContext.Callsign+' at index '+IntToStr(i)+' IP='+DTBClientList[i].IP);
end;
// THREAD!
class procedure TDTBEventHandlers.IdTCPServer1Exception(AContext: TIdContext;
AException: Exception);
begin
LocalLog('DTB Server Exception: '+AException.Message,TH_ERRORMSG);
end;
// NOT a Thread
procedure SaveGlobalSettings;
begin
GlobalSettings.SaveToDisk;
end;
procedure SendAllDatabases(DTBCommand: TDTBCommand);
var
i: integer;
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
ADTBClient:TDTBContextClient;
AGlobalSetting: TGlobalSetting;
AStationList: TStationList;
AMarkerList: TMarkerList;
AMessageList: TMessageList;
ASARLogList: TSARLogList;
ATimeLineList: TTimeLineList;
AreferenceList: TReferenceList;
begin
// if HistoricData then exit; // LOCAL Historic data. This must be sepparated from Server work.
if ShutdownInProgress then exit;
Log('*************** SendAllDatabases');
try
ADTBClient := GetContextClient(DTBCommand.DTBCallsign);
if ADTBClient = nil then
begin
Log('SendAllDatabases: Client not found!',d_error);
exit;
end;
if DTBCommand.OpsName = '' then
begin
Log('SendAllDatabases: OpsName missing!',d_error);
exit;
end;
ADTBClient.OpsName := DTBCommand.OpsName; // This will be the requested Opsname from the Client
AGlobalSetting := GlobalSettings.GetGlobalSetting(DTBCommand.GroupID);
if AGlobalSetting <> nil then
begin
if AGlobalSetting.ActiveOpsName = DTBCommand.OpsName then
begin
ADTBClient.IsActiveOps := true;
end else
begin
ADTBClient.IsActiveOps := false;
end;
end else
begin
Log('SendAllDatabases: GlobalSettings not found for GroupID '+IntToStr(DTBCommand.GroupID)+' Making one.',d_Warning);
AGlobalSetting := TGlobalSetting.Create;
AGlobalSetting.Defaults;
AGlobalSetting.GroupID := DTBCommand.GroupID;
GlobalSettings.AddGlobalSetting(AGlobalSetting);
GlobalSettings.HasChanged := true;
DTBMakeGroupDirectories(AGlobalSetting); // Only if they not already exist
end;
AStream := TMemoryStream.Create;
AnsiWriter := TAnsiWriter.Create(AStream, 4096 );
except
on E:Exception do
begin
Log('SendAllDatabases (1): '+E.Message,d_error);
exit;
end;
end;
try
try
AnsiWriter.WriteListBegin; // NOTE: This is the BEGIN for the entire Stream, including Stations etc.
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(DTBCommand.DTBCallsign); // DestStation
AnsiWriter.WriteInteger(DTBCommand.GroupID);
AnsiWriter.WriteString(DTBCommand.OpsName);
AnsiWriter.WriteInteger(MultiStreamInitial);
except
on E:Exception do
begin
Log('SendAllDatabases (2): '+E.Message,d_error);
exit;
end;
end;
// ALL References: NOTE: Send these first, so that it is not possible that they are "auto-generated" by incoming Log entries
AReferenceList := ReferenceListList.GetReferenceList(DTBCommand.GroupID,DTBCommand.OpsName);
if AReferenceList = nil then
begin
Log('SendAllDatabases: ReferenceList not found, Making one.',d_DTB);
AReferenceList := ReferenceListList.AddReferenceList(DTBCommand.GroupId,DTBCommand.Opsname);
AReferenceList.LoadFromDisk;
end;
if AReferenceList.Count <> 0 then
begin
Log('SendAllDatabases: Sending References: '+IntToStr(AReferenceList.Count));
try
for i := 0 to AReferenceList.Count-1 do
begin
AnsiWriter.WriteInteger(StreamType_References);
AnsiWriter.WriteBoolean(true); // InitialLoad.
AReferenceList[i].SaveStream(AnsiWriter);
// Log('Sending Reference: '+AReferenceList[i].RefName+' TeamID='+IntToStr(AReferenceList[i].TeamID));
end;
except
on E:Exception do
begin
Log('SendAllDatabases: Sending ReferenceList failed: '+E.Message,d_error);
exit;
end;
end;
end;
// ALL STATIONS:
AStationList := StationListList.GetStationList(DTBCommand.GroupID,DTBCommand.OpsName);
if AStationList = nil then
begin
Log('SendAllDatabases: StationList not found: Making one.',d_DTB);
AStationList := StationListList.AddSTationList(DTBCommand.GroupId,DTBCommand.Opsname);
AStationList.LoadFromDisk;
AStationList.MaxTrackParts := AGlobalSetting.MaxTrackParts;
end;
Log('SendAllDatabases: Sending Stations: '+IntToStr(AStationList.Count));
try
for i := 0 to AStationList.Count-1 do
begin
AStationList[i].MaxTrackParts := AGlobalSetting.MaxTrackParts;
AnsiWriter.WriteInteger(StreamType_Station);
AnsiWriter.WriteBoolean(true); // InitialLoad.
AStationList[i].SaveStream(AnsiWriter,true);
{if AStationList[i].FOverlay.TrackParts.Count > 0 then
begin
//Log('Sending: '+AStationList[i].Callsign+' Tracks='+IntToStr(AStationList[i].FOverlay.TrackParts.Count)
// +' TrackPos='+IntToStr(AStationList[i].FOverlay.TrackWritePos));
if AStationList[i].Latitude <> AStationList[i].FOverlay.TrackParts[AStationList[i].FOverlay.TrackWritePos].FLatitude
then Log('*** Sending Station Latitude error! '+AStationList[i].Callsign+' Diff='+FloatToStrF(AStationList[i].Latitude-AStationList[i].FOverlay.TrackParts[AStationList[i].FOverlay.TrackWritePos].FLatitude,ffFixed, 16, 8),d_error);
end; }
end;
// LocalLog('SendAllDatabases: Stations: Stream.Size='+IntToStr(ADTBClient.FStreams[ADTBClient.ServerIndex].Size));
except
on E:Exception do
begin
Log('SendAllDatabases: Sending StationList failed: '+E.Message,d_error);
exit;
end;
end;
// ALL OBJECTS:
AMarkerList := MarkerListList.GetMarkerList(DTBCommand.GroupID,DTBCommand.OpsName);
if AMarkerList = nil then
begin
Log('SendAllDatabases: MarkerList not found, Making one.',d_DTB);
AMarkerList := MarkerListList.AddMarkerList(DTBCommand.GroupId,DTBCommand.Opsname);
AMarkerList.LoadFromDisk;
AM
arkerList.MaxTrackParts := AGlobalSetting.MaxTrackParts;
end;
Log('SendAllDatabases: Sending Objects: '+IntToStr(AMarkerList.Count));
try
for i := 0 to AMarkerList.Count-1 do
begin
AMarkerList[i].MaxTrackParts := AGlobalSetting.MaxTrackParts;
AnsiWriter.WriteInteger(StreamType_Object);
AnsiWriter.WriteBoolean(true); // InitialLoad.
AnsiWriter.WriteBoolean(true); // IncludeCoords
AMarkerList[i].SaveStream(AnsiWriter,true);
{if AMarkerList[i].FOverlay.TrackParts.Count > 0 then
begin
//Log('Sending: '+AMarkerList[i].Objectname+' Tracks='+IntToStr(AMarkerList[i].FOverlay.TrackParts.Count)
// +' TrackPos='+IntToStr(AMarkerList[i].FOverlay.TrackWritePos));
if AMarkerList[i].Latitude <> AMarkerList[i].FOverlay.TrackParts[AMarkerList[i].FOverlay.TrackWritePos].FLatitude
then Log('*** Sending Object Latitude error! '+AMarkerList[i].Objectname+' Diff='+FloatToStrF(AMarkerList[i].Latitude-AMarkerList[i].FOverlay.TrackParts[AMarkerList[i].FOverlay.TrackWritePos].FLatitude,ffFixed, 16, 8),d_error);
end; }
end;
except
on E:Exception do
begin
Log('SendAllDatabases: Sending MarkerList failed: '+E.Message,d_error);
exit;
end;
end;
// ALL MESSAGES:
AMessageList := MessageListList.GetMessageList(DTBCommand.GroupID,DTBCommand.OpsName);
if AMessageList = nil then
begin
Log('SendAllDatabases: MessageList not found, Making one.',d_DTB);
AMessageList := MessageListList.AddMessageList(DTBCommand.GroupId,DTBCommand.Opsname);
AMessageList.LoadFromDisk;
end;
Log('SendAllDatabases: Sending Messages: '+IntToStr(AMessageList.Count));
try
for i := 0 to AMessageList.Count-1 do
begin
AnsiWriter.WriteInteger(StreamType_Message);
AnsiWriter.WriteBoolean(true); // InitialLoad.
AMessageList[i].SaveStream(AnsiWriter);
end;
except
on E:Exception do
begin
Log('SendAllDatabases: Sending MessageList failed: '+E.Message,d_error);
exit;
end;
end;
// ALL TimeLines:
ATimeLineList := TimeLineListList.GetTimeLineList(DTBCommand.GroupID,DTBCommand.OpsName);
if ATimeLineList = nil then
begin
Log('SendAllDatabases: TimeLineList not found, Making one.',d_DTB);
ATimeLineList := TimeLineListList.AddTimeLineList(DTBCommand.GroupId,DTBCommand.Opsname);
ATimeLineList.LoadFromDisk;
end;
Log('SendAllDatabases: Sending TimeLines: '+IntToStr(ATimeLineList.Count));
try
for i := 0 to ATimeLineList.Count-1 do
begin
AnsiWriter.WriteInteger(StreamType_TimeLine);
AnsiWriter.WriteBoolean(true); // InitialLoad.
ATimeLineList[i].SaveStream(AnsiWriter);
end;
except
on E:Exception do
begin
Log('SendAllDatabases: Sending TimeLine failed: '+E.Message,d_error);
exit;
end;
end;
// ALL SARLogs:
ASARLogList := SARLogListList.GetSARLogList(DTBCommand.GroupID,DTBCommand.OpsName);
if ASARLogList = nil then
begin
Log('SendAllDatabases: SARLogList not found, Making one.',d_DTB);
ASARLogList := SARLogListList.AddSARLogList(DTBCommand.GroupId,DTBCommand.Opsname);
ASARLogList.LoadFromDisk;
end;
Log('SendAllDatabases: Sending SARLogs for Opsname '+ADTBClient.OpsName+' Count='+IntToStr(ASARLogList.Count));
try
for i := 0 to ASARLogList.Count-1 do
begin
AnsiWriter.WriteInteger(StreamType_SARLog);
AnsiWriter.WriteBoolean(true); // InitialLoad.
ASARLogList[i].SaveStream(AnsiWriter);
end;
except
on E:Exception do
begin
Log('SendAllDatabases: Sending SARLogList failed: '+E.Message,d_error);
exit;
end;
end;
// NOTE: More sepparate stuff below!
// Here the rest: ....
try
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBu
ffer;
AnsiWriter.Free;
except
on E:Exception do
begin
Log('SendAllDatabases: FlushBuffer failed: '+E.Message,d_error);
exit;
end;
end;
if AStream.Size = 0 then
begin
Log('SendAllDatabases: Final Stream size = 0! Abort',d_error);
exit;
end;
Log('SendAllDatabases: Final Stream.Size='+IntToStr(AStream.Size));
with DTBCommand do
begin
ServerToClient(AStream,DTBCallsign,GroupID,Opsname);
end;
// -------------------------------------------------------------------------
// The following stuff may happen if a Client got disconnected in the middle
// of working in certain areas:
// Refresh also the PeopleList if we have an outstanding Update request:
// Check if any Clients have asked to get Updates from this database.
{for i := 0 to DTBClients.
AClientCall := ClientUpdateRequests.GetClient('people','', DTBCommand.GroupId);
if AClientCall = ADTBClient.Callsign then
begin
Log('SendAllDatabases: (Update) Sending People for Client '+AClientCall);
DTBCommand.DTBCallsign := AClientCall; // This works backwards!
// DTBCommand.DTBCallsign := SARSettings.DTBServerCallsign;
DTBTransmitPeople(DTBCommand);
break;
end;
until AClientCall = ''; }
// Refresh also the CapabilityList if we have an outstanding Update request:
{repeat // Check if any Clients have asked to get Updates from this database.
AClientCall := ClientUpdateRequests.GetClient('capabilitynamelist','', DTBCommand.GroupId);
if AClientCall = ADTBClient.Callsign then
begin
Log('SendAllDatabases: (Update) Sending CapabilityNames for Client '+AClientCall);
DTBCommand.DTBCallsign := AClientCall; // This works backwards!
// DTBCommand.DTBCallsign := SARSettings.DTBServerCallsign;
DTBTransmitCapabilityList(DTBCommand);
break;
end;
until AClientCall = ''; }
// Refresh also the EquipmentList if we have an outstanding Update request:
{repeat // Check if any Clients have asked to get Updates from this database.
AClientCall := ClientUpdateRequests.GetClient('equipment','', DTBCommand.GroupId);
if AClientCall = ADTBClient.Callsign then
begin
Log('SendAllDatabases: (Update) Sending Equipment for Client '+AClientCall);
DTBCommand.DTBCallsign := AClientCall; // This works backwards!
// DTBCommand.DTBCallsign := SARSettings.DTBServerCallsign;
DTBTransmitAllEquipment(DTBCommand);
break;
end;
until AClientCall = ''; }
// Refresh also the EquipmentNameList if we have an outstanding Update request:
{repeat // Check if any Clients have asked to get Updates from this database.
AClientCall := ClientUpdateRequests.GetClient('equipmentname','', DTBCommand.GroupId);
if AClientCall = ADTBClient.Callsign then
begin
Log('SendAllDatabases: (Update) Sending EquipmentNames for Client '+AClientCall);
DTBCommand.DTBCallsign := AClientCall; // This works backwards!
// DTBCommand.DTBCallsign := SARSettings.DTBServerCallsign;
DTBTransmitEquipmentNameList(DTBCommand);
break;
end;
until AClientCall = ''; }
except
on E:Exception do Log('SendAllDatabases (Final): '+E.Message,d_error);
end;
end;
// THREAD!
procedure ProcessLogin(ADTBClient: TDTBContextClient; AStream: TMemoryStream);
var
AnsiReader: TAnsiReader;
StreamType, ADTBMultiStream: integer;
ALoginName,
APasswd,
AFromCall, ADestCall,AOpsName: string;
AGroupID: integer;
ADTBUser: TDTBUser;
ADTBUserList: TDTBUserList;
AClientVersion: integer;
begin
if not assigned(AStream) then exit;
// LocalLog('ProcessLogin: '{+AOutputBuffer.Username});
AStream.Seek(0,soBeginning);
AnsiReader := TAnsiReader.Create(AStream,1024);
try
try
AnsiReader.ReadListBegin;
AFromCall := AnsiReader.ReadString;
AD
estCall := AnsiReader.ReadString;
AGroupID := AnsiReader.ReadInteger;
AOpsName := AnsiReader.ReadString;
ADTBMultiStream := AnsiReader.ReadInteger;
StreamType := AnsiReader.ReadInteger;
ALoginName := AnsiReader.ReadString;
APasswd := AnsiReader.ReadStr;
ADTBClient.Callsign := AnsiReader.ReadString;
AGroupID := AnsiReader.ReadInteger;
AClientVersion := AnsiReader.ReadInteger;
SpareInt1 := AnsiReader.ReadInteger;
SpareInt2 := AnsiReader.ReadInteger;
SpareStr1 := AnsiReader.ReadString;
SpareStr2 := AnsiReader.ReadString;
AnsiReader.ReadListEnd;
//if Superuser then
LocalLog('ProcessLogin: StreamType='+IntToStr(StreamType)+' Login='+ALoginName+' Pass='+APasswd
+' Callsign='+ADTBClient.Callsign+' GroupID='+IntToStr(AGroupID)+' IP='+ADTBClient.Binding.PeerIP);
ADTBClient.GroupID := AGroupID;
ADTBClient.LoginName := ALoginName;
ADTBClient.AccessLevel := ulInvalidLogin; // Default if things go wrong
ADTBClient.ClientVersion := AClientVersion;
if AClientVersion <> 0 then
begin
if AClientVersion > SARSettings.AcceptedHighestClientVersion then
begin
LocalLog('Client logging in to high Version number: '+IntToStr(AClientVersion)
+'. AcceptedHighestClientVersion is '+IntToStr(SARSettings.AcceptedHighestClientVersion),d_warning);
ADTBClient.AccessLevel := ulInvalidVersionHigh;
exit;
end else
if AClientVersion < SARSettings.AcceptedLowestClientVersion then
begin
LocalLog('Client logging in with to low Version number: '+IntToStr(AClientVersion)
+'. AcceptedLowestClientVersion '+IntToStr(SARSettings.AcceptedLowestClientVersion),d_warning);
ADTBClient.AccessLevel := ulInvalidVersionLow;
exit;
end;
end;
if AFromCall = SARSettings.DTBServerCallsign then
begin
LocalLog('Client logging in with SAME Callsign as Server!: '+AFromCall,d_warning);
ADTBClient.AccessLevel := ulInvalidCallsign;
exit;
end;
APasswd := Decrypt(RawBytestring(APasswd),AGroupID);
if ALoginName = rsSARTrack then // Master login to add other Supervisors for GroupID's
begin
if APasswd = rsSARTrackPass then
begin
ADTBClient.AccessLevel := ulSARTrack;
LocalLog('ProcessLogin: User '+ALoginName+' logged in at level '+AccessLevelToText(ADTBClient.AccessLevel)+' Callsign='+ADTBClient.Callsign
+' IP='+ADTBClient.Binding.PeerIP);
exit;
end;
end else
if lowercase(ALoginName) = lowercase(rsSUPERVISOR) then
begin
if APasswd = SARSettings.DTBSupervisorPass then
begin
ADTBClient.AccessLevel := ulSupervisor;
LocalLog('ProcessLogin: User '+ALoginName+' logged in at level '+AccessLevelToText(ADTBClient.AccessLevel)+' Callsign='+ADTBClient.Callsign+' IP='+ADTBClient.Binding.PeerIP);
exit;
end else LocalLog('ProcessLogin: User '+ALoginName+' invalid password: '+APasswd+' Callsign='+ADTBClient.Callsign+' IP='+ADTBClient.Binding.PeerIP);
end else
begin
// DTBDEBUG: Do we need Thread protection here?
ADTBUserList := DTBUserListList.GetDTBUserList(AGroupId);
if ADTBUserList = nil then
begin
LocalLog('ProcessLogin: DTBUserList not found, Making one.',d_DTB);
ADTBUserList := DTBUserListList.AddDTBUserList(AGroupId);
ADTBUserList.LoadFromDisk;
end;
ADTBUser := ADTBUserList.GetUser(ALoginName);
if ADTBUser = nil then
begin
LocalLog('ProcessLogin: Unknown Login name: '+ALoginName+' Callsign='+ADTBClient.Callsign+' IP='+ADTBClient.Binding.PeerIP,d_warning);
exit;
end else
begin
if APasswd = ADTBUser.Password then
begin
ADTBClient.AccessLevel := ADTBUser.Level;
LocalLog('ProcessLogin: User '+ALoginName+' logged in at level '+AccessLevelToText(ADTBUser.Level)+' Callsign='+ADTBClient.Callsign+' IP='+ADTBClient.Binding.PeerIP);
exit;
end else
begin
LocalLog('ProcessLogin: Invalid Password: '+ALoginName+' Callsign='+ADTBClient.Callsign+' IP='+ADTBClient.Binding.PeerIP,d_error);
ADTBClient.AccessLevel := ulInvalidLogin;
if SuperUser then LocalLog('Password='+APasswd+' DTBUser.Password='+ADTBUser.Password);
exit;
end;
end;
end;
except
on E:Exception do
begin
LocalLog('ProcessLogin: '+E.Message,TH_ERRORMSG);
exit;
end;
end;
finally
AnsiReader.Free;
end;
end;
procedure ServerTransfer(AStream:TmemoryStream; ADTBClient: TDTBContextClient);
var DTBTransferRecord : PDTBTransferRecord;
begin
New(DTBTransferRecord);
DTBTransferRecord^.AStream := AStream;
DTBTransferRecord^.ThreadID := GetCurrentThreadID;
DTBTransferRecord^.DTBClient := ADTBClient;
PostMessage(SARTrackForm.Handle, TH_MESSAGE, TH_DTBSERVERRXDATA, LPARAM(DTBTransferRecord)); // DTBDEBUG
end;
// THREAD!
class procedure TDTBEventHandlers.IdTCPServer1Execute(AContext: TIdContext);
var
ADTBClient: TDTBContextClient;
AStream, SendStream: TMemoryStream;
AnsiReader: TAnsiReader;
AnsiWriter: TAnsiwriter;
AStreamType, ADTBMultiStream: integer;
AFromCall, ADestCall, AOpsName: string;
AGlobalSetting: TGlobalSetting;
CurrentTime: TSystemTime;
CurrentTimeStamp: int64;
TransferRecord: PTransferRecord;
begin
if ShutDownInProgress then exit;
{try
if AContext.Data is TDTBContextClient
then ADTBClient := TDTBContextClient(AContext.Data)
else begin
LocalLog('Execute: Client not in Context.Data!',TH_ERRORMSG);
sleep(1);
exit;
end;
except
on E:Exception do
begin
Locallog('ContextData/DTBClient linkage: '+E.Message,d_DTBERROR);
exit;
end;
end; }
try // This Try is for global catch 1
// READ any INCOMING data:
if not AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
// LocalLog('OnExecute: Reading data from stream.');
AStream := TMemoryStream.Create;
AnsiReader := TAnsiReader.Create(AStream,1024);
try // finally
LocalLog('Server Received: AContext.Connection.IOHandler.InputBuffer.Size='+IntToStr(AContext.Connection.IOHandler.InputBuffer.Size));
AContext.Connection.IOHandler.ReadStream(AStream);
LocalLog('Server received from Client: Stream.Size='+IntToStr(AStream.Size));
AStream.Seek(0,soBeginning);
AnsiReader.ReadListBegin;
AFromCall := AnsiReader.ReadString;
ADestCall := AnsiReader.ReadString;
TmpInt := AnsiReader.ReadInteger; //GroupID
AOpsName := AnsiReader.ReadString;
ADTBMultiStream := AnsiReader.ReadInteger;
AStreamType := AnsiReader.ReadInteger;
// LocalLog('Server received Stream with FromCall='+AFromCall+' StreamType='+StreamTypeToText(AStreamType)+' GroupID='+IntToStr(AGroupID));
if AStreamType = StreamType_Login then
begin
if ADTBClient = nil then exit;
if ADTBClient.AccessLevel > 0 then exit; // Client was already logged in.
SendStream := TMemoryStream.Create;
AnsiWriter := TAnsiwriter.Create(SendStream,1024);
try // finally
ProcessLogin(ADTBClient,AStream);
// ADTBClient.IP := AContext.Binding.PeerIP;
try
AnsiWriter.WriteListBegin;
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(ADTBClient.Callsign); // DestStation
AnsiWriter.WriteInteger(ADTBClient.GroupID);
AnsiWriter.WriteString('');
AnsiWriter.WriteInteger(MultiStreamNone); //MultiStreamInitial
AnsiWriter.WriteInteger(StreamType_Con
nectStatus);
if ADTBClient.AccessLevel = ulInvalidLogin then
begin
AnsiWriter.WriteInteger(IS_REFUSED);
AnsiWriter.WriteString('Login Failed');
AnsiWriter.WriteInteger(ulNotLoggedIn);
end else
if ADTBClient.AccessLevel = ulInvalidVersionHigh then
begin
AnsiWriter.WriteInteger(IS_REFUSED);
AnsiWriter.WriteString('SARTrack Version to high: *Server* needs updating!');
AnsiWriter.WriteInteger(ulInvalidVersionHigh);
end else
if ADTBClient.AccessLevel = ulInvalidVersionLow then
begin
AnsiWriter.WriteInteger(IS_REFUSED);
AnsiWriter.WriteString('SARTrack Version to low: SARTrack needs updating! MinVersion='+IntToStr(SARSettings.AcceptedLowestClientVersion));
AnsiWriter.WriteInteger(ulInvalidVersionLow);
end else
if ADTBClient.AccessLevel = ulInvalidCallsign then
begin
AnsiWriter.WriteInteger(IS_REFUSED);
AnsiWriter.WriteString('Invalid Callsign: Same as Server!');
AnsiWriter.WriteInteger(ulInvalidCallsign);
end else
if ADTBClient.AccessLevel <= ulNotLoggedIn then
begin
AnsiWriter.WriteInteger(IS_REFUSED);
AnsiWriter.WriteString('Login Error');
AnsiWriter.WriteInteger(ADTBClient.AccessLevel);
end else
begin
AnsiWriter.WriteInteger(IS_CONNECTED);
AnsiWriter.WriteString('Login OK');
AnsiWriter.WriteInteger(ADTBClient.AccessLevel);
end;
GetSystemTime(CurrentTime);
CurrentTimeStamp := MakeTimeStamp;
AnsiWriter.Write(CurrentTime,sizeof(TSystemTime));
AnsiWriter.WriteInteger(CurrentTimeStamp);
AnsiWriter.WriteString(SARSettings.DTBServerCallsign); // The callsign of the SERVER
AnsiWriter.WriteInteger(StreamType_ConnectStatusFooter);
if ADTBClient.AccessLevel > ulNotLoggedIn then
begin
AGlobalSetting := GlobalSettings.GetGlobalSetting(ADTBClient.GroupID);
if AGlobalSetting = nil then
begin
AGlobalSetting := TGlobalSetting.Create;
AGlobalSetting.Defaults;
AGlobalSetting.GroupID := ADTBClient.GroupID;
GlobalSettings.AddGlobalSetting(AGlobalSetting);
GlobalSettings.HasChanged := true;
DTBMakeGroupDirectories(AGlobalSetting); // Only if they not already exist
ADTBClient.OpsName := AGlobalSetting.ActiveOpsName;
ADTBClient.IsActiveOps := true;
LocalLog('Server: GlobalSettings GroupID not found. Made one.',d_Warning);
end else
begin
AGlobalSetting.DTBCallsign := SARSettings.DTBServerCallsign;
if AGlobalSetting.MaxTrackParts <= 0 then
begin
AGlobalSetting.MaxTrackParts := 1000;
Log('IdTCPServer1Execute: Error: MaxTrackParts='+IntToStr(AGlobalSetting.MaxTrackParts),d_error);
end;
if AGlobalSetting.TrackWidth <= 0 then
begin
AGlobalSetting.TrackWidth := 4;
Log('IdTCPServer1Execute: Error: TrackWidth = 0!',d_error);
end;
ADTBClient.OpsName := AGlobalSetting.ActiveOpsName;
ADTBClient.IsActiveOps := true;
end;
// LocalLog('Server: Sending GlobalSetting: GroupID='+IntToStr(AGlobalSetting.GroupID)+ ' OpsName='+AGlobalSetting.ActiveOpsName);
AnsiWriter.WriteInteger(StreamType_GlobalSettings);
AnsiWriter.Writ
eBoolean(false); // InitialLoad;
AGlobalSetting.SaveStream(AnsiWriter); // Includes Footer
end;
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AContext.Connection.IOHandler.Write(SendStream,0,true);
if ADTBClient.AccessLevel <= ulNotLoggedIn then
begin
sleep(1000);
AContext.Connection.Disconnect;
New(TransferRecord);
TransferRecord^.UniData := ADTBClient.Callsign;
TransferRecord^.ThreadID := GetCurrentThreadID;
PostMessage(SARTrackForm.Handle, TH_DeleteClient, 0, LPARAM(TransferRecord));
// DTBClientList.Delete(DTBClientList.IndexOf(ADTBClient));
LocalLog('Login failed from Client '+ADTBClient.Callsign,TH_WARNINGMSG);
exit;
end else
begin
LocalLog('Login Success for Client '+ADTBClient.Callsign);
// The ConnectStatus is send at the begining of SendAllDatabases.
end;
except
on E:Exception do
begin
LocalLog('Execute: Writing Status: '+E.Message,TH_ERRORMSG);
exit;
end;
end;
finally
AnsiWriter.Free;
SendStream.Free;
end;
// The Client must now *REQUEST* which databases it requires. Active of a Historic one.
ADTBClient.Command := '';
AStream.Free;
exit;
end else // NOT a Login stream:
begin
inc(ADTBClient.RXPacketCount);
inc(ADTBClient.AverageCount);
ServerTransfer(AStream,ADTBClient); // Send the whole Stream to "ProcessIncomingData".
end;
finally
AnsiReader.Free;
end;
end; // Data in inout buffer.
except
on E:Exception do
begin
if assigned(ADTBClient) then
begin
inc(ADTBClient.ClientErrors);
LocalLog('IdTCPServer1Execute: Global catch(Incoming): Callsign='+ADTBClient.Callsign+' IP='+ADTBCLient.Binding.PeerIP+': '+E.Message,d_DTBError);
end else LocalLog('IdTCPServer1Execute: Global catch(Incoming): ADTBClient=nil: '+E.Message,d_error);
end;
end;
if ShutDownInProgress then exit;
try // This try is for Globalcatch 2
try
with ADTBClient do
begin
if DataStreams.Count > 0 then
begin
if AccessLevel = ulNotLoggedIn then
begin
LocalLog('Client not logged in; Skipped. Client='+ADTBClient.Callsign,TH_WARNINGMSG);
exit;
end;
// LocalLog('Server Execute: DataStreams.Count='+IntToStr(DataStreams.Count));
while DataStreams.Count > 0 do
begin
if not assigned(DataStreams[0]) then
begin
Inc(ADTBClient.ClientErrors);
LocalLog('Execute: DataStreams[0] is not assigned! '+ADTBClient.Callsign+' '+ADTBClient.Binding.PeerIP,d_DTBError);
try
DataStreams.Clear;
except
LocalLog('Execute: Trying to clear DataStreams after error. '+ADTBClient.Callsign+' '+ADTBClient.Binding.PeerIP,d_error);
end;
continue;
end;
if DataStreams[0].Size > 0 then
begin
// LocalLog('Execute: Sending to '+ADTBClient.Callsign+' Stream.Size='+ IntToStr(DataStreams[0].Size));
AContext.Connection.IOHandler.Write(DataStreams[0],0,true);
DataStreams.Delete(0);
inc(ADTBClient.TXPacketCount);
inc(ADTBClient.AverageCount);
end else
begin
LocalLog('Execute: Stream is empty! Client='+ADTBClient.Callsign+' '+ADTBClient.Binding.PeerIP,d_DTBerror);
inc(ADTBClient.ClientErrors);
DataStreams.Delete(0);
end;
end;
end else sleep(1); // Only if nothing was done
end;
except
on E:Exception do
begin
inc(ADTBClient.ClientErrors);
LocalLog('Execute: Writing: '+E.Message,TH_ERRORMSG);
LocalLog('Execute: Client='+ADTBClient.Callsign,TH_ERRORMSG);
try
ADTBClient.DataStreams.Clear;
except
// Make sure we do not end up with an Application error.
end;
end;
end;
except
on E:Exception do
begin
if assigned(ADTBClient) then
begin
inc(ADTBClient.ClientErrors);
if ADTBClient.DataStreams.Count > 0 then ADTBClient.DataStreams.Delete(0);
LocalLog('IdTCPServer1Execute: Global catch(Outgoing): Callsign='+ADTBClient.Callsign+' IP='+ADTBCLient.Binding.PeerIP+': '+E.Message,d_DTBError);
end else LocalLog('IdTCPServer1Execute: Global catch(1): ADTBClient=nil: '+E.Message,d_error);
end;
end;
end;
// THREAD!
class procedure TDTBEventHandlers.IdTCPServer1ListenException(AThread: TIdListenerThread;
AException: Exception);
begin
LocalLog('DTB Server ListenException: '+AException.Message,TH_ERRORMSG);
end;
// THREAD!
class procedure TDTBEventHandlers.IdTCPServer1Status(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
begin
LocalLog('DTB Server: Status: '+AStatusText);
end;
// Add to SERVER TX buffer for transmission.
// Next step is in IdTCPServer1Execute.
procedure ServerToAllClients(AStream: TMemoryStream; AFromCall, ADestCall: string; AGroupID:integer; AOpsname:string);
var
i: integer;
LockList: TList;
begin
if ShutDownInProgress then exit;
// Log('ServerToAllClients: Fromcall='+AFromCall+' GroupID='+IntToStr(AGroupID)+' OpsName='+AOpsName+' DestCall="'+ADestCall+'" Stream.Size='+IntToStr(AStream.Size),d_4);
if not assigned(AStream) then
begin
Log('DTBServer: ServerToAllClients: AStream not assigned!',d_error);
exit;
end;
// Log('ServerToAllClients: FromCall='+AFromCall);
LockList := IdTCPServer1.Contexts.LockList;
try
try
for i := LockList.Count-1 downto 0 do // The connected Clients
begin
try
if not SafetyCheck(TDTBContextClient(LockList[i])) then
begin
try
TDTBContextClient(LockList[i]).Connection.Disconnect; // This will also delete it from the DTBClientList!
except
on E:Exception do Log('After SafetyCheck, Disconnecting DTBCLient: '+E.Message,d_error);
end;
continue;
end;
if AFromCall <> '' then
begin
// Log('Checking: DTBClients[i].Callsign='+DTBClients[i].Callsign+' ACallsign='+AFromCall);
if TDTBContextClient(LockList[i]).Callsign = AFromCall then
begin
// Log('ServerToAllClients: Skipping (FromCall): '+DTBClients[i].Callsign+' = '+AFromCall,d_4);
continue;
end;
end;
if ADestCall <> '' then
begin
if TDTBContextClient(LockList[i]).Callsign <> ADestCall then
begin
Log('ServerToAllClients: Skipping (DestCall): '+TDTBContextClient(LockList[i]).Callsign+' <> '+ADestCall
+' Client Callsign='+TDTBContextClient(LockList[i]).Callsign,d_4);
continue;
end;
end;
if AGroupID <> 0 then
begin
if TDTBContextClient(LockList[i]).GroupID <> AGroupID then
begin
// if DTBClientList[i].GroupID <> 1 // Monitor
// then Log('ServerToAllClients: Skipping (GroupID): '+IntToStr(DTBClientList[i].GroupID)+' <> '+IntToStr(AGroupID)+' Client='+DTBClientList[i].Callsign,d_4);
continue;
end;
end;
if AOpsName <> '' then
begin
if TDTBContextClient(LockList[i]).OpsName <> AOpsName then
begin
Log('ServerToAllClients: Skipping (OpsName): '+TDTBContextClie
nt(LockList[i]).OpsName+' <> '+AOpsName
+' Client Callsign='+TDTBContextClient(LockList[i]).Callsign,d_4);
continue;
end;
end;
try
TDTBContextClient(LockList[i]).DataStreams.CopyStream(AStream);
except
on E:Exception do
begin
Log('ServerToAllClients: CopyStream: DTBClientList[i]='+TDTBContextClient(LockList[i]).Callsign+': '+E.Message,d_error);
continue;
end;
end;
except // This except for every loop
on E:Exception do
begin
inc(TDTBContextClient(LockList[i]).ClientErrors);
Log('ServerToAllClients: This Client: DTBClientList['+IntToStr(i)+'] Callsign='+TDTBContextClient(LockList[i]).Callsign
+' IP='+TDTBContextClient(LockList[i]).Binding.PeerIP+' '+E.Message,d_error);
try
TDTBContextClient(LockList[i]).Connection.Disconnect; // This will also delete it from the DTBClientList!
except
on E:Exception do Log('After Exception, Disconnecting DTBCLient: '+E.Message,d_error);
end;
continue;
end;
end;
end;
// Next step is IdTCPServer1Execute (Which loops very fast!)
except
on E:exception do
begin
Log('ServerToAllClients (Final): '+E.Message,d_error);
end;
end;
finally
IdTCPServer1.Contexts.UnlockList;
AStream.Free; // The original stream must now be freed.
end;
end;
// Add to SERVER TX buffer for transmission.
// Next step is in IdTCPServer1Execute.
procedure ServerToClient(AStream: TMemoryStream; ADestCall: string; AGroupID:integer; AOpsname:string);
var
AClient: TDTBContextClient;
begin
if ShutDownInProgress then exit;
if not assigned(AStream) then
begin
Log('DTBServer: ServerToClient: AStream not assigned!',d_DTBerror);
end;
Log('ServerToClient: DestCall='+ADestCall+' GroupID='+IntToStr(AGroupID)+' Opsname="'+AOpsName+'" Stream.Size='+IntToStr(AStream.Size),d_DTB);
try
try
AClient := GetContextClient(ADestCall);
if AClient = nil then
begin
Log('ServerToClient: Client not found!: '+ADestCall,d_DTBerror);
exit;
end;
AClient.DataStreams.CopyStream(AStream);
// Next step is IdTCPServer1Execute (which loops very fast)
except
on E:exception do
begin
Log('ServerToClient: '+E.Message,d_DTBerror);
end;
end;
finally
AStream.Free; // The original stream must now be freed.
end;
end;
//*************** STATIONS *****************************************************
procedure DTBTransmitAllStations(DTBCommand:TDTBCommand);
Var
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
AStationList: TStationList;
i : integer;
Found: boolean;
begin
if ShutdownInProgress then exit;
if DTBCommand.OpsName = '' then
begin
Log('DTBTransmitAllStations: OpsName missing!',d_error);
exit;
end;
AStationList := StationListList.GetStationList(DTBCommand.GroupID,DTBCommand.OpsName);
if AStationList = nil then
begin
Log('DTBTransmitAllStations: StationList not found: Making one.',d_DTB);
AStationList := StationListList.AddSTationList(DTBCommand.GroupId,DTBCommand.Opsname);
AStationList.LoadFromDisk;
end;
Found := false;
AStream := TMemoryStream.Create;
AnsiWriter:= TAnsiWriter.Create(AStream, 4096 );
try
try
AnsiWriter.WriteListBegin;
with DTBCommand do
begin
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(DestCallsign); // DestStation
AnsiWriter.WriteInteger(GroupID);
AnsiWriter.WriteString(OpsName);
AnsiWriter.WriteInteger(MultiStreamInitial);
end;
for i := 0 to AStationList.Count-1 do
begin
AStationList[i].MaxTrackParts := AStationList.MaxTrackParts;
if (DTBCommand.FromTime
Stamp = 0) then
begin
AnsiWriter.WriteInteger(StreamType_Station);
AnsiWriter.WriteBoolean(true); // InitialLoad (Full list)
AStationList[i].SaveStream(AnsiWriter,true);
Found := true;
end else
if (AStationList.DTBLastTimeStamp > DTBCommand.FromTimeStamp) then
begin
AnsiWriter.WriteInteger(StreamType_Station);
AnsiWriter.WriteBoolean(false); // InitialLoad (Client only needs update)
AStationList[i].SaveStream(AnsiWriter,true);
Found := true;
end;
end;
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AnsiWriter.Free;
if not Found then
begin
AStream.Free;
exit; // Do not send anything.
end;
with DTBCommand do
begin
ServerToAllClients(AStream,DTBCallsign,DestCallsign,GroupID,Opsname);
end;
except
on E:Exception do Log('DTBTransmitAllStations: '+E.Message,d_DTBerror);
end;
finally
end;
end;
//***************** OBJECTS ****************************************************
procedure DTBTransmitAllObjects(DTBCommand:TDTBCommand; AlsoTracks:boolean);
Var
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
i : integer;
Found: boolean;
AMarkerList: TMarkerList;
begin
if ShutdownInProgress then exit;
if DTBCommand.OpsName = '' then
begin
Log('DTBTransmitAllObjects: OpsName missing!',d_Error);
exit;
end;
AMarkerList := MarkerListList.GetMarkerList(DTBCommand.GroupID,DTBCommand.OpsName);
if AMarkerList = nil then
begin
Log('DTBTransmitAllObjects: MarkerList not found, Making one.',d_DTB);
AMarkerList := MarkerListList.AddMarkerList(DTBCommand.GroupId,DTBCommand.Opsname);
AMarkerList.LoadFromDisk;
end;
Found := false;
AStream := TMemoryStream.Create;
AnsiWriter:= TAnsiWriter.Create(AStream, 4096 );
try
try
AnsiWriter.WriteListBegin;
with DTBCommand do
begin
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(DestCallsign); // DestStation
AnsiWriter.WriteInteger(GroupID);
AnsiWriter.WriteString(OpsName);
AnsiWriter.WriteInteger(MultiStreamInitial);
end;
for i := 0 to AMarkerList.Count-1 do
begin
AMarkerList[i].MaxTrackParts := AMarkerList.MaxTrackParts;
if (DTBCommand.FromTimeStamp = 0) then
begin
AnsiWriter.WriteInteger(StreamType_Object);
AnsiWriter.WriteBoolean(true); // InitialLoad (Full list)
AnsiWriter.WriteBoolean(true); // IncludeCoords
AMarkerList[i].SaveStream(AnsiWriter,AlsoTracks);
Found := true;
end else
if (AMarkerList.DTBLastTimeStamp > DTBCommand.FromTimeStamp) then
begin
AnsiWriter.WriteInteger(StreamType_Object);
AnsiWriter.WriteBoolean(false); // InitialLoad (Client only needs update)
AnsiWriter.WriteBoolean(true); // IncludeCoords
AMarkerList[i].SaveStream(AnsiWriter,AlsoTracks);
Found := true;
end;
end;
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AnsiWriter.Free;
if not Found then
begin
AStream.Free;
exit; // Do not send anything.
end;
with DTBCommand do
begin
ServerToAllClients(AStream,DTBCallsign,DestCallsign,GroupID,Opsname);
end;
except
on E:Exception do Log('DTBTransmitAllObjects: '+E.Message,d_DTBerror);
end;
finally
end;
end;
// ************ Database Users *************************************************
// Note: DTBUSers database is only kept on Server.
// Used to send Updates TO the Server, but also for Server to reply to a Request
// from a Client of a DTBUser.
procedure DTBTransmit(ADTBUser:TDTBUser;AGroupID:integer; DestCall:string);
Var
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
begin
if ShutdownInProgress then exit;
// Log('DTBTransmit...');
AStream := TMemoryStream.Create;
AnsiWriter:= TAnsiWriter.Create(AStream, 4096 );
try
try
AnsiWriter.WriteListBegin;
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(DestCall); // DestStation
AnsiWriter.WriteInteger(AGroupID);
AnsiWriter.WriteString('');
AnsiWriter.WriteInteger(MultiStreamNone);
AnsiWriter.WriteInteger(StreamType_DTBUsers);
AnsiWriter.WriteBoolean(false); // InitialLoad
ADTBUser.SaveStream(AnsiWriter,AGroupID);
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AnsiWriter.Free;
ServerToClient(AStream,DestCall,AGroupID,'');
except
on E:Exception do
begin
Log('DTBTransmit(DTBUser): '+E.Message,d_DTBerror);
raise;
end;
end;
finally
end;
end;
// Only SERVER sends this.
procedure DTBTransmitDTBUsers(DTBCommand:TDTBCommand);
var
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
i : integer;
ADTBUser: TDTBUser;
ADTBUserList: TDTBUserList;
begin
if ShutdownInProgress then exit;
ADTBUserList := DTBUserListList.GetDTBUserList(DTBCommand.GroupId);
if ADTBUserList = nil then
begin
Log('DTBTransmitDTBUsers: DTBUserList not found, Making one.',d_DTB);
ADTBUserList := DTBUserListList.AddDTBUserList(DTBCommand.GroupId);
ADTBUserList.LoadFromDisk;
end;
Log('DTBTransmitDTBUsers: Sending DTBUsers: '+IntToStr(ADTBUserList.Count));
AStream := TMemoryStream.Create;
AnsiWriter := TAnsiWriter.Create(AStream, 4096 );
try
try
AnsiWriter.WriteListBegin;
with DTBCommand do
begin
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(DestCallsign); // DestStation
AnsiWriter.WriteInteger(GroupID);
AnsiWriter.WriteString(OpsName);
AnsiWriter.WriteInteger(MultiStreamInitial);
end;
if DTBCommand.Keyword = 'all' then
begin
for i := 0 to ADTBUserList.Count-1 do
begin
if (SARSettings.DTBIsGlobalServer)
and (lowercase(ADTBUserList[i].LoginName) = 'supervisor') then continue; // Do NOT Send the Supervisor data
ADTBUserList[i].ConfirmationID := DTBCommand.ConfirmationID; // On every record...?
ADTBUserList[i].Status := ssFound;
AnsiWriter.WriteInteger(StreamType_DTBUsers);
AnsiWriter.WriteBoolean(true); // InitialLoad (Full list)
ADTBUserList[i].SaveStream(AnsiWriter,DTBCommand.GroupID);
end;
end else
begin
Log('DTBTransmitDTBUsers: Server Responding to DTBUser request for '+DTBCommand.Keyword,d_DTB);
ADTBUser := ADTBUserList.GetUser(DTBCommand.Keyword);
if ADTBUser <> nil then
begin
with ADTBUser do
Log('DTBTransmitDTBUsers: Found DTBUser: '+LoginName+' GroupID='+IntToStr(DTBCommand.GroupID),d_DTB);
ADTBUser.Status := ssFound;
ADTBUser.ConfirmationID := DTBCommand.ConfirmationID;
AnsiWriter.WriteInteger(StreamType_DTBUsers);
AnsiWriter.WriteBoolean(true); // InitialLoad (Full list)
ADTBUser.SaveStream(AnsiWriter,DTBCommand.GroupID);
end else
begin
Log('DTBTransmitDTBUsers: DTBUser not found: '+DTBCommand.Keyword,d_DTB);
with DTBCommand do
DTBSendCommand(SARSettings.DTBServerCallsign,DTBCallsign,GroupID,
'','dtbusers','response',Keyword,ConfirmationID,0,'Not Found');
end;
end;
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AnsiWriter.Free;
with DTBCommand do
begin
ServerToClient(AStream,DTBCallsign,GroupID,Opsname); // Where DTBCallsign is the Client requesting the data
end;
except
on E:Exception do Log('DTBTransmitDTBUsers: '+E.Message,d_DTBerror);
end;
finally
end;
end;
// ------------- GLOBALSETTINGS -----------------------------------------
-------
procedure DTBTransmit(AGlobalSetting:TGlobalSetting);
Var
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
begin
if ShutdownInProgress then exit;
AStream := TMemoryStream.Create;
AnsiWriter:= TAnsiWriter.Create(AStream, 4096 );
try
try
AnsiWriter.WriteListBegin;
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(''); // DestStation (all)
AnsiWriter.WriteInteger(AGlobalSetting.GroupID);
AnsiWriter.WriteString('');
AnsiWriter.WriteInteger(MultiStreamNone);
AnsiWriter.WriteInteger(StreamType_GlobalSettings);
AnsiWriter.WriteBoolean(false); // InitialLoad
AGlobalSetting.SaveStream(AnsiWriter);
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AnsiWriter.Free;
ServerToAllClients(AStream,SARSettings.DTBServerCallsign,'',AGlobalSetting.GroupID,'');
except
on E:Exception do
begin
Log('DTBTransmit(GlobalSetting): '+E.Message,d_DTBerror);
raise;
end;
end;
finally
end;
end;
// Client request change of Operation name for itself (Historical data)
procedure ClientOpsChange(DTBCommand:TDTBCommand);
var
ADTBClient: TDTBContextClient;
AGlobalSetting: TGlobalSetting;
AFilename: string;
begin
ADTBClient := GetContextClient(DTBCommand.DTBCallsign);
if ADTBClient = nil then
begin
Log('ClientOpsChange: Client not found! '+ DTBCommand.DTBCallsign,D_DTBERROR);
exit;
end;
if DTBCommand.Keyword = 'active' then // Client request switch back to current Active Operation (which may have changed)
begin
AGlobalSetting := GlobalSettings.GetGlobalSetting(DTBCommand.GroupID);
if AGlobalSetting = nil then
begin
Log('ClientOpsChange: GlobalSetting not found! '+IntToStr(DTBCommand.GroupID),D_DTBERROR);
exit;
end;
DTBCommand.Keyword := AGlobalSetting.ActiveOpsName;
end;
if ADTBClient.OpsName = DTBCommand.Keyword then
begin
Log('ClientOpsChange: Client request change of OpsName but already on that Opsname',d_warning);
// But still do it.
end;
AFilename := DatabaseDir+IntToStr(DTBCommand.GroupID)+'\'+DTBCommand.OpsName+'.sarlog';
if not FileExists(AFilename) then
begin
Log('ClientOpsChange: Client request change of OpsName but there is no Operation with that name',d_DTBError);
with DTBCommand do
if ConfirmationID > 0 then
DTBSendCommand(SARSettings.DTBServerCallsign,DTBCallsign,GroupID,'','changeops','response',DTBCommand.Keyword,ConfirmationID,0,'Operation does not exist');
exit;
end;
ADTBClient.OpsName := DTBCommand.Keyword;
with DTBCommand do
if ConfirmationID > 0 then
DTBSendCommand(SARSettings.DTBServerCallsign,DTBCallsign,GroupID,'','changeops','response',DTBCommand.Keyword,ConfirmationID,0,'');
end;
procedure LoadOperations(AGroupID: integer; ActiveOpsName:string; AList:TStringList);
var
TmpList:TStringList;
i, APos : integer;
AName:string;
begin
if not assigned(AList) then exit;
AList.Clear;
TmpList := TStringList.Create;
try
FindFiles(TmpList,DatabaseDir+IntToStr(AGroupID),'\*.sarlog',false,false);
for i := 0 to TmpList.Count-1 do
begin
APos := system.Pos('.',TmpList[i]);
if APos > 0 then AName := copy(TmpList[i],1,APos-1);
if lowercase(AName) <> lowercase(ActiveOpsName) then AList.Add(AName);
end;
Log('LoadOperations: Loaded: '+IntToStr(AList.Count));
{for i := 0 to OperationsList.Count-1 do
begin
Log(OperationsList[i]);
end;}
finally
TmpList.Free;
end;
end;
//Client requests a list of available historical Operation names.
procedure OpsListRequest(DTBCommand:TDTBCommand);
var
ADTBClient: TDTBContextClient;
AGlobalSetting: TGlobalSetting;
ActiveOpsName: string;
AList: TStringList;
begin
ADTBClient := GetContextClient(DTBCommand.DTBCallsign);
if ADTBClient = nil then
begin
Log('ClientOpsChange: Client not found! '+ DTBCommand.DTBCallsign
,D_DTBERROR);
exit;
end;
AList := TStringList.Create;
AGlobalSetting := GlobalSettings.GetGlobalSetting(DTBCommand.GroupID);
if AGlobalSetting = nil then
begin
Log('ClientOpsChange: GlobalSetting not found! '+IntToStr(DTBCommand.GroupID),D_DTBERROR);
with DTBCommand do
DTBSendCommand(SARSettings.DTBServerCallsign,DTBCallsign,GroupID,'','opslist','response','NoKey',ConfirmationID,0,AList.Text);
exit;
end;
ActiveOpsName := AGlobalSetting.ActiveOpsName;
try
LoadOperations(DTBCommand.GroupID, ActiveOpsName, AList);
Log('OpsListRequest: Sending: '+AList.Text);
with DTBCommand do
DTBSendCommand(SARSettings.DTBServerCallsign,DTBCallsign,GroupID,'','opslist','response','NoKey',ConfirmationID,0,AList.Text);
finally
AList.Free;
end;
end;
// ----------- PEOPLE ----------------------------------------------------------
procedure DTBTransmit(APeople:TPeople; ADestCall:string;AgroupId:integer; InitialLoad:boolean);
Var
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
begin
if ShutdownInProgress then exit;
// if not InitialLoad then Log('DTBTransmit(AStation): '+AStation.Callsign);
AStream := TMemoryStream.Create;
AnsiWriter:= TAnsiWriter.Create(AStream, 4096 );
try
try
AnsiWriter.WriteListBegin;
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(ADestCall); // DestStation
AnsiWriter.WriteInteger(AGroupID);
AnsiWriter.WriteString('');
AnsiWriter.WriteInteger(MultiStreamNone);
AnsiWriter.WriteInteger(StreamType_People);
AnsiWriter.WriteBoolean(InitialLoad);
APeople.SaveStream(AnsiWriter);
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AnsiWriter.Free;
// if not DTBInitialLoad then Log('DTBTransmitStationToServer: Stream.Size='+IntToStr(AStream.Size));
if ADestCall = ''
then ServerToAllClients(AStream,SARSettings.DTBServerCallsign, ADestCall,AGroupID,'')
else ServerToClient(AStream,ADestCall,AGroupID,'');
except
on E:Exception do Log('DTBTransmit(Station): '+E.Message,d_DTBerror);
end;
finally
end;
end;
procedure DTBTransmitPeopleStatus(APeople: TPeople; ADestCall: string; AGroupID: integer);
Var
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
begin
if ShutDownInProgress then exit;
AStream := TMemoryStream.Create;
AnsiWriter := TAnsiWriter.Create(AStream, 4096);
try
AnsiWriter.WriteListBegin;
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(ADestCall); // DestStation
AnsiWriter.WriteInteger(AGroupID);
AnsiWriter.WriteString('');
AnsiWriter.WriteInteger(MultiStreamNone);
AnsiWriter.WriteInteger(StreamType_PeopleStatus);
APeople.SaveStatusStream(AnsiWriter);
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AnsiWriter.Free;
if ADestCall = ''
then ServerToAllClients(AStream,SARSettings.DTBServerCallsign, ADestCall,AGroupID,'')
else ServerToClient(AStream,ADestCall,AGroupID,'');
except
on E: Exception do
Log('DTBTransmitPeopleStatus: ' + E.Message, d_DTBerror);
end;
end;
procedure DTBTransmitALLPeopleStatus(APeopleList: TPeopleList; ADestCall: string; AGroupID: integer);
Var
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
i: integer;
const
AVersion = 1; // <<< This must be changed at two locations
begin
if ShutDownInProgress then exit;
AStream := TMemoryStream.Create;
AnsiWriter := TAnsiWriter.Create(AStream, 4096);
try
AnsiWriter.WriteListBegin;
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(ADestCall); // DestStation
AnsiWriter.WriteInteger(AGroupID);
AnsiWriter.WriteString('');
AnsiWriter.WriteInteger(MultiStreamNone);
for i := 0 to APeopleList.Count-1 do
with APeopleList[i] do
begin
AnsiWriter.WriteInteger(StreamType_PeopleStatus);
AnsiWriter.WriteString(MemberID);
AnsiWriter.WriteInteger(AVersion);
AnsiWriter.WriteInteger(ConfirmationID);
AnsiWriter.WriteInteger(Status);
AnsiWriter.WriteInteger(OrgStatus);
AnsiWriter.WriteString(TeamName);
AnsiWriter.WriteInteger(TeamID);
AnsiWriter.WriteString(SpareStr1);
AnsiWriter.WriteString(SpareStr2);
AnsiWriter.WriteString(SpareStr3);
AnsiWriter.WriteInteger(SpareInt1);
AnsiWriter.WriteInteger(SpareInt2);
AnsiWriter.WriteInteger(SpareInt3);
AnsiWriter.WriteFloat(SpareDouble1);
AnsiWriter.WriteFloat(SpareDouble2);
AnsiWriter.WriteInteger(StreamType_PeopleStatusFooter);
end;
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AnsiWriter.Free;
if ADestCall = ''
then ServerToAllClients(AStream,SARSettings.DTBServerCallsign, ADestCall,AGroupID,'')
else ServerToClient(AStream,ADestCall,AGroupID,'');
Log('DTBTransmitALLPeopleStatus: Stream.Size='+IntToStr(AStream.Size));
except
on E: Exception do
Log('DTBTransmitALLPeopleStatus: ' + E.Message, d_DTBerror);
end;
end;
function FindCapabilities(APeople:TPeople;AKeyword:string):boolean;
var i: integer;
begin
// Log('FindCapabilities for '+APeople.MemberID+' Capability.Count='+IntToStr(APeople.CapabilityList.Count));
AKeyword := lowercase(Akeyword);
with APeople do
begin
for i := 0 to CapabilityList.Count-1 do
begin
// Log('Searching: '+CapabilityList[i].Description);
if pos(AKeyword,lowercase(CapabilityList[i].Description)) > 0 then
begin
result := true;
exit;
end;
end;
end;
result := false;
end;
procedure DTBTransmitPeople(DTBCommand:TDTBCommand);
var
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
i : integer;
Found: integer;
ADTBMultiStream: integer;
APeopleList: TPeopleList;
begin
// if HistoricData then exit;
if ShutdownInProgress then exit;
APeopleList := PeopleListList.GetPeopleList(DTBCommand.GroupID);
if APeopleList = nil then
begin
Log('DTBAddPeople: PeopleList not found, Making one.',d_DTB);
APeopleList := PeopleListList.AddPeopleList(DTBCommand.GroupID);
APeopleList.LoadFromDisk;
end;
Found := 0;
if DTBCommand.Keyword = 'all' then ADTBMultiStream := MultiStreamInitial else ADTBMultiStream := MultiStreamNone;
AStream := TMemoryStream.Create;
AnsiWriter := TAnsiWriter.Create(AStream, 4096 );
try
try
AnsiWriter.WriteListBegin;
with DTBCommand do
begin
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(DestCallsign); // DestStation
AnsiWriter.WriteInteger(GroupID);
AnsiWriter.WriteString(OpsName);
AnsiWriter.WriteInteger(ADTBMultiStream);
end;
for i := 0 to APeopleList.Count-1 do
begin
if (DTBCommand.FromTimeStamp = 0) then
begin
if DTBCommand.Keyword = 'all' then
begin
APeopleList[i].ConfirmationID := DTBCommand.ConfirmationID;
AnsiWriter.WriteInteger(StreamType_People);
AnsiWriter.WriteBoolean(true); // InitialLoad (Full list)
APeopleList[i].SaveStream(AnsiWriter);
inc(Found);
end else // It has a Key: MemberID or LastName.
begin
DTBCommand.Keyword := lowercase(DTBCommand.Keyword);
// Log('DTBTransmitAllPeople: Looking for Key: '+DTBCommand.Keyword+' in '+lowercase(PeopleList[i].MemberID));
if DTBCommand.Database = 'people' then // Look for memberID and Surname
begin
if (lowercase(APeopleList[i].MemberID) = DTBCommand.Keyword)
or (lowercase(APeopleList[i].Surname) = DTBCommand.Keyword) then
begin
Log('DTBTransmitAllPeople: Keyword Found: '+APeopleList[i].Surname);
APeopleList[i].ConfirmationID := DTBCommand.ConfirmationID;
AnsiWriter.WriteInteger(StreamType_People);
AnsiWriter.WriteBoolean(false);
APeopleList[i].SaveStream(AnsiWriter);
inc(Found);
end;
end else
if DTBCommand.Database = 'peoplecaps' then // Look for Capabilities and Surname
begin
if (lowercase(APeopleList[i].Surname) = DTBCommand.Keyword)
or (FindCapabilities(APeopleList[i],DTBCommand.keyword)) then
begin
Log('DTBTransmitAllPeople: Keyword Found: '+APeopleList[i].Surname);
APeopleList[i].ConfirmationID := DTBCommand.ConfirmationID;
AnsiWriter.WriteInteger(StreamType_People);
AnsiWriter.WriteBoolean(false);
APeopleList[i].SaveStream(AnsiWriter);
inc(Found);
end;
end else
end;
end;
end;
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AnsiWriter.Free;
if Found = 0 then
begin
Log('DTBTransmitAllPeople: Requested Key not found: '+DTBCommand.Keyword
+' FromTimestamp='+IntToStr(DTBCommand.FromTimeStamp),d_DTB);
AStream.Free;
end else
begin
Log('DTBTransmitAllPeople: Requested Key found: '+DTBCommand.Keyword+' Found='+IntToStr(Found),d_DTB);
with DTBCommand do
begin
if DestCallsign = ''
then ServerToAllClients(AStream,DTBCallsign,DestCallsign,GroupID,Opsname)
else ServerToClient(AStream,DTBCallsign,GroupID,Opsname); // Where DTBCallsign is the Client requesting the data
end;
end;
// Send final confirmation that the MultiStreamInitial is finished:
with DTBCommand do
DTBSendCommand(SARSettings.DTBServerCallsign,DTBCallsign,GroupID,'','people','response',DTBCommand.Keyword,ConfirmationID,0,'');
except
on E:Exception do Log('DTBTransmitAllPeople: '+E.Message,d_DTBerror);
end;
finally
end;
end;
// -------- EQUIPMENT ----------------------------------------------------------
// Note: DTBUSers database is only kept on Server.
// Used to send Updates TO the Server, but also for Server to reply to a Request
// from a Client of a DTBUser.
procedure DTBTransmit(AEquipment:TEquipment;AGroupID:integer;DestCall:string);
Var
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
begin
if ShutdownInProgress then exit;
// Log('DTBTransmit...');
AStream := TMemoryStream.Create;
AnsiWriter:= TAnsiWriter.Create(AStream, 4096 );
try
try
AnsiWriter.WriteListBegin;
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(DestCall); // DestStation
AnsiWriter.WriteInteger(AGroupID);
AnsiWriter.WriteString('');
AnsiWriter.WriteInteger(MultiStreamNone);
AnsiWriter.WriteInteger(StreamType_Equipment);
AnsiWriter.WriteBoolean(false); // InitialLoad
AEquipment.SaveStream(AnsiWriter);
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AnsiWriter.Free;
ServerToClient(AStream,DestCall,AGroupID,'');
except
on E:Exception do
begin
Log('DTBTransmit(AEquipment): '+E.Message,d_DTBerror);
raise;
end;
end;
finally
end;
end;
procedure DTBTransmitAllEquipment(DTBCommand:TDTBCommand);
Var
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
i : integer;
AEquipmentList: TEquipmentList;
begin
if ShutdownInProgress then exit;
AEquipmentList := EquipmentListList.GetEquipmentList(DTBCommand.GroupId);
if AEquipmentList = nil then
begin
Log('DTBTransmitAllEquipment: EquipmentList not found, Making one.',d_DTB);
AEquipmentList := EquipmentListList.AddEquipmentList(DTBCommand.GroupId);
AEquipmentList.LoadFromDisk;
end;
if AEquipmentList.Count = 0 then // Transmit a confirmation because the list is empty.
with DTBCOmmand do
begin
DTBSendCommand(SARSettings.DTBServerCallsign,DTBCallsign,GroupID,'','equipment','re
sponse','NoKey',ConfirmationID,0,'');
exit;
end;
Log('DTBTransmitAllEquipment: Transmitting entries: '+IntToStr(AEquipmentList.Count));
AStream := TMemoryStream.Create;
AnsiWriter:= TAnsiWriter.Create(AStream, 4096 );
try
try
AnsiWriter.WriteListBegin;
with DTBCommand do
begin
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(DestCallsign); // DestStation
AnsiWriter.WriteInteger(GroupID);
AnsiWriter.WriteString(OpsName);
AnsiWriter.WriteInteger(MultiStreamNone);
end;
for i := 0 to AEquipmentList.Count-1 do
begin
AnsiWriter.WriteInteger(StreamType_Equipment);
AnsiWriter.WriteBoolean(true); // InitialLoad
AEquipmentList[i].SaveStream(AnsiWriter);
end;
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AnsiWriter.Free;
with DTBCommand do
begin
ServerToClient(AStream,DTBCallsign,GroupID,'');
end;
// Send final confirmation that the MultiStreamInitial is finished:
with DTBCommand do
DTBSendCommand(SARSettings.DTBServerCallsign,DTBCallsign,GroupID,'','equipment','response','NoKey',ConfirmationID,0,'');
except
on E:Exception do Log('DTBTransmitAllEquipment: '+E.Message,d_DTBerror);
end;
finally
end;
end;
// One entry, transmitted to ALL stations (only because it is so small) so they can all Update if they use it.
// This is the STRINGLIST
(*
procedure DTBAddEquipmentName(AName:string;AConfirmationID:integer);
Var
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
begin
if HistoricData then exit;
if ShutdownInProgress then exit;
AStream := TMemoryStream.Create;
AnsiWriter:= TAnsiWriter.Create(AStream, 4096 );
try
try
AnsiWriter.WriteListBegin;
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(''); // DestStation
AnsiWriter.WriteInteger(SARSettings.GroupID);
AnsiWriter.WriteString(SARSettings.OperationsName);
AnsiWriter.WriteBoolean(false); // InitialLoad
AnsiWriter.WriteInteger(StreamType_EquipmentName);
AnsiWriter.WriteInteger(SARSettings.GroupID);
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteInteger(AConfirmationID);
AnsiWriter.WriteInteger(1);
AnsiWriter.WriteString(AName);
AnsiWriter.WriteInteger(StreamType_EquipmentNameFooter);
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AnsiWriter.Free;
// if ADestCall = '' then
ServerToAllClients(AStream,SARSettings.DTBServerCallsign,'',SARSettings.GroupID,SARSettings.OperationsName)
// else ServerToClient(AStream,ADestCall,SARSettings.GroupID,SARSettings.OperationsName);
except
on E:Exception do Log('DTBTransmitEquipmentName: '+E.Message,d_DTBerror);
end;
finally
end;
end;
*)
// Full list. Clients only send one entry at the time.
procedure DTBTransmitEquipmentNameList(DTBCommand:TDTBCommand);
Var
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
i : integer;
AEquipmentNameList: TEquipmentNameList;
begin
if ShutdownInProgress then exit;
AEquipmentNameList := EquipmentNameListList.GetEquipmentNameList(DTBCommand.GroupID);
if AEquipmentNameList = nil then
begin
Log('DTBTransmitEquipmentNameList: AEquipmentNameList not found, Making one.',d_DTB);
AEquipmentNameList := EquipmentNameListList.AddEquipmentNameList(DTBCommand.GroupId);
AEquipmentNameList.LoadFromDisk;
end;
AStream := TMemoryStream.Create;
AnsiWriter:= TAnsiWriter.Create(AStream, 4096 );
try
try
AnsiWriter.WriteListBegin;
with DTBCommand do
begin
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(DestCallsign); // DestStation
AnsiWriter.WriteInteger(GroupID);
AnsiWriter.WriteString(OpsName);
AnsiWriter.WriteInteger(MultiStreamNone);
AnsiWriter.WriteInteger(StreamType_EquipmentName);
AnsiWriter.WriteInteger(ConfirmationID);
end;
AnsiWriter.WriteInteger(AEquipmentNameList.Count);
for i := 0 to AEquipmentNameList.Count-1 do
begin
AnsiWriter.WriteString(AEquipmentNameList[i]);
end;
AnsiWriter.WriteInteger(StreamType_EquipmentNameFooter);
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AnsiWriter.Free;
ServerToClient(AStream,DTBCommand.DTBCallsign,DTBCommand.GroupID,'');
// Send final confirmation that the InitialLoad is finished:
with DTBCommand do
DTBSendCommand(SARSettings.DTBServerCallsign,DTBCallsign,GroupID,'','equipmentnamelist','response','NoKey',ConfirmationID,0,'');
except
on E:Exception do Log('DTBTransmitEquipmentNameList: '+E.Message,d_DTBerror);
end;
finally
end;
end;
//---------- BINARIES ----------------------------------------------------------
// The CLIENT will transmit this to the Server after adding a Binary file
procedure DTBTransmit(BinStream:TMemoryStream; AGroupId: integer; AFilename: string; ADestCall:string; AConfirmationID:integer);
var
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
ImageSize : integer;
const
AVersion = 1;
begin
if ShutdownInProgress then exit;
AStream := TMemoryStream.Create;
AnsiWriter := TAnsiWriter.Create(AStream, 4096 );
try
try
AnsiWriter.WriteListBegin;
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(ADestCall);
AnsiWriter.WriteInteger(AGroupID);
AnsiWriter.WriteString(''); // Opsname
AnsiWriter.WriteInteger(MultiStreamNone);
AnsiWriter.WriteInteger(StreamType_Binary);
AnsiWriter.WriteInteger(AConfirmationID);
AnsiWriter.WriteInteger(AVersion);
ImageSize := BinStream.size;
AnsiWriter.WriteInteger(ImageSize);
AnsiWriter.WriteString(AFilename);
if ImageSize > 0 then
begin
AnsiWriter.FlushBuffer;
// Log('DTBTransmit(BinStream): Adding Image to stream: Size='+IntToStr(ImageSize)+' Stream.position='+IntToStr(AStream.Position));
AStream.CopyFrom(BinStream,0);
// Log(' NEW Stream.position='+IntToStr(AStream.Position));
end else Log('DTBTransmit(BinStream): ImageSize = 0!',d_error);
AnsiWriter.WriteInteger(StreamType_BinaryFooter);
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AnsiWriter.Free;
// Log('DTBTransmit(BinStream): Transmitting Binary, Filename='+AFileName);
ServerToClient(AStream,ADestCall,AGroupID,'');
except
on E:Exception do
begin
Log('DTBTransmit(BinStream): '+E.Message,d_DTBerror);
end;
end;
finally
try
if assigned(BinStream) then BinStream.Free;
// NO! AStream.Free; is done in the Thread.
except
on E:Exception Do Log('DTBTransmit(BinStream): Freeing: '+E.Message,d_DTBerror);
end;
end;
end;
procedure DTBTransmitPeoplePhoto(DTBCommand:TDTBCommand);
var
BinStream: TMemoryStream;
AFilename, APath: string;
NewDTBCommand: TDTBCommand;
const
AVersion = 1;
begin
if ShutdownInProgress then exit;
AFilename := '';
Log('DTBTransmitPeoplePhoto: Looking for MemberPhoto for: '+DTBCommand.Keyword);
try
try
AFilename := 'People_'+DTBCommand.Keyword+'.jpg';
APath := DatabaseDir+IntToStr(DTBCommand.GroupID)+'\Binaries\';
if NOT FileExists(APath+AFilename) then
begin
AFilename := 'People_'+DTBCommand.Keyword+'.png';
if NOT FileExists(APath+AFilename) then
begin
Log('DTBTransmitPeoplePhoto: Photo not found on disk: '+APath+AFilename,d_DTBWarning);
AFilename := '';
exit;
end;
end;
except
on E:Exception Do
begin
Log('DTBTransmitPeoplePhoto: File: '+E.Message,d_DTBerror);
AFilename := '';
exit;
end;
end;
BinStream := TMe
moryStream.Create;
try
BinStream.LoadFromFile(APath+AFilename);
Log('BinStream.LoadFromFile OK: AFilename='+AFilename);
DTBTransmit(BinStream,DTBCommand.GroupId, AFilename, DTBCommand.DTBCallsign, DTBCommand.ConfirmationID);
except
on E:Exception Do
begin
Log('DTBTransmitPeoplePhoto: Load File: '+E.Message,d_DTBerror);
FreeAndNil(BinStream);
AFilename := '';
exit;
end;
end;
finally
try
if AFilename = '' then // ONLY when we did not find the photo. Client must be notified.
begin
Log('DTBTransmitPeoplePhoto: Sending DTBCommand, Photo not found');
NewDTBCommand.DTBCallsign := SARSettings.DTBServerCallsign;
NewDTBCommand.DestCallsign := DTBCommand.DTBCallsign;
NewDTBCommand.GroupID := DTBCommand.GroupID;
NewDTBCommand.OpsName := DTBCommand.OpsName;
NewDTBCommand.Database := DTBCommand.Database;
NewDTBCommand.Command := 'response';
NewDTBCommand.Keyword := DTBCommand.Keyword;
NewDTBCommand.ReplyStr := ''; // If empty, the file was not found.
NewDTBCommand.ConfirmationID := DTBCommand.ConfirmationID;
DTBSendCommand(NewDTBCommand);
end;
// NO! AStream.Free; is done in the Thread.
except
on E:Exception Do Log('DTBTransmitAllPeople: Freeing: '+E.Message,d_DTBerror);
end;
end;
end;
// -------- CAPABILITIES AND CAPABILITYLIST ------------------------------------
procedure DTBTransmitCapabilityList(DTBCommand:TDTBCommand);
Var
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
i : integer;
ACapabilityNameList: TCapabilityNameList;
begin
if ShutdownInProgress then exit;
ACapabilityNameList := CapabilityNameListList.GetCapabilityNameList(DTBCommand.GroupID);
if ACapabilityNameList = nil then
begin
Log('DTBTransmitCapabilityList: CapabilityNameList not found, Making one.',d_DTB);
ACapabilityNameList := CapabilityNameListList.AddCapabilityNameList(DTBCommand.GroupID);
ACapabilityNameList.LoadFromDisk;
end;
AStream := TMemoryStream.Create;
AnsiWriter:= TAnsiWriter.Create(AStream, 4096 );
try
try
AnsiWriter.WriteListBegin;
with DTBCommand do
begin
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(DestCallsign); // DestStation
AnsiWriter.WriteInteger(GroupID);
AnsiWriter.WriteString(OpsName);
AnsiWriter.WriteInteger(MultiStreamNone);
AnsiWriter.WriteInteger(StreamType_CapabilityList);
AnsiWriter.WriteInteger(ConfirmationID);
end;
AnsiWriter.WriteInteger(ACapabilityNameList.Count);
for i := 0 to ACapabilityNameList.Count-1 do
begin
AnsiWriter.WriteString(ACapabilityNameList[i]);
end;
AnsiWriter.WriteInteger(StreamType_CapabilityListFooter);
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AnsiWriter.Free;
with DTBCommand do
begin
if DestCallsign = ''
then ServerToAllClients(AStream,DTBCallsign,DestCallsign,GroupID,Opsname)
else ServerToClient(AStream,DTBCallsign,GroupID,Opsname); // Where DTBCallsign is the Client requesting the data
end;
// Send final confirmation that the InitialLoad is finished:
with DTBCommand do
DTBSendCommand(SARSettings.DTBServerCallsign,DTBCallsign,GroupID,'','capabilitynamelist','response','NoKey',ConfirmationID,0,'');
except
on E:Exception do Log('DTBTransmitCapabilityList: '+E.Message,d_DTBerror);
end;
finally
end;
end;
procedure DatabaseMessage(DTBCommand:TDTBCommand);
begin
DTBCommand.DestCallsign := ''; // All Clients
if DTBCommand.Keyword = 'all' then // This Message goes to ALL Clients, regardless of GroupID.
begin
DTBCommand.GroupID := 0;
end; // Else leave as received.
DTBSendCommand(DTBCommand);
end;
procedure DTBProcessCommand(var DTBCommand: TDTBCommand);
var
NewDTBComman
d: TDTBCommand;
SendConfirmation: boolean;
// AClientCall: string; // Any Clients which require an Update of a database
i: integer;
ADTBClient: TDTBContextClient;
LockList: TList;
begin
SendConfirmation := true;
LockList := IdTCPServer1.Contexts.LockList;
try
with DTBCommand do
begin
if (Command = '')
or (Database = '')
or (Keyword = '')
or (GroupID <= 0) then
begin
Log('DTBProcessCommand: Bad command received: From='+DTBCallsign+' GroupID='
+IntToStr(GroupID)+' Command='+Command+' Database='+Database+' keyword= '+Keyword,d_DTBerror);
exit;
end;
if Command <> 'response' then // Reduce overload due to logging
begin
Log('DTBProcessCommand: Command received from '+DTBCallsign+' DestStation='+DestCallsign
+' GroupID='+IntToStr(GroupID)+' OpsName="'+OpsName+'" Command='+Command+' for Database='+Database+' Keyword='+Keyword
+' ConfirmationID='+IntToStr(ConfirmationID),d_DTB);
end;
// Local Processing
//-------- DELETE --------------------------------------------------------
if Command = 'delete' then
begin
if Database = 'station' then
begin
if NOT DTBDeleteStation(DTBCommand) then Log('DTBProcessCommand: Station not found to delete: '+Keyword,d_DTBwarning);
end else
if (Database = 'object') or (Database = 'objects') then
begin
if NOT DTBDeleteMarker(DTBCommand) then Log('DTBProcessCommand: Object not found to delete: '+Keyword,d_DTBwarning);
end else
if Database = 'people' then
begin
if not DTBDeletePeople(DTbCommand) then Log('DTBProcessCommand: People not found to delete: '+Keyword,d_DTBwarning)
end else
if Database = 'dtbusers' then
begin
if NOT DTBDeleteDTBUser(DTBCommand) then Log('DTBProcessCommand: DTBUser not found to delete: '+Keyword,d_DTBwarning);
end else
if Database = 'equipment' then
begin
if not DTBDeleteEquipment(DTBCommand) then Log('DTBProcessCommand: Equipment not found to delete: '+Keyword,d_DTBWarning);
end else
if Database = 'equipmentname' then
begin
if not DTBDeleteEquipmentName(DTBCommand) then Log('DTBProcessCommand: EquipmentName not found to delete: '+Keyword,d_DTB);
end else
if Database = 'timeline' then
begin
if not DTBDeleteTimeLine(DTBCommand) then Log('DTBProcessCommand: TimeLine not found to delete: '+Keyword,d_DTB);
end else
begin
Log('DTBProcessCommand: Invalid destination for Delete: '+Database,d_DTBerror);
end;
end;
//----- SERVER REQUESTS ONLY ---------------------------------------------------
if Command = 'delete' then
begin
// Check if any Clients have asked to get Updates from this database.
for i := 0 to LockList.Count-1 do
begin
if TDTBContextClient(LockList[i]).WantsDatabase(Database,DTBCommand.DTBCallsign) then
begin
NewDTBCommand := CopyDTBCommand(DTBCommand);
NewDTBCommand.DestCallsign := TDTBContextClient(LockList[i]).Callsign;
NewDTBCommand.ConfirmationID := 0;
DTBSendCommand(NewDTBCommand); // Forward the original command to the Client who requested an Update.
end;
end;
end else
if Command = 'request' then
begin
if Database = 'all' then
begin
if Keyword = 'all' then
begin
Log('DTBProcessCommand: Server Responding to All Databases request',d_DTB);
SendAllDatabases(DTBCommand); // Server only
end;
end else
if Database = 'stations' then
begin
if Keyword = 'all' then
begin
Log('DTBProcessCommand: Server Responding to All Stations request',d_DTB);
DTBTransmitAllStations(DTBCommand); // Server only
end;
end else
if Database = 'objects' then
begin
Log('DTBProcessCommand: Server Responding to Objects req
uest',d_DTB);
DTBTransmitAllObjects(DTBCommand,true);
end else
if (Database = 'people') // This will automatically switch between 'all' and single user key.
or (Database = 'peoplecaps') then
begin
Log('DTBProcessCommand: Server Responding to People request',d_5);
DTBTransmitPeople(DTBCommand);
SendConfirmation := false; // This function sends its own confirmation.
end else
if Database = 'people-photo' then
begin
Log('DTBProcessCommand: Server Responding to People-Photo request',d_DTB);
DTBTransmitPeoplePhoto(DTBCommand);
SendConfirmation := false; // This function sends its own confirmation.
end else
if Database = 'capabilitynamelist' then
begin
Log('DTBProcessCommand: Server Responding to CapabilityNameList request',d_DTB);
DTBTransmitCapabilityList(DTBCommand);
end else
if Database = 'dtbusers' then
begin
Log('DTBProcessCommand: Server Responding to DTBUsers request',d_DTB);
DTBTransmitDTBUsers(DTBCommand); // Server only
end else
if Database = 'equipmentname' then // This is the STRINGLIST
begin
Log('DTBProcessCommand: Server Responding to EquipmentName request',d_DTB);
DTBTransmitEquipmentNameList(DTBCommand);
SendConfirmation := true; // The StringList cannot send its own ConfirmationID.
end else
if Database = 'equipment' then // This is the OBJECTLIST
begin
if Keyword = 'all' then
begin
Log('DTBProcessCommand: Server Responding to All Equipment request',d_DTB);
DTBTransmitAllEquipment(DTBCommand); // Server only
SendConfirmation := false; // ConfirmationID is in database.
end;
end else
if Database = 'opslist' then // A Client requests a list of Historical operation names.
begin
Log('DTBProcessCommand: Server Responding to Operation List Request from '+DTBCommand.DTBCallsign+' for Database '+Database,d_DTB);
OpsListRequest(DTBCommand);
SendConfirmation := false;
end else
begin
Log('DTBProcessCommand: Unknown Database! '+Database,d_DTBerror);
exit;
end;
end else
if Command = 'update' then // Clients request Updates of any changes in selected database.
begin
ADTBClient := GetContextClient(DTBCommand.DTBCallsign);
// Log('DTBProcessCommand: Server Responding to Update Request from '+DTBCommand.DTBCallsign+' for Database '+Database,d_DTB);
if ADTBClient <> nil then ADTBClient.AddDatabase(Database);
SendConfirmation := false; // Just accept this command.
end else
if Command = 'clearupdate' then // Clients request to be Cleared of Updates of any changes in selected database.
begin
// Log('DTBProcessCommand: Server Responding to ClearUpdate Request from '+DTBCommand.DTBCallsign+' for Database '+Database,d_DTB);
ADTBClient := GetContextClient(DTBCommand.DTBCallsign);
if ADTBClient <> nil then ADTBClient.RemoveDatabase(Database);
SendConfirmation := false; // Just accept this command.
end else
if Command = 'changeops' then // A Client requests to switch its own OpsName, to be able to receive Historical data only.
begin // This is NOT a Change ACTIVE Operation for the whole Group. Thats done in GlobalSetting change.
Log('DTBProcessCommand: Server Responding to Change Operation Request from '+DTBCommand.DTBCallsign+' for Database '+Database,d_DTB);
ClientOpsChange(DTBCommand);
SendConfirmation := false;
end else
if Command = 'databasemsg' then // A Client requests a broadcast of a Message to all other clients
begin
Log('DTBProcessCommand: Server Responding to Database Message from '+DTBCommand.DTBCallsign+' for Database '+Database,d_DTB);
DatabaseMessage(DTBCommand);
end else
if Command = 'shutdown' then
begin
if NOT CheckAccessLevel(ulSARTrack,DTBCommand.DTBCallsign) then exit;
ForceTerminate := true;
Application.Terminate;
end;
if SendConfirmation then // Some functions send their own confirmation.
begin
if DTBCommand.ConfirmationID = 0 then exit;
// NOW FINALLY SEND A CONFIRMATION PACKET TO TELL THE CLIENT WE ARE FINISHED
NewDTBCommand.DTBCallsign := SARSettings.DTBServerCallsign;
NewDTBCommand.DestCallsign := DTBCommand.DTBCallsign;
NewDTBCommand.GroupID := DTBCommand.GroupID;
NewDTBCommand.OpsName := DTBCommand.OpsName;
NewDTBCommand.Database := DTBCommand.Database;
NewDTBCommand.Command := 'response';
NewDTBCommand.Keyword := DTBCommand.Keyword;
NewDTBCommand.ConfirmationID := DTBCommand.ConfirmationID;
DTBSendCommand(NewDTBCommand);
end;
end;
finally
IdTCPServer1.Contexts.UnlockList;
end;
end;
function DTBSendCommand(DTBCommand:TDTBCommand):boolean;
const
AVersion = 1;
var
AStream: TMemoryStream;
AnsiWriter: TAnsiWriter;
begin
result := false;
if ShutdownInProgress then exit;
with DTBCommand do
if (Command = '')
or (Database = '')
or (Keyword = '')
or (GroupID < 0) then
begin
Log('DTBSendCommand: Bad command: From='+DTBCallsign+' GroupID='+IntToStr(GroupID)
+' Command='+Command+' Database='+Database+' keyword= '+Keyword,d_DTBerror);
exit;
end;
with DTBCommand do
Log('DTBSendCommand: Sending Command: FromCall='+DTBCallsign+' DestCall='+DestCallsign
+' GroupID='+IntToStr(GroupID)+' OpsName="'+OpsName+'" Command='+Command+' for Database='+Database+' keyword= '+Keyword
+' ConfirmationID='+IntToStr(ConfirmationID)+' ReplyStr='+ReplyStr,d_DTB);
AStream := TMemoryStream.Create;
AnsiWriter:= TAnsiWriter.Create(AStream, 4096 );
try
try
AnsiWriter.WriteListBegin;
AnsiWriter.WriteString(SARSettings.DTBServerCallsign);
AnsiWriter.WriteString(DTBCommand.DestCallsign); // DestStation
AnsiWriter.WriteInteger(DTBCommand.GroupID);
AnsiWriter.WriteString(DTBCommand.OpsName);
AnsiWriter.WriteInteger(MultiStreamNone);
AnsiWriter.WriteInteger(StreamType_Command);
AnsiWriter.WriteInteger(AVersion);
AnsiWriter.WriteInteger(DTBCommand.GroupID);
AnsiWriter.WriteString(DTBCommand.OpsName);
AnsiWriter.WriteString(DTBCommand.DTBCallsign);
AnsiWriter.WriteString(DTBCommand.DestCallsign);
AnsiWriter.WriteString(DTBCommand.Command);
AnsiWriter.WriteString(DTBCommand.Database);
AnsiWriter.WriteString(DTBCommand.Keyword);
AnsiWriter.WriteInteger(DTBCommand.FromTimestamp);
AnsiWriter.WriteInteger(DTBCommand.ConfirmationID);
AnsiWriter.WriteString(DTBCommand.ReplyStr);
AnsiWriter.WriteString(DTBCommand.SpareStr2);
AnsiWriter.WriteInteger(DTBCommand.ErrorCode);
AnsiWriter.WriteInteger(StreamType_CommandFooter);
AnsiWriter.WriteListEnd;
AnsiWriter.FlushBuffer;
AnsiWriter.Free;
if DTBCommand.DestCallsign <> ''
then ServerToClient(AStream,DTBCommand.DestCallsign,DTBCommand.GroupID,'')
else ServerToAllClients(AStream,DTBCommand.DTBCallsign,'',DTBCommand.GroupID,DTBCommand.OpsName);
result := true;
except
on E:Exception do
begin
Log('DTBSendCommand: '+E.Message,d_DTBerror);
end;
end;
finally
end;
end;
// AFromCall,ADestCall,AGroupID,AOpsName,ADatabase,ACommand,AKey,AConfirmationID,AFromTimestamp,AReplyStr
function DTBSendCommand(AFromCall, ADestCall: string; AGroupID: integer;
AOpsName, ADatabase, ACommand, AKey: string; AConfirmationID: integer; AFromTimestamp:int64; AReplyStr: string):boolean;
var DTBCommand:TDTBCommand;
begin
DTBCommand.DTBCallsign := AFromCall;
DTBCommand.DestCallsign := ADestCall;
DTBCommand.GroupID := AGroupID;
DTBCommand.OpsName := AOpsname;
DTBCommand.Database := ADatabase;
DTBCommand.Command := ACommand;
D
TBCommand.Keyword := AKey;
DTBCommand.FromTimestamp := AFromTimestamp;
DTBCommand.ConfirmationID := AConfirmationID;
DTBCommand.ReplyStr := AReplyStr;
DTBCommand.SpareStr2 := '';
result := DTBSendCommand(DTBCommand);
end;
// DTBDEBUG: This must be completely checked.
// It ONLY loads the ACTIVE OPERATION databases. Other databases syat the same.
// DTBDEBUG: MUST also FORCE an Upload of all Stations and Objects on all other connected clients!!!
procedure RebuildTracks(AGlobalSetting:TGlobalSetting);
var
AStationList: TStationList;
AMarkerList: TMarkerList;
i: integer;
begin
Log('RebuildTracks: WILL ONLY DELETE ALL TRACKS!!! NOT FINISHED',d_error);
Log('RebuildTracks: New MaxTrackParts='+IntToStr(AGlobalSetting.MaxTrackParts));
AStationList := StationListList.GetStationList(AGlobalSetting.GroupID,AGlobalSetting.ActiveOpsName);
if AStationList = nil then
begin
Log('RebuildTracks: StationList not found: Making one.',d_DTB);
AStationList := StationListList.AddSTationList(AGlobalSetting.GroupId,AGlobalSetting.ActiveOpsName);
AStationList.LoadFromDisk;
end;
AStationList.MaxTrackParts := AGlobalSetting.MaxTrackParts;
for i := 0 to AStationList.Count-1 do
begin
AStationList[i].MaxTrackParts := AStationList.MaxTrackParts;
if AStationList[i].FOverlay.TrackParts.Count >= AStationList.MaxTrackParts then
begin
{for j := AStationList[i].FOverlay.TrackParts.Count-1 downto AStationList.MaxTrackParts+1
do AStationList[i].FOverlay.TrackParts.Delete(j);
AStationList[i].FOverlay.TrackWritePos := AStationList[i].FOverlay.TrackParts.Count-1;}
AStationList[i].FOverlay.TrackParts.Clear; // DTBDEBUG
AStationList[i].FOverlay.TrackWritePos := 0;
end;
end;
AStationList.HasChanged := true;
AMarkerList := MarkerListList.GetMarkerList(AGlobalSetting.GroupID,AGlobalSetting.ActiveOpsName);
if AMarkerList = nil then
begin
Log('RebuildTracks: MarkerList not found, Making one.',d_DTB);
AMarkerList := MarkerListList.AddMarkerList(AGlobalSetting.GroupId,AGlobalSetting.ActiveOpsName);
AMarkerList.LoadFromDisk;
AMarkerList.MaxTrackParts := AGlobalSetting.MaxTrackParts;
end;
AMarkerList.MaxTrackParts := AGlobalSetting.MaxTrackParts;
for i := 0 to AMarkerList.Count-1 do
begin
AMarkerList[i].MaxTrackParts := AMarkerList.MaxTrackParts;
if AMarkerList[i].FOverlay.TrackParts.Count >= AMarkerList.MaxTrackParts then
begin
// Log('RebuildTracks: Object found: '+AMarkerList[i].ObjectName+' +TrackParts.count='+IntToStr(AMarkerList[i].FOverlay.TrackParts.Count));
{for j := AMarkerList[i].FOverlay.TrackParts.Count-1 downto AMarkerList.MaxTrackParts+1
do AMarkerList[i].FOverlay.TrackParts.Delete(j);
AMarkerList[i].FOverlay.TrackWritePos := AMarkerList[i].FOverlay.TrackParts.Count-1;}
AMarkerList[i].FOverlay.TrackParts.Clear;
AMarkerList[i].FOverlay.TrackWritePos := 0;
end;
end;
AMarkerList.HasChanged := true;
end;
procedure DTBInit;
begin
// DTBClientList := TDTBClientList.Create;
// DTBClientList.OwnsObjects := false;
GlobalSettings := TGlobalSettings.Create;
IdTCPServer1 := TiDTCPServer.Create(nil);
IdTCPServer1.ContextClass := TDTBContextClient;
IdTCPServer1.OnConnect := TDTBEventHandlers.IdTCPServer1Connect;
IdTCPServer1.OnDisconnect := TDTBEventHandlers.IdTCPServer1Disconnect;
IdTCPServer1.OnStatus := TDTBEventHandlers.IdTCPServer1Status;
IdTCPServer1.OnExecute := TDTBEventHandlers.IdTCPServer1Execute;
IdTCPServer1.OnException := TDTBEventHandlers.IdTCPServer1Exception;
IdTCPServer1.DefaultPort := 8050;
IdTCPServer1.MaxConnections := 20;
IdTCPServer1.ListenQueue := 15;
end;
procedure DTBShutdown;
begin
Log('DTB ShutDown: Closing Server');
try
IdTCPServer1.Active := false;
GlobalSettings.SaveToDisk;
GlobalSettings.Free;
IdTCPServer1.free;
except
on E:Exception do Log('DTBShutDown: '+E.Message,d_error);
end;
Log('DTBShutDown finished');
end;
end.
{code}
--
Bart Kindt, CEO and developer
SARTrack Limited New Zealand
http://www.sartrack.co.nz/
|
Mega Search
Sign Up 
