I have small problem (I wish it's small) with disconnecting server - I mean - only in the moment when I want to disconnect it from server application (server.active=false).
Here is my simple code:
type
PClient = ^TClient;
type
TClient = record
Name: string;
AContext: TIdContext;
end;
clients: TThreadList;
SERVER: TIdTCPServer;
procedure TX.SERVERConnect(AContext: TIdContext);
var
NewClient: PClient;
s:string;
begin
s := AContext.Connection.socket.ReadLn();
GetMem(NewClient, SizeOf(TClient));
NewClient.name:=s;
NewClient.AContext := AContext;
AContext.data := TObject(NewClient);
try
clients.LockList.Add(NewClient);
finally
clients.UnlockList;
end;
AContext.Connection.socket.writeln('E:');//answer to client - "all right"
End;
procedure TX.SERVERDisconnect(AContext: TIdContext);
var
AClient: PClient;
begin
AClient := PClient(AContext.data);
try
clients.LockList.Remove(AClient);
finally
clients.UnlockList;
end;
FreeMem(AClient);
AContext.data := nil;
end;
It have to works only for sending data to clients therefore I read only one data line in onconnect procedure - it contains login name.
Procedure for sending data in my code looks like (is it good?):
var
procedure TX.send(what: string; where: string);
i, ile: integer;
s: string;
Aclient: PClient;
list: tlist;
begin
list:= SERVER.Contexts.LockList;
try
for i := 0 to list.Count - 1 do
with TIdContext(list[i]) do
begin
AClient := PClient(data);
if where = ActClient^.name then
Connection.IOHandler.writeln(what);
end;
finally
SERVER.Contexts.UnlockList;
end;
end;
It looks it works good - I mean. But when I want to disable server by SERVER.active:=false application freezes? I tried to free clients etc. but it dosen't work in my bad code.
Could Somebody help me and give me advice how to stop server for this code?
Artik
Related
I am writing a client / server application. There is one server and several clients.
When connecting a client, the task is to add its IP address to the ListBox, and when disconnecting the client, remove it from the ListBox. Then exchange messages between the client and server.
Three questions arose: when a client connects, its IP address is added to the ListBox, but when disconnected, it is not deleted from there, here is the code:
type
TSimpleClient = class(TObject)
DNS,
Name : String;
ListLink : Integer;
Thread : Pointer;
end;
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
Client: TSimpleClient;
begin
Client := TSimpleClient.Create;
Client.DNS := AContext.Connection.Socket.Binding.PeerIP;
Client.ListLink := ListBox1.Items.Count;
Client.Thread := AContext;
ListBox1.Items.Add(Client.DNS);
AContext.Data := Client;
Clients.Add(Client);
end;
procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
Client : TSimpleClient;
begin
sleep(2000);
Client :=Pointer (AContext.Data);
Clients.Delete(Client.ListLink);
ListBox1.Items.Delete(ListBox1.Items.IndexOf(Client.DNS));
Client.Free;
AContext.Data := nil;
end;
The second question, when exchanging messages, the letters in Cyrillic are given as "???", all Google went through it and it was not possible to find an error.
And the third question, on the client is a timer that listens to messages from the server, when the timer is turned on, the client application hangs tight, putting all this into the stream is the same trouble, the code:
if not IdTCPClient1.Connected then
Exit;
s := IdTCPClient1.Socket.ReadLn;
if s <> '' then
Label1.Text := s;
I see quite a few problems with your code.
On the server side, you need to get rid of the TSimpleClient.ListLink field. You are misusing it, causing bad behaviors in your code since you don't keep it updated as clients are added/removed. Think of what happens when you have 2 clients connected, where ListLink is 0 and 1 respectively, and then the 1st client disconnects. The ListLink for the 2nd client will become invalid since you don't decrement it from 1 to 0.
Also TIdTCPServer is a multi-threaded component, its events are fired in the context of worker threads, but your event handler code is not thread-safe. You MUST synchronize with the main UI thread when accessing UI controls from worker threads, and you MUST protect your Clients list from concurrent access across thread boundaries. In this case, you don't really need your own Clients list to begin with as TIdTCPServer has its own thread-safe Contexts list that you can use to access the connected clients.
You are also not handling Unicode at all. By default, Indy's default byte encoding for Unicode strings is US-ASCII, which is why you are getting ? for non-ASCII characters. You can use the IOHandler's DefStringEncoding property to set a different byte encoding, such as IndyTextEncoding_UTF8 (if you are using Delphi 2007 or earlier, you might need to also use the IOHandler's DefAnsiEncoding property to specify how your ANSI strings are converted to/from Unicode. By default, it is set to IndyTextEncoding_OSDefault).
Try something more like this:
type
TSimpleClient = class(TObject)
DNS,
Name : String;
Thread : Pointer;
OutgoingMsgs : TIdThreadSafeStringList;
HasOutgoingMsgs : Boolean;
constructor Create;
destructor Destroy; override;
procedure Queue(const Msg: string);
procedure FlushMsgs;
end;
constructor TSimpleClient.Create;
begin
inherited;
OutgoingMsgs := TIdThreadSafeStringList.Create;
end;
destructor TSimpleClient.Destroy;
begin
OutgoingMsgs.Free;
inherited;
end;
procedure TSimpleClient.Queue(const Msg: string);
var
List: TStringList;
begin
List := OutgoingMsgs.Lock;
try
List.Add(Msg);
HasOutgoingMsgs := True;
finally
OutgoingMsgs.Unlock;
end;
end;
procedure TSimpleClient.FlushMsgs;
var
List: TStringList;
begin
List := OutgoingMsgs.Lock;
try
while List.Count > 0 do
begin
TIdContext(Thread).Connection.IOHandler.WriteLn(List[0]);
List.Delete(0);
end;
HasOutgoingMsgs := False;
finally
OutgoingMsgs.Unlock;
end;
end;
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
PeerIP: string;
Client: TSimpleClient;
begin
PeerIP := AContext.Binding.PeerIP;
Client := TSimpleClient.Create;
Client.DNS := PeerIP;
Client.Thread := AContext;
AContext.Data := Client;
TThread.Queue(nil,
procedure
begin
ListBox1.Items.AddObject(PeerIP, Client);
end
);
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
end;
procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
Client : TSimpleClient;
begin
Client := TSimpleClient(AContext.Data);
try
TThread.Queue(nil,
procedure
var
Index: Integer;
begin
Index := ListBox1.Items.IndexOfObject(Client);
if Index <> -1 then
ListBox1.Items.Delete(Index);
end;
);
finally
{ The anonymous procedure being passed to TThread.Queue() above captures
the Client variable itself, not its value. On ARC platforms, we need to
prevent Free() setting the variable to nil before it can be passed to
IndexOfObject(), and also because IndexOfObject() expects a live object
anyway. ARC will free the object when the anonymous procedure exits. On
non-ARC platforms, it is OK to Free() the object here, the variable will
not change value, and IndexOfObject() does not need a live object... }
{$IFNDEF AUTOREFCOUNT}
Client.Free;
{$ENDIF}
AContext.Data := nil;
end;
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
Client: TSimpleClient;
begin
Client := TSimpleClient(AContext.Data);
if Client.HasOutgoingMsgs then
Client.FlushMsgs
else
Sleep(100);
end;
procedure TForm1.SendMessageToClient(Client: TSimpleClient; const Msg: string);
var
List: TIdContextList;
begin
List := IdTCPServer1.Contexts.LockList;
try
if List.IndexOf(TIdContext(Client.Thread)) <> -1 then // still connected?
Client.Queue(Msg);
finally
IdTCPServer1.Contexts.UnlockList;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Index: Integer;
Msg: string;
Client: TSimpleClient;
begin
Index := ListBox1.ItemIndex;
if Index = -1 then Exit;
Msg := Edit1.Text;
if Msg = '' then Exit;
Client := TSimpleClient(ListBox1.Items.Objects[Index]);
SendMessageToClient(Client, Msg);
end;
Alternatively, you can derive TSimpleClient from TIdServerContext and get rid of the Thread field altogether:
type
TSimpleClient = class(TIdServerContext)
DNS,
Name : String;
OutgoingMsgs : TIdThreadSafeStringList;
HasOutgoingMsgs : Boolean;
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
destructor Destroy; override;
procedure Queue(const Msg: string);
procedure FlushMsgs;
end;
constructor TSimpleClient.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited Create(AConnection, AYarn, AList);
OutgoingMsgs := TIdThreadSafeStringList.Create;
end;
destructor TSimpleClient.Destroy;
begin
OutgoingMsgs.Free;
inherited;
end;
procedure TSimpleClient.Queue(const Msg: string);
var
List: TStringList;
begin
List := OutgoingMsgs.Lock;
try
List.Add(Msg);
HasOutgoingMsgs := True;
finally
OutgoingMsgs.Unlock;
end;
end;
procedure TSimpleClient.FlushMsgs;
var
List: TStringList;
begin
List := OutgoingMsgs.Lock;
try
while List.Count > 0 do
begin
Self.Connection.IOHandler.WriteLn(List[0]);
List.Delete(0);
end;
HasOutgoingMsgs := False;
finally
OutgoingMsgs.Unlock;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
IdTCPServer1.ContextClass := TSimpleClient;
end;
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
PeerIP: string;
Client: TSimpleClient;
begin
PeerIP := AContext.Binding.PeerIP;
Client := TSimpleClient(AContext);
Client.DNS := PeerIP;
TThread.Queue(nil,
procedure
begin
ListBox1.Items.AddObject(PeerIP, Client);
end
);
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
end;
procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
Client : TSimpleClient;
begin
Client := TSimpleClient(AContext);
TThread.Queue(nil,
procedure
var
Index: Integer;
begin
Index := ListBox1.Items.IndexOfObject(Client);
if Index <> -1 then
ListBox1.Items.Delete(Index);
end;
);
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
Client: TSimpleClient;
begin
Client := TSimpleClient(AContext);
if Client.HasOutgoingMsgs then
Client.FlushMsgs
else
Sleep(100);
end;
procedure TForm1.SendMessageToClient(Client: TSimpleClient; const Msg: string);
var
List: TIdContextList;
begin
List := IdTCPServer1.Contexts.LockList;
try
if List.IndexOf(TIdContext(Client)) <> -1 then // still connected?
Client.Queue(Msg);
finally
IdTCPServer1.Contexts.UnlockList;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Index: Integer;
Msg: string;
Client: TSimpleClient;
begin
Index := ListBox1.ItemIndex;
if Index = -1 then Exit;
Msg := Edit1.Text;
if Msg = '' then Exit;
Client := TSimpleClient(ListBox1.Items.Objects[Index]);
SendMessageToClient(Client, Msg);
end;
On the client side, you are reading from the socket in the main UI thread, but Indy uses blocking sockets, and so its reading methods will block the calling thread until the requested data arrives. DON'T block the main UI thread! Read only if there is actually something available to read, or else move the reading into a separate worker thread. For example:
IdTCPClient1.Connect;
IdTCPClient1.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
...
IdTCPClient1.Disconnect;
...
procedure TForm1.Timer1Timer(Sender: TObject);
var
s: string;
begin
if IdTCPClient1.Connected and (not IdTCPClient1.IOHandler.InputBufferIsEmpty) then
begin
s := IdTCPClient1.IOHandler.ReadLn;
if s <> '' then
Label1.Text := s;
end;
end;
Alternatively:
type
TReadingThread = class(TThread)
protected
procedure Execute; override;
end;
procedure TReadingThread.Execute;
var
s: String;
begin
while not Terminated do
begin
s := Form1.IdTCPClient1.IOHandler.ReadLn;
if s <> '' then
begin
TThread.Queue(nil,
procedure
begin
Form1.Label1.Text := s;
end
);
end;
end;
end;
...
var
ReadingThread: TReadingThread = nil;
...
IdTCPClient1.Connect;
IdTCPClient1.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
ReadingThread := TReadingThread.Create(False);
...
ReadingThread.Terminate;
try
IdTCPClient1.Disconnect;
finally
ReadingThread.WaitFor;
ReadingThread.Free;
end;
Thank you so much Remy, your answer really helped me sort out my problem. I targeted Windows and Android platforms. I fixed your code a little and it worked for me:
type
TSimpleClient = class(TObject)
DNS,
Name : String;
Thread : Pointer;
OutgoingMsgs : TIdThreadSafeStringList;
HasOutgoingMsgs : Boolean;
constructor Create;
destructor Destroy; override;
procedure Queue(const Msg: string);
procedure FlushMsgs;
end;
constructor TSimpleClient.Create;
begin
inherited;
OutgoingMsgs := TIdThreadSafeStringList.Create;
end;
destructor TSimpleClient.Destroy;
begin
OutgoingMsgs.Free;
inherited;
end;
procedure TSimpleClient.Queue(const Msg: string);
var
List: TStringList;
Client: TSimpleClient;
begin
List := OutgoingMsgs.Lock;
try
List.Add(Msg);
HasOutgoingMsgs := True;
Client.FlushMsgs;
finally
OutgoingMsgs.Unlock;
end;
end;
procedure TSimpleClient.FlushMsgs;
var
List: TStringList;
begin
List := OutgoingMsgs.Lock;
try
while List.Count > 0 do
begin
TIdContext(Thread).Connection.IOHandler.WriteLn(List[0]);
List.Delete(0);
end;
HasOutgoingMsgs := False;
finally
OutgoingMsgs.Unlock;
end;
end;
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
PeerIP: string;
Client: TSimpleClient;
begin
PeerIP := AContext.Binding.PeerIP;
Client := TSimpleClient.Create;
Client.DNS := PeerIP;
Client.Thread := AContext;
AContext.Data := Client;
TThread.Queue(nil,
procedure
begin
ListBox1.Items.AddObject(PeerIP, Client);
end
);
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
end;
procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
Client : TSimpleClient;
begin
Client := TSimpleClient(AContext.Data);
try
TThread.Queue(nil,
procedure
var
Index: Integer;
begin
Index := ListBox1.Items.IndexOfObject(Client);
if Index <> -1 then
ListBox1.Items.Delete(Index);
end;
);
finally
{ The anonymous procedure being passed to TThread.Queue() above captures
the Client variable itself, not its value. On ARC platforms, we need to
prevent Free() setting the variable to nil before it can be passed to
IndexOfObject(), and also because IndexOfObject() expects a live object
anyway. ARC will free the object when the anonymous procedure exits. On
non-ARC platforms, it is OK to Free() the object here, the variable will
not change value, and IndexOfObject() does not need a live object... }
{$IFNDEF AUTOREFCOUNT}
Client.Free;
{$ENDIF}
AContext.Data := nil;
end;
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
Client: TSimpleClient;
begin
Client := TSimpleClient(AContext.Data);
if Client.HasOutgoingMsgs then
Client.FlushMsgs
else
Sleep(100);
end;
procedure TForm1.SendMessageToClient(Client: TSimpleClient; const Msg: string);
var
List: TIdContextList;
begin
List := IdTCPServer1.Contexts.LockList;
try
if List.IndexOf(TIdContext(Client.Thread)) <> -1 then // still connected?
Client.Queue(Msg);
finally
IdTCPServer1.Contexts.UnlockList;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Index: Integer;
Msg: string;
Client: TSimpleClient;
begin
Index := ListBox1.ItemIndex;
if Index = -1 then Exit;
Msg := Edit1.Text;
if Msg = '' then Exit;
Client := TSimpleClient(ListBox1.Items.Objects[Index]);
SendMessageToClient(Client, Msg);
end;
I added a call to the FlushMsgs method from the TSimpleClient.Queue procedure and messages started to be sent, the list of clients is updated every time clients are connected and disconnected, and the server stopped hanging. Thanks again Remy, you helped a lot to speed up the development, golden man.
I have Server And Client App.
From Server side there are 2 buttons.
1st button "Display Data On Server".
2nd button "Send Data to Client".
In a Server side i'm using FDQuery1, SringGrid1, TetheringManager1 and TetheringAppProfile1.
From Client Side only 1 button "Connect".
In a Client Side I'm using StringGrid1, TetheringManager1 and TetheringAppProfile1
So First Client Connecting to the Server then Server Side sending data to client.
Server "Send Data to Client" button
Code:
procedure TForm1.Button2Click(Sender: TObject);
var rec:integer;
begin
FDQuery1.SQL.Text := 'SELECT * FROM names';
FDQuery1.Open;
rec := FDQuery1.RecordCount;
FDQuery1.First;
if rec>0 then
begin
while not FDQuery1.Eof do
begin
TetheringAppProfile1.Resources.FindByName('Vefa').Value:=FDQuery1.FieldByName('Name').AsString;
FDQuery1.Next;
end;
end;
Client Side Receive
Code:
procedure TForm2.TetheringAppProfile1Resources1ResourceReceived(
const Sender: TObject; const AResource: TRemoteResource);
var i:integer;
begin
for i := 0 to TetheringAppProfile1.Resources.Count do
StringGrid1.Cells[1,i]:=AResource.Value.AsString;
end;
But When I send data from Server to Client I see like this:
You can collect the names into a TStringList and then send that either as a string, using the TStringList.Text property, or as a stream.
To send as a string (and assuming a resource name = NameList), the SendDataClick event handler could look like this:
procedure TServerForm.btnSendDataClick(Sender: TObject);
var
sl: TStringList;
begin
sl := TStringList.Create;
try
sl.Add(StringGrid1.Cells[1, 1]);
sl.Add(StringGrid1.Cells[1, 2]);
sl.Add(StringGrid1.Cells[1, 3]);
TetheringAppProfile1.Resources.FindByName('NameList').Value := sl.Text;
finally
sl.Free;
end;
end;
I simply copied the names from the grid, you could do it directly from the db records.
And the client OnResourceReceived:
procedure TClientForm.TetheringAppProfile1Resources2ResourceReceived(
const Sender: TObject; const AResource: TRemoteResource);
var
sl: TStringList;
i: integer;
begin
sl := TStringList.Create;
try
sl.Text := AResource.Value.AsString;
for i := 0 to sl.Count-1 do
StringGrid1.Cells[1, i+1] := sl[i];
finally
sl.Free;
end;
end;
I suggest you also read about passing streams in Malcolm Groves blog
I started playing with Indy TCPServer and TCPClient few weeks ago, and now, after lots of research and help from SOF experts (specially Mr. Lebeau), I can securely manage client connections and send a string message to a specific client. Here is a piece of the code:
type
TClient = class(TObject)
private
FHost: string;
public
FQMsg: TIdThreadSafeStringList; // Message Queue
constructor Create(const Host: string);
destructor Destroy; override;
end;
procedure TfrmMain.TCPServerExecute(AContext: TIdContext);
var
Client: TClient;
LQueue: TStringList;
WQueue: TStringList;
begin
with AContext.Connection.IOHandler Do
begin
DefStringEncoding := TEncoding.UTF8;
LQueue := nil;
Client := TClient(AContext.Data);
try
WQueue := Client.FQMsg.Lock;
try
if (WQueue.Count > 0) then
begin
LQueue := TStringList.Create;
LQueue.Assign(WQueue);
WQueue.Clear;
end;
finally
Client.FQMsg.Unlock;
end;
if (LQueue <> nil) then
Write(LQueue);
finally
LQueue.Free;
end;
end;
end;
Now it's time to go a step further, and try to receive an answer from the client. But suddenly I realize that I can't use the TCPServer's OnExecute event to send the message and receive answer at "same time"?? I am probably wrong, but this code isn't working, and I have no idea why...
procedure TfrmMain.TCPServerExecute(AContext: TIdContext);
var
RStr: string;
Client: TClient;
LQueue: TStringList;
WQueue: TStringList;
begin
with AContext.Connection.IOHandler Do
begin
DefStringEncoding := TEncoding.UTF8;
// Send Cmd
LQueue := nil;
Client := TClient(AContext.Data);
try
WQueue := Client.FQMsg.Lock;
try
if (WQueue.Count > 0) then
begin
LQueue := TStringList.Create;
LQueue.Assign(WQueue);
WQueue.Clear;
end;
finally
Client.FQMsg.Unlock;
end;
if (LQueue <> nil) then
Write(LQueue);
finally
LQueue.Free;
end;
// Receive Data
RStr := Trim(ReadLn);
if (RStr <> '') then
begin
SyncLog(RStr);
end;
end;
end;
When I add this last part (ReadLn) together, the first part of the code do not work, I cannot send the message to client anymore :(
Please, anyone knows what I missing?
Thank you!
First, use TIdTextEncoding.UTF8 instead of TEncoding.UTF8 (or IndyTextEncoding_UTF8 if you upgrade to Indy 10.6+), and move the assignment of DefStringEncoding to the OnConnect event. You only need to assign it once, not on every read/write.
Second, ReadLn() is a blocking method. It does exit until a line of actually read, or a timeout/error occurs. So, to do what you are attempting, you have to check for the existence of inbound data before you actually read it, so that you can timeout and Exit and let OnExecute loop back to check the queue again.
Try something like this:
type
TClient = class(TObject)
private
FHost: string;
FQMsg: TIdThreadSafeStringList; // Message Queue
public
constructor Create(const Host: string);
destructor Destroy; override;
property QMsg: TIdThreadSafeStringList read FQMsg;
end;
procedure TfrmMain.TCPServerConnect(AContext: TIdContext);
var
Client: TClient;
begin
AContext.Connection.IOHandler.DefStringEncoding := TIdTextEncoding.UTF8;
...
Client := TClient.Create;
...
AContext.Data := Client;
...
end;
procedure TfrmMain.TCPServerExecute(AContext: TIdContext);
var
RStr: string;
Client: TClient;
LQueue: TStringList;
WQueue: TStringList;
begin
Client := TClient(AContext.Data);
// Send Cmd
LQueue := nil;
try
WQueue := Client.QMsg.Lock;
try
if (WQueue.Count > 0) then
begin
LQueue := TStringList.Create;
LQueue.Assign(WQueue);
WQueue.Clear;
end;
finally
Client.QMsg.Unlock;
end;
if (LQueue <> nil) then
AContext.Connection.IOHandler.Write(LQueue);
finally
LQueue.Free;
end;
// Receive Data
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
if not AContext.Connection.IOHandler.CheckForDataOnSource(100) then Exit;
AContext.Connection.IOHandler.CheckForDisconnect;
end;
RStr := Trim(AContext.Connection.IOHandler.ReadLn);
if (RStr <> '') then
begin
SyncLog(RStr);
end;
end;
I am new to Delphi and trying to convert vb.net apps to learn. The issue I am having is reading from a TCP/IP host. Currently I can connect via telnet to the device, send a command, and the device will send data non-stop until all data is sent. This could be simply two characters followed by CR/LF, or it could be several rows of varing length data. Each row is end is CR/LF. Prior to writing code, we were able to telnet via Hyperterminal to the device. Send a command, and, with the capture text enabled save to a text file.
Below is the code I have so far. I have not coded for saving to text file (one step at a time). The data is pipe delimited. I have no control on the format or operatation of the device aside from sending commands and receiving data. It works most of the time however there are times when not all of the data (65 records for testing) are received. I will greatly appreciate guidence and feel free to comment on my code, good or bad.
function Parse(Char, S: string; Count: Integer): string;
var
I: Integer;
T: string;
begin
if S[Length(S)] <> Char then
S := S + Char;
for I := 1 to Count do
begin
T := Copy(S, 0, Pos(Char, S) - 1);
S := Copy(S, Pos(Char, S) + 1, Length(S));
end;
Result := T;
end;
procedure TForm2.btnEXITClick(Sender: TObject);
begin
if idTcpClient1.connected then
begin
idTcpClient1.IOHandler.InputBuffer.clear;
idTcpClient1.Disconnect;
end;
Close;
end;
procedure TForm2.btnSendDataClick(Sender: TObject);
var
mTXDataString : String;
RXString : String;
begin
IdTCPClient1.Host := IPAddress.Text;
IdTCPClient1.Port := StrToInt(IPPort.Text);
mTXDataString := mTXData.Text + #13#10;
IdTCPClient1.Connect;
If IdTCPClient1.Connected then
begin
IdTCPClient1.IOHandler.Write(mTXDataString);
mTXDataString := mTXData.Lines.Text;
if MTXDataString.Contains('SCHEMA') then
begin
mRXData.Lines.Add(IdTCPClient1.IOHandler.ReadLn);
while not (IdTCPClient1.IOHandler.InputBufferIsEmpty) do
begin
RXString := IdTCPClient1.IOHandler.ReadLn;
If (RXString <> '') and (RXString <> '??') then
begin
//Add received data to RXmemo
mRXData.Lines.Add(RXString);
//Determine number of records to received based on schema data
lblRecords.Caption := Parse(',', RXString, 2);
end;
end; //while not
end // if
else
if mTXDataString.Contains('DATA') then
begin
mRXData.Lines.Add(IdTCPClient1.IOHandler.ReadLn);
while not (IdTCPClient1.IOHandler.InputBufferIsEmpty) do
begin
RXString := IdTCPClient1.IOHandler.ReadLn;
If (RXString <> '') and (RXString <> '??') then
begin
mRXData.Lines.Add(RXString);
end; // if
end; //while not
end; // if Schema or not
end; // if Connected
IdTCPClient1.Disconnect;
end; //Procedure
HyperTerminal and Telnet apps display whatever data they receive, in real-time. TIdTCPClient is not a real-time component. You control when and how it reads. If you are expecting data to arrive asynchronously, especially if you don't know how many rows are going to be received, then you need to perform the reading in a timer or worker thread, eg:
procedure TForm2.TimerElapsed(Sender: TObject);
var
S: String;
begin
if IdTCPClient1.IOHandler = nil then Exit;
if IdTCPClient1.IOHandler.InputBufferIsEmpty then
begin
IdTCPClient1.IOHandler.CheckForDataOnSource(50);
if IdTCPClient1.IOHandler.InputBufferIsEmpty then Exit;
end;
S := IdTCPClient1.IOHandler.ReadLn;
// use S as needed ...
end;
Or:
type
TMyThread = class(TThread)
protected
fClient: TIdTCPClient;
procedure Execute; override;
public
constructor Create(aClient: TIdTCPClient);
end;
constructor TMyThread.Create(aClient: TIdTCPClient);
begin
inherited Create(False);
fClient := aClient;
end;
procedure TMyThread.Execute;
var
S: String;
begin
while not Terminated do
begin
S := fClient.IOHandler.ReadLn;
// use S as needed ...
end;
end;
Or, if the server supports the actual Telnet protocol, have a look at using Indy's TIdTelnet component instead.
After a lot of searching I thought Indy TCP server would be the best to use on Instant messenger server I am working on. The only issue I am facing right now is broadcasting and forwarding message to other connected client, sending back response to the same client seems ok and doesn't hangs up other clients activity, but for forwarding message to other clients the mechanism that I know of is by using the aContext.locklist, and iterating between the connection list to find the client connection that is to receive the data.
The problem here I think is that it freezes the list and doesn't process other clients requests until the unlocklist is called. So will it not hurt the performance of the server? locking the list and iterating between connections for forwarding each message (as this is what happens very often in a messenger). Is there any better way to do this?
I am using Indy 10 and Delphi 7
Code for broadcast:
Var tmpList: TList;
i: Integer;
Begin
tmpList := IdServer.Contexts.LockList;
For i := 0 to tmpList.Count Do Begin
TIdContext(tmpList[i]).Connection.Socket.WriteLn('Broadcast message');
End;
IdServer.Contexts.UnlockList;
Code for forwarding message:
Var tmpList: TList;
i: Integer;
Begin
tmpList := IdServer.Contexts.LockList;
For i := 0 to tmpList.Count Do Begin
If TIdContext(tmpList[i]).Connection.Socket.Tag = idReceiver Then
TIdContext(tmpList[i]).Connection.Socket.WriteLn('Message');
End;
IdServer.Contexts.UnlockList;
Yes, you have to loop through the Contexts list in order to broadcast a message to multiple clients. However, you do not (and should not) perform the actual writing from inside the loop. One, as you already noticed, server performance can be affected by keeping the list locked for awhile. Two, it is not thread-safe. If your loop writes data to a connection while another thread is writing to the same connection at the same time, then the two writes will overlap each other and corrupt your communications with that client.
What I typically do is implement a per-client outbound queue instead, using either the TIdContext.Data property or a TIdServerContext descendant to hold the actual queue. When you need to send data to a client from outside of that client's OnExecute event, put the data in that client's queue instead. That client's OnExecute event can then send the contents of the queue to the client when it is safe to do so.
For example:
type
TMyContext = class(TIdServerContext)
public
Tag: Integer;
Queue: TIdThreadSafeStringList;
...
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil); override;
destructor Destroy; override;
end;
constructor TMyContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil);
begin
inherited;
Queue := TIdThreadSafeStringList.Create;
end;
destructor TMyContext.Destroy;
begin
Queue.Free;
inherited;
end;
.
procedure TForm1.FormCreate(Sender: TObject);
begin
IdServer.ContextClass := TMyContext;
end;
procedure TForm1.IdServerConnect(AContext: TIdContext);
begin
TMyContext(AContext).Queue.Clear;
TMyContext(AContext).Tag := ...
end;
procedure TForm1.IdServerDisconnect(AContext: TIdContext);
begin
TMyContext(AContext).Queue.Clear;
end;
procedure TForm1.IdServerExecute(AContext: TIdContext);
var
Queue: TStringList;
tmpList: TStringList;
begin
...
tmpList := nil;
try
Queue := TMyContext(AContext).Queue.Lock;
try
if Queue.Count > 0 then
begin
tmpList := TStringList.Create;
tmpList.Assign(Queue);
Queue.Clear;
end;
finally
TMyContext(AContext).Queue.Unlock;
end;
if tmpList <> nil then
AContext.Connection.IOHandler.Write(tmpList);
finally
tmpList.Free;
end;
...
end;
.
var
tmpList: TList;
i: Integer;
begin
tmpList := IdServer.Contexts.LockList;
try
for i := 0 to tmpList.Count-1 do
TMyContext(tmpList[i]).Queue.Add('Broadcast message');
finally
IdServer.Contexts.UnlockList;
end;
end;
.
var
tmpList: TList;
i: Integer;
begin
tmpList := IdServer.Contexts.LockList;
try
for i := 0 to tmpList.Count-1 do
begin
if TMyContext(tmpList[i]).Tag = idReceiver then
TMyContext(tmpList[i]).Queue.Add('Message');
end;
finally
IdServer.Contexts.UnlockList;
end;
end;