Here is the code of the timer which tries to authenticate and 'ping' the remote servers
if bLogging then
CodeSite.EnterMethod('Timer1');
if runningThreads <= 0 then
begin
runningThreads := 0;
Timer1.Enabled := False;
Timer2.Enabled := True;
dData.Clear;
sList.Clear;
MyDb.FDQuery2.Close;
MyDb.FDQuery2.SQL.Clear;
MyDb.FDQuery2.SQL.Add('Select * from shipsperuser where loginname = ''' + suser + ''' order by imo');
MyDb.FDQuery2.Open;
iRec := MyDb.FDQuery2.RecordCount;
x := 1;
while not MyDb.FDQuery2.Eof do
begin
rTdata.sU := MyDb.FDQuery2.FieldByName('username').Value;
rTdata.sAddress := MyDb.FDQuery2.FieldByName('ipaddress').Value;
rTdata.sImo := MyDb.FDQuery2.FieldByName('imo').Value;
Codec1.DecryptString(rTdata.sPwd, MyDb.FDQuery2.FieldByName('password').Value, System.SysUtils.TEncoding.Default);
dData.Add(x, rTdata);
inc(x);
MyDb.FDQuery2.Next;
end;
MyDb.FDQuery2.Close;
if bLogging then
for key in dData.Keys do
CodeSite.Send('dData key and value: ' + IntToStr(key), dData.Items[key].sAddress);
Application.ProcessMessages;
if bLogging then
CodeSite.Send('Record count in dData:', dData.Count);
if dData.Count > 0 then
begin
if bLogging then
CodeSite.Send('Creating new tasks');
// .TaskConfig(Parallel.TaskConfig.OnMessage(WM_RESULT, LogResult))
{
Here we start the parallel processing in threads for all the ships. A thread per ship will be created.
}
FParallel := Parallel.For(1, iRec).TaskConfig(Parallel.TaskConfig.OnTerminated( // OnMessage(WM_RESULT, LogResult)
procedure
begin
if runningThreads > 0 then
dec(runningThreads);
FParallel := nil;
if bLogging then
CodeSite.Send('On Terminate Decreased running threads. Value now is:', runningThreads);
end).noThreadPool).NoWait.OnStop(
procedure
begin
FParallel := nil;
runningThreads := 0;
if bLogging then
CodeSite.Send('On Stop, running threads value now is:', runningThreads);
end);
if bLogging then
CodeSite.Send('Before the execute statement');
{
Here the thread processing starts
}
FParallel.Execute(
procedure(taskIndex, idx: Integer) // const task: IOmniTask;
var
bResult: Boolean;
sResult: string;
Token: String;
rTempx: rThread;
Request: THttpRequest;
Response: THttpResponse;
XClient: TXDataClient;
XClientAuth: TXDataClient;
begin
if bLogging then
CodeSite.EnterMethod('FParallel');
Try
rTempx.sAddress := '';
if bLogging then
CodeSite.Send('rTempx assigned, idx: ', idx);
dData.TryGetValue(idx, rTempx);
if bLogging then
CodeSite.Send('After getting rTempx: ', rTempx.sAddress);
sResult := '';
bResult := False;
Try
XClientAuth := TXDataClient.Create;
if bLogging then
CodeSite.Send('XClientAuth Created. ', rTempx.sAddress);
XClient := TXDataClient.Create;
if bLogging then
CodeSite.Send('XClient Created. ', rTempx.sAddress);
Except
exit;
end;
if bLogging then
begin
CodeSite.Send('New task for: ' + rTempx.sImo, rTempx.sAddress);
CodeSite.Send('idx: ' + IntToStr(idx));
end;
inc(runningThreads);
Token := '';
XClientAuth.Uri := 'http://' + rTempx.sAddress + ':' + Xport + '/ship/auth';
Try
if bLogging then
begin
CodeSite.Send('Starting the authentication ' + XClientAuth.Uri + ' ; user: ' + rTempx.sU + ' ; password: ' + rTempx.sPwd);
end;
Token := XClientAuth.Service<ILoginService>.Login(rTempx.sU, rTempx.sPwd);
// Now we start the 'ping'
// generic method to send authorization info to server
Request := XClient.HttpClient.CreateRequest;
Request.Uri := 'http://' + rTempx.sAddress + ':' + Xport + '/ship';
Request.Method := 'GET';
Request.Headers.SetValue('Authorization', 'Bearer ' + Token);
if bLogging then
CodeSite.Send('Request created for: ' + rTempx.sAddress + ' ; token: ' + Token);
Try
if bLogging then
begin
CodeSite.Send('Starting the ping, token:', Token);
CodeSite.Send('Starting the ping, uri:', Request.Uri);
end;
Response := XClient.HttpClient.Send(Request);
if Response.StatusCode = 200 then
begin
bResult := True;
sResult := rTempx.sImo + '|' + rTempx.sAddress + '|Ok';
end;
if bLogging then
CodeSite.Send('Request headers', Request.Headers);
Request.Free;
Response.Free;
Except
if bLogging then
CodeSite.Send('Ping error for ', rTempx.sAddress);
End;
Except
if bLogging then
CodeSite.Send('Authentication error');
End;
if bLogging then
CodeSite.Send('Result of ping:' + rTempx.sAddress, bResult);
if sResult <> '' then
sList.Add(sResult);
Finally
if bLogging then
CodeSite.Send('In finally block', rTempx.sAddress);
XClientAuth.Free;
if bLogging then
CodeSite.Send('In finally block, freed XClientAuth', rTempx.sAddress);
XClient.Free;
if bLogging then
CodeSite.Send('In finally block, freed XClient', rTempx.sAddress);
Application.ProcessMessages;
end;
if bLogging then
CodeSite.ExitMethod('FParallel');
end);
end;
if bLogging then
CodeSite.Send('sList.count: ', sList.Count);
Timer1.Enabled := True;
end;
if bLogging then
CodeSite.ExitMethod('Timer1');
end;