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.
Related
I make an application where the client and the server are in the same program. I use Delphi XE7 and components TIpTCPServer / ... Client. But when I try to close the server with the client connected (in the same window), the program stops responding. Perhaps this is something related to multithreading. How to implement a program with a client and server in one application and is this the right approach?
procedure TfrmMain.startClick(Sender: TObject);
begin
if (server.active) then stopServer()
else startServer();
end;
procedure TfrmMain.startServer();
var
binding: TIdSocketHandle;
begin
server.bindings.clear();
try
server.defaultPort := strToInt(port.text);
binding := server.bindings.add();
binding.ip := ip;
binding.port := strToInt(port.text);
server.active := true;
if (server.active) then begin
addToLog('Server started');
start.caption := 'Stop';
end;
except on e: exception do
addToLog('Error: ' + e.message + '.');
end;
end;
procedure TfrmMain.stopServer();
begin
server.active := false;
server.bindings.clear();
if (not(server.active)) then begin
addToLog('Server stopped');
start.caption := 'Start';
end
else addToLog('Server shutdown error.');
end;
procedure TfrmMain.serverConnect(AContext: TIdContext);
var
i: integer;
begin
addToLog('New client: ' + aContext.connection.socket.binding.peerIP + '.');
clients.clear();
for i := 0 to server.contexts.lockList.count - 1 do begin
with TIdContext(server.contexts.lockList[i]) do
clients.items.add(connection.socket.binding.peerIP);
end;
server.contexts.unlockList();
end;
procedure TfrmMain.serverDisconnect(AContext: TIdContext);
begin
addToLog('Client ' + aContext.connection.socket.binding.peerIP + ' disconnected from the server.');
end;
procedure TfrmMain.clientConnected(Sender: TObject);
begin
addToConsole('You connected to server successfully.');
end;
procedure TfrmMain.clientDisconnected(Sender: TObject);
begin
addToConsole('The connection to the server was interrupted.');
end;
and connection code:
client.host := ip;
try
client.connect();
except on e: exception do
addToConsole('Error: ' + e.message);
end;
I see a number of issues with this code.
How are addToLog() and addToConsole() implemented? Are they thread-safe? Remember that TIdTCPServer is a multi-threaded component, its events are fired in the context of worker threads, not the main UI thread, so any access to the UI, shared variables, etc must be synchronized.
What is clients? Is it is a UI control? You need to sync access to it so you don't corrupt its content when multiple threads try to access it at the same time.
Your use of the TIdTCPServer.Contexts property is not adequately protected from exceptions. You need a try..finally block so you can call Contexts.UnlockList() safely.
More importantly, you are calling Contexts.LockList() too many times in your serverConnect() loop (this is the root cause of your problem). LockList() returns a TIdContextList object. Inside your loop, you should be accessing that list's Items[] property instead of calling LockList() again. Because you do not have a matching UnlockList() for each LockList(), once a client connects to your server, the Contexts list becomes deadlocked, and can no longer be accessed once serverConnect() exits, which includes when clients connect/disconnect, and during TIdTCPServer shutdown (such as in your case).
serverDisconnect() is not removing any items from clients. serverConnect() should not be resetting clients at all. It should add only the calling TIdContext to clients, and then serverDisconnect() should remove that same TIdContext from clients later.
With that said, try something more like this:
procedure TfrmMain.addToConsole(const AMsg: string);
begin
TThread.Queue(nil,
procedure
begin
// add AMsg to console ...
end
);
end;
procedure TfrmMain.addToLog(const AMsg: string);
begin
TThread.Queue(nil,
procedure
begin
// add AMsg to log ...
end
);
end;
procedure TfrmMain.startClick(Sender: TObject);
begin
if server.Active then
stopServer()
else
startServer();
end;
procedure TfrmMain.startServer();
var
binding: TIdSocketHandle;
begin
server.Bindings.Clear();
try
server.DefaultPort := StrToInt(port.Text);
binding := server.Bindings.Add();
binding.IP := ip;
binding.Port := StrToInt(port.Text);
server.Active := True;
addToLog('Server started');
start.Caption := 'Stop';
except
on e: Exception do
addToLog('Error: ' + e.message + '.');
end;
end;
procedure TfrmMain.stopServer();
begin
try
server.Active := False;
server.Bindings.Clear();
addToLog('Server stopped');
start.Caption := 'Start';
except
on e: Exception do
addToLog('Server shutdown error.');
end;
end;
procedure TfrmMain.serverConnect(AContext: TIdContext);
var
PeerIP: string;
begin
PeerIP := AContext.Binding.PeerIP;
addToLog('New client: ' + PeerIP + '.');
TThread.Queue(nil,
procedure
{
var
i: integer;
list: TIdContextList;
}
begin
{
clients.clear();
list := server.Contexts.LockList;
try
for i := 0 to list.count - 1 do begin
clients.Items.Add(TIdContext(list[i]).Binding.PeerIP);
end;
finally
list.UnlockList();
end;
}
// I'm assuming clients is a UI control whose Items property
// is a TStrings object. If not, adjust this code as needed...
clients.Items.AddObject(PeerIP, AContext);
end;
);
end;
procedure TfrmMain.serverDisconnect(AContext: TIdContext);
begin
addToLog('Client ' + AContext.Binding.PeerIP + ' disconnected from the server.');
TThread.Queue(nil,
procedure
var
i: Integer;
begin
// I'm assuming clients is a UI control whose Items property
// is a TStrings object. If not, adjust this code as needed...
i := clients.Items.IndexOfObject(AContext);
if i <> -1 then
clients.Items.Delete(i);
end
);
end;
procedure TfrmMain.clientConnected(Sender: TObject);
begin
addToConsole('You connected to server successfully.');
end;
procedure TfrmMain.clientDisconnected(Sender: TObject);
begin
addToConsole('The connection to the server was interrupted.');
end;
I want to transfer data from the TIdTCPServer to the TIdTCPClient.
On the server side I have:
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var x:Integer;
Received:String;
SendBuff:TBytes;
hFile:THandle;
fSize:Int64;
begin
fSize:=0;
if MOpenFileForRead(hFile,MGetExePath+'\test.jpg') then begin
fSize:=MFileSize(hFile);
SetLength(SendBuff,fSize);
MReadFile(hFile,SendBuff[0],fSize);
MCloseFile(hFile);
end;
// ... here the SendBuff contains valid data, I checked.
repeat
Received:=AContext.Connection.Socket.ReadLn;
if not AContext.Connection.Connected then Exit;
if Received=CMD_TEST_FILE then begin
AContext.Connection.Socket.Write(fSize);
AContext.Connection.Socket.WriteBufferOpen;
AContext.Connection.Socket.Write(SendBuff);
AContext.Connection.Socket.WriteBufferClose;
end;
until False;
end;
And the client side:
procedure TForm1.Button2Click(Sender: TObject);
var fSize:Int64;
RecvBuff:TBytes;
hFile:THandle;
begin
IdTCPClient1.Socket.WriteLn(CMD_TEST_FILE);
fSize:=IdTCPClient1.Socket.ReadInt64;
SetLength(RecvBuff,fSize);
IdTCPClient1.Socket.ReadBytes(RecvBuff,fSize);
if MCreateFile(hFile, MGetExePath+'\new.jpg') then begin
MWriteFile(hFile,RecvBuff[0],fSize);
MCloseFile(hFile);
end;
Memo1.Lines.Add('ok');
end;
... but it's not working. I checked the read and write data functions used and they are ok. At the server the buffer is set ok, the file size arrives at client ok, but the content of the buffer at client is only zeros.
P.S: I want to send the file in this way not with stream or anything else.
If you look at the signature of ReadBytes(), it has an optional AAppend parameter that is True by default:
procedure ReadBytes(var VBuffer: TIdBytes; AByteCount: Integer; AAppend: Boolean = True); virtual;
When true, it reads bytes from the socket and appends them to the end of the existing byte array. Since you are pre-allocating the array, the initial bytes are undefined and the file bytes follow after the undefined bytes.
To fix this, you need to either:
Stop pre-allocating the byte array, let ReadBytes() allocate it for you.
procedure TForm1.Button2Click(Sender: TObject);
var
fSize: Int64;
RecvBuff: TBytes;
hFile: THandle;
begin
IdTCPClient1.Socket.WriteLn(CMD_TEST_FILE);
fSize := IdTCPClient1.Socket.ReadInt64;
// SetLength(RecvBuff,fSize); // <-- remove this line
IdTCPClient1.Socket.ReadBytes(RecvBuffer, fSize);
if MCreateFile(hFile, MGetExePath+'\new.jpg') then
begin
MWriteFile(haile, RecvBuff[0], fSize);
MCloseFile(hFile);
end;
Memo1.Lines.Add('ok');
end;
pre-allocate the array, but set AAppend to False so the bytes fill the existing array instead of append to it.
procedure TForm1.Button2Click(Sender: TObject);
var
fSize: Int64;
RecvBuff: TBytes;
hFile: THandle;
begin
IdTCPClient1.Socket.WriteLn(CMD_TEST_FILE);
fSize := IdTCPClient1.Socket.ReadInt64;
SetLength(RecvBuff, fSize);
IdTCPClient1.Socket.ReadBytes(RecvBuff, fSize, False);
if MCreateFile(hFile, MGetExePath+'\new.jpg') then
begin
MWriteFile(haile, RecvBuff[0], fSize);
MCloseFile(hFile);
end;
Memo1.Lines.Add('ok');
end;
Update: That being said, I strongly suggest you use a TStream instead, despite you saying you do not want to. It will greatly simplify the code and memory management, without breaking the communication protocol you have chosen to use:
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
begin
AContext.Data := TFileStream.Create(MGetExePath+'\test.jpg', fmOpenRead or fmShareDenyWrite);
AContext.Connection.IOHandler.LargeStream := True;
end;
TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
Received: String;
begin
Received := AContext.Connection.IOHandler.ReadLn;
if Received = CMD_TEST_FILE then
begin
AContext.Connection.IOHandler.Write(TStream(AContext.Data), 0, True);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
FileName: string;
Strm: TStream;
begin
FileName := MGetExePath+'\new.jpg';
Strm := TFileStream.Create(FileName, fmCreate);
try
try
IdTCPClient1.IOHandler.WriteLn
(CMD_TEST_FILE);
IdTCPClient1.IOHandler.ReadStream(Strm, -1, False);
finally
Strm.Free;
end;
except
DeleteFile(FileName);
raise;
end;
Memo1.Lines.Add('ok');
end;
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 use the following code to eval the msg. content (body / lines) of an E Mail msg received with the INDY 10 components
function LinesFromMsg(aMsg: TIdMessage): TStrings;
var
i: Integer;
begin
for i := 0 to aMsg.MessageParts.AttachmentCount-1 do
begin
if (amsg.MessageParts.Items[i].ContentType ='HTML') then
begin
if (amsg.MessageParts.Items[i] is Tidtext) then
Result := TidText(amsg.MessageParts.Items[i]).body;
end;
end;
end;
regarding this code I have 2 questions :
a) is this the correct way of finding the Tlines part in an arbitray mail message ?
( consider the advice shown at INDY 10 EMAIL MSG PARTS )
b) where can I find a tutorial of all the different Contenttype string values?
The correct ContentType value to look for is text/html. Use Indy's IsHeaderMediaType() function to check it, as the ContentType value may have additional attributes associated with it that your comparison needs to ignore.
You also need to take the TIdMessage.ContentType into account as well, as HTML emails may not be MIME encoded and thus not use the TIdMessage.MessageParts` collection at all.
And lastly, you loop needs to use the MessageParts.Count property instead of the MessageParts.AttachmentsCount property.
Try this:
function HTMLFromMsg(aMsg: TIdMessage): TStrings;
var
i: Integer;
Part: TIdMessagePart;
begin
Result := nil;
if IsHeaderMediaType(aMsg.ContentType, 'text/html') then
begin
Result := aMsg.Body;
Exit;
end;
for i := 0 to aMsg.MessageParts.Count-1 do
begin
Part := aMsg.MessageParts.Items[i];
if (Part is TIdText) and IsHeaderMediaType(Part.ContentType, 'text/html') then
begin
Result := TIdText(Part).Body;
Exit;
end;
end;
end;
With that said, this is technically not the correct way to handle MIME. Officially, a conforming reader is supposed to loop backwards through the MIME parts, as they are ordered from the simpliest form downwards towards the most complex form. So you loop backwards, taking MIME nesting into account, looking for the most complex form you support. Something more like this (untested):
procedure DisplayPlainText(Body: TStrings);
begin
// display plain text as needed...
end;
procedure DisplayHTML(Body: TStrings);
begin
// display html as needed...
end;
procedure DisplayMultiPartAlternative(aMsg: TIdMessage; aParentIndex, aLastIndex: Integer);
var
Part: TIdMessagePart;
i: Integer:
begin
for i := aLastIndex-1 downto aParentIndex+1 do
begin
Part := aMsg.MessageParts.Items[i];
if (Part.ParentPart = aParentIndex) and (Part is TIdText) then
begin
if IsHeaderMediaType(Part.ContentType, 'text/html') then
begin
DisplayHTML(TIdText(Part).Body);
Exit;
end;
if IsHeaderMediaType(Part.ContentType, 'text/plain') then
begin
DisplayPlainText(TIdText(Part).Body);
Exit;
end;
end;
end;
// nothing supported to display...
end;
procedure DisplayMultiPartMixed(aMsg: TIdMessage; aParentIndex, aLastIndex: Integer);
var
Part: TIdMessagePart;
i: Integer;
begin
for i := aLastIndex-1 downto aParentIndex+1 do
begin
Part := aMsg.MessageParts.Items[i];
if (Part.ParentPart = aParentIndex) and (Part is TIdText) then
begin
if IsHeaderMediaType(Part.ContentType, 'multipart/alternative') then
begin
DisplayMultiPartAlternative(aMsg, ParentPart.Index, aLastIndex);
Exit;
end;
if IsHeaderMediaType(ParentPart.ContentType, 'text/html') then
begin
DisplayHTML(TIdText(Part).Body);
Exit;
end;
if IsHeaderMediaType(Part.ContentType, 'text/plain') then
begin
DisplayPlainText(TIdText(Part).Body);
Exit;
end;
aLastIndex := i;
end;
end;
// nothing supported to display...
end;
procedure DisplayMsg(aMsg: TIdMessage);
var
ContentType: string;
begin
ContentType := ExtractHeaderMediaType(aMsg.ContentType);
case PosInStrArray(ContentType, ['multipart/mixed', 'multipart/alternative', 'text/html', 'text/plain'], False) of
0: begin
DisplayMultiPartAlternative(aMsg, -1, aMsg.MessageParts.Count);
Exit;
end;
1: begin
DisplayMultiPartMixed(aMsg, -1, aMsg.MessageParts.Count);
Exit;
end;
2: begin
DisplayHTML(aMsg.Body);
Exit;
end;
3: begin
DisplayPlainText(aMsg.Body);
Exit;
end;
else
// nothing supported to display...
end;
end;
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