I have a simple webserver written in delphi which fetchs data from the DB and retrieve in JSON.
There are 20 endpoints, I will post one of them:
procedure TWM.WMactGruposGetAction(Sender: TObject; Request: TWebRequest;
Response: TWebResponse; var Handled: Boolean);
var
...
begin
// Get query fields
...
// Configurar resposta
Response.ContentType := APPLICATION_JSON + '; ' + CHARSET_UTF8;
// Look for grupos
qryGrupos := TFDQuery.Create(nil);
with qryGrupos do
begin
Connection := dmDados.GetConnection(NomeDB); // Open the
Active := False;
SQL.Clear;
Open('SELECT * FROM ' + T_PESSOAS_GRUPO +
' WHERE ' + C_ID_LOTEAMENTO + ' = ' + IDLoteamento);
if qryGrupos.RecordCount > 0 then
JsonArray := TJSONArray.Create;
try
First;
while not Eof do
begin
JsonObject := TJSONObject.Create;
CapturarCamposGrupos(JsonObject, qryGrupos);
JsonArray.AddElement(JsonObject);
Next;
end;
finally
Response.Content := JsonArray.ToString;
CloseQuery(qryGrupos); // Close and nil the query
dmDados.CloseConnection(NomeDB); // Close the TFDConnection
JsonArray.DisposeOf;
end;
end;
end;
function TdmDados.GetConnection(DBName: string): TFDConnection;
begin
FDConnection.Open();
Result := FDConnection
end;
This basically does the following:
Opens the TFDConnection
Opens the TFDQuery;
Closes the TFDQuery;
Closes the TFDConnection;
Note: The TFDConnection is created at design time when the application starts, so every API call uses the same TFDConnection;
Problem
The problem is that in my flutter app I call three endpoints at the same time (they pretty much do the same thing as this grupos one).
When I call each endpoint at a time it works fine, but when I go to this page that calls three endpoints at the same time. The webserver brokes.
The error messages differ but they were things like:
Lost connection to MySQL server
Access violation address at ...
Cannot connect to MySQL
And then the server never works more for any endpoint.
I feel like somehow the TFDConnection lost the connection and can not get it again. Any help?
Related
I intent to block certain clients from connecting to my server. I have the following code segments:
procedure TMain.WebServiceConnect(AContext:TIdContext);
Var
IP:String;
begin
try
IP:=AContext.Binding.PeerIP;
if Allowlist.IndexOf(IP)=-1 then Begin;
if Blocklist.IndexOf(IP)>-1 then Begin;
LogWrite('Blocking IP "'+IP+'"!',Detailed);
LogRequest(IP,'*BLOCKED*');
AContext.Connection.Disconnect;
End;
End;
except
ON E:Exception do
LogWrite('"'+E.Message+'" while connection-check on blocklist',Detailed);
end;
end;
procedure TMain.WebServiceReceive(AContext:TIdContext; ARequestInfo:TIdHTTPRequestInfo; AResponseInfo:TIdHTTPResponseInfo);
begin
try
try
LogWrite('Handling connection from '+ARequestInfo.RemoteIP,Debug);
AResponseInfo.ResponseNo:=401;
ProcessWebRequest(AContext,ARequestInfo,AResponseInfo);
LogWrite('Closing connection to '+ARequestInfo.RemoteIP,Debug);
except
ON E:Exception do
LogWrite('"'+E.Message+'" while handling request!',verbose,FALSE);
End;
finally
End;
End;
But I see both events trigger from blocked IPs! I do see the "blocked" logline, but it seems the AContext.Connection.Disconnect doesnt act as expected.
What is wrong?
I see no possible way that the server's OnCommand... events can be fired for a given client connection if the OnConnect event has closed that connection. The server would fail to read the client's request data to populate the TIdRequestInfo object before firing the OnCommand... events.
So, either you are not actually calling Disconnect() like you are expecting, or you are misdiagnosing the issue.
For instance, in your log messages, try including the AContext.Binding.PeerPort, or even the AContext.Binding.Handle, in addition to the PeerIP to make sure the log messages actually belong to the same client connection. PeerIP alone is not adequate to uniquely identify individual connections.
That being said, in the unlikely situation that Disconnect() is actually not closing the connection, you can force a disconnect by raising an exception, such as via SysUtils.Abort(), so that the server will terminate the calling thread and close the socket.
Also, speaking of exceptions, you should re-raise any exception that you catch with except (or, at least, any Indy exception derived from EIdException), let the server handle it.
Try something more like this:
procedure TMain.WebServiceConnect(AContext:TIdContext);
var
IP: String;
Port: TIdPort;
begin
try
IP := AContext.Binding.PeerIP;
Port := AContext.Binding.PeerPort;
if Allowlist.IndexOf(IP) = -1 then begin
if Blocklist.IndexOf(IP) > -1 then begin
LogWrite('Blocking IP "' + IP + ':' + IntToStr(Port) + '"!', Detailed);
LogRequest(IP, '*BLOCKED*');
AContext.Connection.Disconnect;
SysUtils.Abort;
end;
end;
except
on E: Exception do begin
if not (E is EAbort) then
LogWrite('"' + E.Message + '" while connection-check on blocklist', Detailed);
raise;
end;
end;
end;
procedure TMain.WebServiceReceive(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
IP: String;
Port: TIdPort;
begin
try
IP := AContext.Binding.PeerIP;
Port := AContext.Binding.PeerPort;
LogWrite('Handling connection from ' + IP + ':' + IntToStr(Port), Debug);
AResponseInfo.ResponseNo := 401;
ProcessWebRequest(AContext, ARequestInfo, AResponseInfo);
LogWrite('Closing connection to ' + IP + ':' + IntToStr(Port), Debug);
except
on E: Exception do begin
LogWrite('"' + E.Message + '" while handling request!', verbose, FALSE);
raise;
end;
end;
end;
I have just started "playing" with Indy. Used this post how to send file from server to client using indy and altered it so that my Client is the one Sending Data to the Server.
Client has following code to send Data :
procedure TForm1.btnConnectClick(Sender: TObject);
begin
TCPClient.Host:='192.168.88.117';
TCPClient.Port:=32832;
TCPClient.Connect;
end;
procedure TForm1.btnSendClick(Sender: TObject);
var
AStream : TFileStream;
begin
if not TCPClient.Connected then Exit;
TCPClient.IOHandler.WriteLn('SEND_FILE '+GetComputerName+FormatDateTime('yyyy-mm-dd_hhnnsszzz',now)+'.txt');
try
AStream := TFileStream.Create(ExtractFilePath(Application.ExeName)+'\1.txt', fmOpenRead or fmShareDenyWrite);
TCPClient.IOHandler.LargeStream := true;
TCPClient.IOHandler.Write(AStream, 0, True);
finally
AStream.Free;
end;
TCPClient.Disconnect; // otherwise the file is locked on the server side
end;
Server has following code to receive Data :
procedure TForm1.TCPServerExecute(AContext: TIdContext);
var
AStream : TFileStream;
cmd, params, filename : string;
begin
params := AContext.Connection.IOHandler.ReadLn();
cmd := Fetch(params);
if cmd = 'SEND_FILE' then
begin
filename := ExtractFileName(params);
TThread.Queue(nil,
procedure
begin
Memo1.Lines.Add('Command '+cmd+' File Name '+filename);
end
);
AStream := TFileStream.Create(ExtractFilePath(Application.ExeName)+'\'+filename, fmCreate);
try
AContext.Connection.IOHandler.LargeStream:=true;
AContext.Connection.IOHandler.ReadStream(AStream, -1, false);
finally
AStream.Free;
end;
end;
end;
It seems to function correctly , I have made two clients for my test and ran them from separate computers , the server was receiving data from both of them and was creating the data correctly.
I have only two Problems :
1. for some reason the File Received on the Server has always the same amount of leading spaces followed by a # symbol.
Original File looks like this
HERE IS SOME STUFF
Received file on Server looks like this :
#HERE IS SOME STUFF
2. It looks like that after every file Send I need to disconnect , otherwise Indy TCPServer keeps the file locked , is this expected behavior ? How can I tell if the File is done ? I will need to process the received files in another Thread one-by-one .
Thank you.
UPDATE 1
So as recommended by Remy I've altered the Server like this :
procedure TForm1.TCPServerExecute(AContext: TIdContext);
var
AStream : TFileStream;
cmd, params, filename : string;
begin
params := AContext.Connection.IOHandler.ReadLn();
cmd := Fetch(params);
if cmd = 'SEND_FILE' then
begin
filename := ExtractFileName(params);
AStream := TFileStream.Create(ExtractFilePath(Application.ExeName)+'\'+filename, fmCreate);
try
AContext.Connection.IOHandler.WriteLn('OK');
AContext.Connection.IOHandler.LargeStream:=true;
AContext.Connection.IOHandler.ReadStream(AStream, -1, false);
finally
AStream.Free;
end;
end;
params := AContext.Connection.IOHandler.ReadLn();
cmd := Fetch(params);
if cmd = 'SENT' then
RenameFile(filename,ChangeFileExt(filename,'.dat'));
end;
On the Client I moved the entire Transfer into a Thread using ITask like this :
procedure TForm1.BackgroundTransfer;
var
TCPClient : TidTCPClient;
AStream : TFileStream;
Files : TStringDynArray;
i : integer;
isDone : boolean;
begin
Files := TDirectory.GetFiles(ExtractFilePath(Application.ExeName)+'\1\','*.out');
TThread.Queue(TThread.CurrentThread,
procedure
begin
Memo1.Lines.Add(IntToStr(Length(Files)));
end
);
if Length(Files) = 0 then Exit;
TCPClient := TidTCPClient.Create(nil);
try
TransferActive:=true;
TCPClient.Disconnect;
TCPClient.Host:='192.168.88.117';
TCPClient.Port:=32832;
TCPClient.Connect;
for i := Low(Files) to High(Files) do
begin
isDone:=false;
if FileExists(Files[i]) = true then
begin
TCPClient.IOHandler.WriteLn('SEND_FILE '+Files[i]);
try
// wait for server
repeat
sleep(100);
if TCPClient.IOHandler.ReadLn() = 'OK' then break;
until ( true );
AStream := TFileStream.Create(Files[i], fmOpenRead or fmShareDenyWrite);
TCPClient.IOHandler.LargeStream := true;
TCPClient.IOHandler.Write(AStream, 0, True);
isDone:=true;
TCPClient.IOHandler.WriteLn('SENT '+Files[i]);
finally
AStream.Free;
end;
if isDone = true then
System.SysUtils.DeleteFile(Files[i]);
end;
end;
finally
TCPClient.Free;
TransferActive:=false;
end;
end;
I Check with a Timer every 10 seconds if the Task is running if not I create a new one like this :
procedure TForm1.Timer2Timer(Sender: TObject);
if TransferActive = false then
begin
inc(ThreadTimer);
Panel1.Caption:=ThreadTimer.ToString;
Panel1.Color:=clRed;
end
else
begin
Panel1.Color:=clGreen;
end;
if ThreadTimer >= 10 then
begin
ThreadTimer:=0;
TransferTask := TTask.Create(BackGroundTransfer);
TransferTask.Start;
end;
end;
If I understood it correctly Indy Keeps Track of the Connections in the Background . Connection A-A , B-B , C-C , they cannot get mixed up . I am asking this because from the Server and Client side I just send OK or SENT and it works . ( hopefully not just by pure luck )
This is important because once it is fully working , I will have multiple client (android devices) sending data to this server . And there will be quiet a high chance that sometimes more then one client will be uploading data.
I also tested this like what happens if I start copying files into the Clients INPUT Directory and the Copy is not Done but the Task start . It worked , on first run it detected 350 files on the next run 500 .
Also tested if I simply stop the Server what happens that works too . If I use the TCPServer.Active:=false;
On the Client side the WriteLn and ReadLn properly causes an Exception ( Server Timeout I guess ) if the connection is lost .
On the Server Side I simply rename the Received file from OUT to DAT once it is done . I am not 100% sure if that guarantees that the file was really 100% correctly transferred . I was however unable to produce a damaged file during my testings.
Anyway the Entire idea is :
TCPClient is running on a Android phone, where the User Scanns Barcodes , I create a control file from this which is then in 10 sec intervals uploaded to the server . And from then on Processed by the Server and sent to another server .
Regards
UPDATE 2
Removed this line from server :
DelFilesFromDir(ExtractFilePath(Application.ExeName), '*.out', FALSE);
was a bad idea to put in inside the Execute method .
I will need to find another way to remove possible junk files .
Also TransferActive is a Global variable , and is being modified by the Transfer Background Thread. But since only one Thread is running at a Time, I thought it should be safe.
I need to write a simple chat program that will be used by some customers. Basically, there are a lot of clients connected to a server and they chat together. The server works:
Here the code if needed:
//CONNECT TO THE SERVER
procedure TFormServer.ButtonStartClick(Sender: TObject);
begin
if not TCPServer.Active then
begin
try
TCPServer.DefaultPort := 8002;
TCPServer.Bindings[0].IP := LIP.Text;
TCPServer.Bindings[0].Port := StrToInt(LPort.Text);
TCPServer.MaxConnections := 5;
TCPServer.Active := true;
Memo1.Lines.Add(TimeNow + 'Server started.');
except
on E: Exception do
Memo1.Lines.Add(sLineBreak + ' ====== INTERNAL ERROR ====== ' +
sLineBreak + ' > ' + E.Message + sLineBreak);
end;
end;
end;
//DISCONNECT
procedure TFormServer.ButtonStopClick(Sender: TObject);
begin
if TCPServer.Active then
begin
TCPServer.Active := false;
Memo1.Lines.Add(TimeNow + 'Server stopped.');
end;
end;
//IF CLOSE THE APP DONT FORGET TO CLOSE SERVER!!
procedure TFormServer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ButtonStopClick(Self);
end;
procedure TFormServer.FormCreate(Sender: TObject);
begin
FClients := 0;
end;
//When a client connects I write a log
procedure TFormServer.TCPServerConnect(AContext: TIdContext);
begin
Inc(FClients);
TThread.Synchronize(nil, procedure
begin
LabelCount.Text := 'Connected sockets: ' + FClients.ToString;
Memo1.Lines.Add(TimeNow + ' Client connected # ' + AContext.Binding.IP + ':' + AContext.Binding.Port.ToString);
end);
end;
//Same, when a client disconnects I log it
procedure TFormServer.TCPServerDisconnect(AContext: TIdContext);
begin
Dec(FClients);
TThread.Synchronize(nil, procedure
begin
LabelCount.Text := 'Connected sockets: ' + FClients.ToString;
Memo1.Lines.Add(TimeNow + ' Client disconnected');
end);
end;
//WHAT I DO HERE:
//I receive a message from the client and then I send this message to EVERYONE that is connected here. It is a global chat
procedure TFormServer.TCPServerExecute(AContext: TIdContext);
var
txt: string;
begin
txt := AContext.Connection.IOHandler.ReadLn();
AContext.Connection.IOHandler.WriteLn(txt);
TThread.Synchronize(nil, procedure
begin
Memo1.Lines.Add(TimeNow + txt);
end);
end;
The sever code is very easy and minimal but it does what I need. This is the client instead:
Here there is the code, very simple:
//CONNECT TO THE SERVER
procedure TFormClient.ConnectClick(Sender: TObject);
begin
if Length(Username.Text) < 4 then
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('ERROR: Username must contain at least 4 characters');
Exit;
end;
if not TCPClient.Connected then
begin
try
Username.Enabled := false;
Memo1.Lines.Clear;
TCPClient.Host := '127.0.0.1';
TCPClient.Port := 8002;
TCPClient.ConnectTimeout := 5000;
TCPClient.Connect;
Connect.Text := 'Disconnect';
except
on E: Exception do
Memo1.Lines.Add(' ====== ERROR ======' + sLineBreak +
' > ' + E.Message + sLineBreak);
end;
end
else
begin
TCPClient.Disconnect;
Username.Enabled := true;
Connect.Text := 'Connect';
end;
end;
//IF YOU FORGET TO DISCONNECT WHEN APP IS CLOSED
procedure TFormClient.FormDestroy(Sender: TObject);
begin
if TCPClient.Connected then
TCPClient.Disconnect;
end;
//Here I send a string to the server and it's good
procedure TFormClient.SendClick(Sender: TObject);
begin
if TCPClient.Connected then
begin
TCPClient.IOHandler.WriteLn(Username.Text + ': ' + EditMessage.Text);
EditMessage.Text := '';
end
else
begin
Memo1.Lines.Add('ERROR: You aren''t connected!');
end;
end;
//Problems here
procedure TFormClient.Timer1Timer(Sender: TObject);
begin
Memo1.Lines.Add(TCPClient.IOHandler.ReadLn());
end;
The problems start in the last procedure Timer1Timer. I have found that TCPServer uses a thread and this is why I call Synchronize to update the UI. Instead TCPClient does not use a thread and I manually have to check the server. Please see this code:
procedure TFormServer.TCPServerExecute(AContext: TIdContext);
var
txt: string;
begin
txt := AContext.Connection.IOHandler.ReadLn();
AContext.Connection.IOHandler.WriteLn(txt);
TThread.Synchronize(nil, procedure
begin
Memo1.Lines.Add(TimeNow + txt);
end);
end;
As you can see, when the server receives a string he immediatly sends it back to all the clients. I try to get the string here:
procedure TFormClient.Timer1Timer(Sender: TObject);
begin
Memo1.Lines.Add(TCPClient.IOHandler.ReadLn());
end;
What is wrong? I have seen a similar question here and answers said that I have to use a timer and IOHandler.ReadLn(), which is what I am doing. I think that the problem is here. How to fix?
Also timer has an interval of 200, is it too short?
I have read what Remy Lebeau said in the answer and I've produced this simple code:
procedure TFormClient.Timer1Timer(Sender: TObject);
begin
if not(TCPClient.Connected) then
Exit;
if TCPClient.IOHandler.InputBufferIsEmpty then
Exit;
Memo1.Lines.Add(TCPClient.IOHandler.InputBufferAsString());
end;
There is a Timer1 component in the form. This works as I expect but it still could lock the UI or not?
The server works
Just an FYI, you don't need the FClients variable at all, especially since you are not really accessing it safely. At the very least, use TInterlocked to access it safely. Or switch to TIdThreadSafeInteger. Though really, the only place you use it is in LabelCount, and you can get the current client count from the TIdTCPServers.Contexts property instead.
This is the client instead:
...
The problems start in the last procedure Timer1Timer.
That is because you are using a UI-based TTimer, and (like most things in Indy) the IOHandler.ReadLn() method blocks until completed. You are calling it within the context of the UI thread, so it blocks the UI message loop until a full line has arrived from the socket.
One way to work around blocking the UI is to place an Indy TIdAntiFreeze component onto your Form. Then the UI will remain responsive while ReadLn() blocks. However, this would be kind of dangerous to use with a TTimer, as you would end up with OnTimer reentry issues that could corrupt the IOHandler's data.
Really, the best solution is to simply not call the IOHandler.ReadLn() in the UI thread at all. Call it in a worker thread instead. Start the thread after you successfully Connect() to the server, and terminate the thread when disconnected. Or even move the Connect() itself into the thread. Either way, you can use Indy's TIdThreadComponent, or write your own T(Id)Thread-derived class.
Instead TCPClient does not use a thread and I manually have to check the server.
Correct, but the way you are doing it is wrong.
If you don't want to use a worker thread (which you should), then at least change your OnTimer event handler so it does not block the UI anymore, like this:
Or:
procedure TFormClient.Timer1Timer(Sender: TObject);
begin
if TCPClient.IOHandler.InputBufferIsEmpty then
begin
TCPClient.IOHandler.CheckForDataOnSource(0);
TCPClient.IOHandler.CheckForDisconnect(False);
if TCPClient.IOHandler.InputBufferIsEmpty then Exit;
end;
// may still block if the EOL hasn't been received yet...
Memo1.Lines.Add(TCPClient.IOHandler.ReadLn);
end;
Alternatively:
procedure TFormClient.Timer1Timer(Sender: TObject);
begin
// Connected() performs a read operation and will buffer
// any pending bytes that happen to be received...
if not TCPClient.Connected then Exit;
while TCPClient.IOHandler.InputBuffer.IndexOf(Byte($0A)) <> -1 do
Memo1.Lines.Add(TCPClient.IOHandler.ReadLn());
end;
I have seen a similar question here and answers said that I have to use a timer and IOHandler.ReadLn(), which is what I am doing.
Whoever said that is wrong, or you misunderstood what was required. Using a timer in the UI is a possible solution, if used correctly, but it is not a very good solution.
Create a thread for your tcpclient and sync messages back to the UI.
I have a DataSnap/REST server and client application.
The server have a method to return one or more datasets with some number of records but, when this number of records is greater than 50, the first 50 records aren't received by the client application.
I have debugged the server application and the SQL statement is correct (I have executed it from IBExpert and returns the correct number of records).
I have used XE7, FireDAC and Firebird.
Into the server application I have this method to return a dataset
procedure TSvrMethodsMdl.AddTable(SQL, TabName: string; JSON: TFDJSONDataSets);
var
Q: TFDQuery;
begin
Q := TFDQuery.Create(nil);
try
Q.Connection := conTPV;
Q.Transaction := conTPV.Transaction;
Q.SQL.Text := SQL;
TFDJSONDataSetsWriter.ListAdd(JSON, TabName, Q);
finally
// FreeAndNil(Q);
end;
end;
Into the client application, for receiving records, I have this code
var
LDataSetList: TFDJSONDataSets;
LDataSet: TFDDataSet;
tTemp: TFDMemTable;
begin
....
// get remote data
LDataSetList := CliConnectMdl.SvrMethodsMdlClient.GetDataChanged(Shop, ResError);
// process data
LDataSet := TFDJSONDataSetsReader.GetListValueByName(LDataSetList, MyTabName);
tTemp.AppendData(LDataSet);
I think that is some of configuration, but I cant find what.
Any idea? Thanks
I want to establish a communication between TIdTCPServer and TIdTCPClient in delphi and this is how my procedures look :
1.Server side :
procedure TMainForm.IdTCPServer1Execute(AContext: TIdContext);
var
clientReq, clientName : String;
begin
clientReq := AContext.Connection.IOHandler.ReadLn(); // client sends request
clientName := extractClientName(clientReq);
AContext.Connection.IOHandler.WriteLn('Hello ' + clientName);
end;
2.Client side :
procedure TMainForm.btnTestClientClick(Sender: TObject);
var
testTCP : TIdTCPClient;
clientReq, serverResponse : String;
begin
testTCP := TIdTCPClient.Create;
try
testTCP.Host := wantedHost;
testTCP.Port := wantedPort;
testTCP.Connect;
clientReq := 'Hello, my Name is user1.';
testTCP.IOHandler.WriteLn(clientReq);
try
serverResponse := testTCP.IOHandler.ReadLn();
except on e : Exception do begin
ShowMessage('Error reading response =' + e.Message);
end;
end;
finally
FreeAndNil(testTCP);
end;
end;
I connect to the server but than my application freezes when I try to receive the response from the server OnExecute event with my TCPClient.IOHandler.ReadLn method. Can anyone help me fix my code or show me a working example of what I'm trying to do (with Indy's TIdTCPClient and TIdTCPServer) ?
There is nothing wrong with the code you have shown, so the problem has to be in the code you have not shown. The way I see it, there are two possibilities:
If you are not setting wantedHost and/or wantedPort to the correct values, you would not actually be connecting to your expected server.
If extractClientName() is getting stuck internally and not exiting, the server would not be sending any response. One way that could happen is if you are running the client and server in the same process, and extractClientName() syncs with the main thread, but the main thread is blocked waiting on the client and cannot process the sync, so a deadlock occurs.