how do I disconnect inactive clients with TIdTCPServer? - delphi

I am trying to disconnect inactive clients that are connected to TIdTCPServer, whether those clients are disconnected from their Internet or for a period of inactive time.
I tried to set timeouts in the OnConnect event like the following:
procedure TservForm.TcpServerConnect(AContext: TIdContext);
begin
AContext.Connection.IOHandler.ReadTimeout := 26000;
AContext.Binding.SetSockOpt(Id_SOL_SOCKET, Id_SO_SNDTIMEO, 15000);
end;
But it seems a disconnect is not triggered after the client connection is lost.
I tried to use SetKeepAliveValues(), but it takes too much time to get an inactive client disconnected.
Is there a more helpful way to disconnect inactive clients? So if the client did not receive or send anything, for example in 30 seconds, the server will disconnect it?
on execute event
procedure TservForm.TcpServerExecute(AContext: TIdContext);
var
Connection: TConnection;
cmd: String;
Cache, OutboundCmds: TStringList;
MS: TMemoryStream;
I: integer;
S: String;
begin
Connection := AContext as TConnection;
// check for pending outbound commands...
OutboundCmds := nil;
try
Cache := Connection.OutboundCache.Lock;
try
if Cache.Count > 0 then
begin
OutboundCmds := TStringList.Create;
OutboundCmds.Assign(Cache);
Cache.Clear;
end;
finally
Connection.OutboundCache.Unlock;
end;
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
begin
AContext.Connection.IOHandler.Writeln(OutboundCmds.Strings[I],
IndyTextEncoding_UTF8);
MS := TMemoryStream(OutboundCmds.Objects[I]);
if MS <> nil then
begin
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
AContext.Connection.IOHandler.LargeStream := true;
AContext.Connection.IOHandler.Write(MS, 0, true);
end;
end;
end;
finally
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
OutboundCmds.Objects[I].Free;
end;
OutboundCmds.Free;
end;
// check for a pending inbound command...
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
AContext.Connection.IOHandler.CheckForDataOnSource(100);
AContext.Connection.IOHandler.CheckForDisconnect;
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
Exit;
end;
end;
cmd := AContext.Connection.Socket.ReadLn(IndyTextEncoding_UTF8);
...............
...............

The client does not disconnect because the ReadLn() is not reached during idle times, so the ReadTimeout does not have effect, and if you are not sending a lot of commands then the socket buffer is not filling up so SO_SNDTIMEO does not have an effect, either.
Since you are already doing some manual timeout handling, you can expand on it to handle an idle timeout as well, eg:
type
TConnection = class(TIdServerContext)
...
public
LastSendRecv: LongWord;
...
end;
...
procedure TservForm.TcpServerConnect(AContext: TIdContext);
var
Connection: TConnection;
begin
Connection := AContext as TConnection;
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
AContext.Connection.IOHandler.LargeStream := True;
AContext.Connection.IOHandler.ReadTimeout := 30000;
AContext.Binding.SetSockOpt(Id_SOL_SOCKET, Id_SO_SNDTIMEO, 15000);
Connection.LastSendRecv := Ticks;
end;
procedure TservForm.TcpServerExecute(AContext: TIdContext);
var
Connection: TConnection;
cmd: String;
Cache, OutboundCmds: TStringList;
MS: TMemoryStream;
I: integer;
S: String;
begin
Connection := AContext as TConnection;
// check for pending outbound commands...
OutboundCmds := nil;
try
Cache := Connection.OutboundCache.Lock;
try
if Cache.Count > 0 then
begin
OutboundCmds := TStringList.Create;
OutboundCmds.Assign(Cache);
Cache.Clear;
end;
finally
Connection.OutboundCache.Unlock;
end;
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
begin
AContext.Connection.IOHandler.WriteLn(OutboundCmds.Strings[I]);
MS := TMemoryStream(OutboundCmds.Objects[I]);
if MS <> nil then
AContext.Connection.IOHandler.Write(MS, 0, true);
end;
Connection.LastSendRecv := Ticks;
end;
finally
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
OutboundCmds.Objects[I].Free;
end;
OutboundCmds.Free;
end;
// check for a pending inbound command...
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
AContext.Connection.IOHandler.CheckForDataOnSource(100);
AContext.Connection.IOHandler.CheckForDisconnect;
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
if GetTickDiff(Connection.LastSendRecv, Ticks) >= 30000 then
AContext.Connection.Disconnect;
Exit;
end;
end;
cmd := AContext.Connection.Socket.ReadLn;
Connection.LastSendRecv := Ticks;
...
end;

Related

Disconnect unknow connections at TIdTcpServer OnConnect

I'm having a problem. I created a TIdTCPServer but I need to prevent false/unknown connections.
I tried this:
procedure Wait(millisecs: Integer);
var
tick: dword;
AnEvent: THandle;
begin
AnEvent := CreateEvent(nil, False, False, nil);
try
tick := GetTickCount + dword(millisecs);
while (millisecs > 0) and (MsgWaitForMultipleObjects(1, AnEvent, False, millisecs, QS_ALLINPUT) <> WAIT_TIMEOUT) do begin
Application.ProcessMessages;
if Application.Terminated then Exit;
millisecs := tick - GetTickcount;
end;
finally
CloseHandle(AnEvent);
end;
end;
procedure CheckCon(Con: Pointer);
begin
Wait(5000);
if TClient(Con).HWID = '' then TClient(Con).Connection.Disconnect;
EndThread(0);
end;
constructor TClient.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
var
ThreadId : Cardinal;
begin
inherited Create(AConnection, AYarn, AList);
FCriticalSection := TCriticalSection.Create;
Queue := TIdThreadSafeStringList.Create;
BeginThread(nil, 0, #CheckCon, Self, 0, ThreadId);
end;
OnConnect event code:
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
Conexao : TClient;
Retorno : TArray<String>;
Query : TFDQuery;
Libera : Boolean;
IPEX : Boolean;
begin
Libera := True;
IPEX := True;
Conexao := TClient(AContext);
Retorno := AContext.Connection.IOHandler.ReadLn.Split(['#']);
if Length(Retorno) = 0 then
begin
AContext.Connection.Disconnect;
Exit;
end;
Conexao.IP := AContext.Connection.Socket.Binding.PeerIP;
Conexao.HWID := Retorno[1];
Conexao.Connected := Now;
Conexao.Ping := Ticks;
ClientStateUpdated(Conexao, RetornaTraducao(40));
TThread.Queue(nil,
procedure
begin
Memo2.Lines.Add(Format(RetornaTraducao(36), [TimeToStr(Now), Conexao.IP, Conexao.HWID]));
end);
end;
If I test creating a low number of unknown clients, it works good, but if I flood it with MANY connections, the application crashes. I need something like this to prevent unknown connections in my TIdTCPServer.
I tried calling
Memo2.Lines.Add(Format('[%s]', [AContext.Connection.IOHandler.ReadLn]));
in IdTCPServer1Connect to determine if the connection was my application, but if the client only connects and doesn't send anything, the line doesn't execute.
Starting a worker thread inside of TClient's constructor is completely unnecessary (the TClient object is already run in a thread created by the server). You can simply set a 5 second timeout on the ReadLn() call itself and be done with it.
Also, TIdTCPServer is a multi-threaded component, its events are fired in the context of worker threads, so access to UI controls like Memo2 MUST by synchronized with the UI thread or else bad things happen.
Try something more like this:
constructor TClient.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited Create(AConnection, AYarn, AList);
FCriticalSection := TCriticalSection.Create;
Queue := TIdThreadSafeStringList.Create;
end;
...
// code adapted from my reply to your previous question:
//
// https://stackoverflow.com/a/58479489/65863
//
// tweak as needed...
//
procedure TForm1.ClientStateUpdated(Client: TClient; const Msg: string);
var
IP, HWID: string;
begin
IP := Client.IP;
HWID := Client.HWID;
TThread.Queue(nil,
procedure
begin
Memo2.Lines.Add(Format(RetornaTraducao(36), [TimeToStr(Now), IP, HWID, Msg]));
end
);
end;
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
Conexao : TClient;
Retorno : TArray<String>;
begin
Conexao := TClient(AContext);
Retorno := AContext.Connection.IOHandler.ReadLn(LF, 5000).Split(['#']);
if (Length(Retorno) < 2) or (Retorno[1] = '') then
begin
AContext.Connection.Disconnect;
Exit;
end;
Conexao.IP := AContext.Binding.PeerIP;
Conexao.HWID := Retorno[1];
Conexao.Connected := Now;
Conexao.Ping := Ticks;
ClientStateUpdated(Conexao, RetornaTraducao(40){'connect'});
end;
procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
Conexao : TClient;
begin
Conexao := TClient(AContext);
if Conexao.Connected <> 0 then
ClientStateUpdated(Conexao, RetornaTraducao(...){'disconnect'});
end;

Delphi Indy TCP connection to RECON

I am trying to figure out how would be possible to get a connection and authentication stablished with the remote console.
This Wiki Wiki 1 and this one Wiki 2 tell me I need to build a packet and send it to the RECON, but I do not know how to do this..
I am a newbie with networking but since I was searching over there then I build this:
procedure TForm1.Button1Click(Sender: TObject);
begin
IdTCPClient1.Host:= '127.0.0.1';
IdTCPClient1.Port:= 20001;
IdTCPClient1.Connect;
IdTcpClient1.IOHandler.Writeln('1234');
ShowMessage(IdTcpClient1.IOHandler.ReadLn);
end;
I am stucked there, where 1234 is the RECON password and the message that it return: Connection closed gracefully...
Finally, how can I log in successfully? And at least send a command "list" the next step would be receive the console log in realtime?
Thanks
Your code is not implementing the Source RECON protocol that the Minecraft commands run on top of. You can't just send arbitrary data to the server, it has to be framed properly.
Try something more like this instead:
const
SERVERDATA_AUTH = 3;
SERVERDATA_AUTH_RESPONSE = 2;
SERVERDATA_EXECCOMMAND = 2;
SERVERDATA_RESPONSE_VALUE = 0;
procedure TForm1.Button1Click(Sender: TObject);
begin
IdTCPClient1.Host := '127.0.0.1';
IdTCPClient1.Port := 20001;
IdTCPClient1.Connect;
SendRECONLogin('1234');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
IdTCPClient1.Disconnect;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
SendRECONCommand('list');
end;
procedure TForm1.IdTCPClient1Connect(Sender: TObject);
begin
Timer1.Enabled := True;
end;
procedure TForm1.IdTCPClient1Disconnect(Sender: TObject);
begin
Timer1.Enabled := False;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
RespID: Int32;
PktType: Int32;
Payload: string;
begin
try
if not IdTCPClient1.Connected then
Exit;
if IdTCPClient1.IOHandler.InputBufferIsEmpty then
begin
IdTCPClient1.IOHandler.CheckForDataOnSource(0);
IdTCPClient1.IOHandler.CheckForDisconnect(True, False);
if IdTCPClient1.IOHandler.InputBufferIsEmpty then Exit;
end;
RespID := ReadRECONPacket(PktType, Payload);
case PktType of
SERVERDATA_AUTH_RESPONSE: begin
if RespID = -1 then begin
// authentication failed...
IdTCPClient1.Disconnect;
end else begin
// authentication successful...
end;
end;
SERVERDATA_RESPONSE_VALUE: begin
// match RespID to previously sent ReqID
// and handle Payload as needed...
end;
end;
except
IdTCPClient1.Disconnect;
end;
end;
var
gReqID: Int32 = 0;
function TForm1.SendRECONPacket(PktType: Int32; const Payload: string = ''): Int32;
var
Bytes: TIdBytes;
begin
Bytes := IndyTextEncoding_ASCII.GetBytes(Payload);
try
if gReqID < MaxInt then Inc(gReqID)
else gReqID := 1;
Result := gReqID;
IdTCPClient1.IOHandler.WriteBufferOpen;
try
IdTCPClient1.IOHandler.Write(Int32(Length(Bytes)+10), False);
IdTCPClient1.IOHandler.Write(Result, False);
IdTCPClient1.IOHandler.Write(PktType, False);
IdTCPClient1.IOHandler.Write(Bytes);
IdTCPClient1.IOHandler.Write(UInt16(0), False);
IdTCPClient1.IOHandler.WriteBufferClose;
except
IdTCPClient1.IOHandler.WriteBufferCancel;
raise;
end;
except
IdTCPClient1.Disconnect;
raise;
end;
end;
function TForm1.SendRECONLogin(const Password: String): Int32;
begin
Result := SendRECONPacket(SERVERDATA_AUTH, Password);
end;
function TForm1.SendRECONCommand(const Cmd: String): Int32;
begin
Result := SendRECONPacket(SERVERDATA_EXECCOMMAND, Cmd);
end;
function TForm1.ReadRECONPacket(var PktType: Integer; var Payload: String): Int32;
var
Len: Int32;
begin
try
Len := IdTCPClient1.IOHandler.ReadInt32(False);
Result := IdTCPClient1.IOHandler.ReadInt32(False);
PktType := IdTCPClient1.IOHandler.ReadInt32(False);
Payload := IdTCPClient1.IOHandler.ReadString(Len-10, IndyTextEncoding_ASCII);
IdTCPClient1.IOHandler.Discard(2);
except
IdTCPClient1.Disconnect;
raise;
end;
end;
Note that RCON is an asynchronous protocol. Each command contains a request ID, which is echoed back in the response. Multiple commands can be sent to the server without waiting for their replies. That is why I wrote SendRCONPacket() to return the request ID actually used, so you can save it off somewhere and match it to the response ID returned by ReadRCONPacket(). The use of a TTimer in the above code is just an example of how to receive unsolicited data from the server. In production code, I would suggest using a dedicated reading thread instead of a timer, and let the thread notify the rest of your code whenever a packet arrives.
If you are not planning on ever having multiple commands being processed in parallel, then you could get rid of the timer altogether and do something more like this instead:
const
SERVERDATA_AUTH = 3;
SERVERDATA_AUTH_RESPONSE = 2;
SERVERDATA_EXECCOMMAND = 2;
SERVERDATA_RESPONSE_VALUE = 0;
procedure TForm1.Button1Click(Sender: TObject);
var
Reply: string;
begin
IdTCPClient1.Host := '127.0.0.1';
IdTCPClient1.Port := 20001;
IdTCPClient1.Connect;
SendRECONLogin('1234');
ShowMessage('Conectado exitosamente');
Reply := SendRECONCommand('say Hello');
// use Reply as needed...
ShowMessage(Reply);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
IdTCPClient1.Disconnect;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
Reply: string;
begin
Reply := SendRECONCommand('list');
// use Reply as needed...
ShowMessage(Reply);
end;
var
gReqID: Int32 = 0;
function TForm1.SendRECONPacket(PktType: Int32; const Payload: string = ''): Int32;
var
Bytes: TIdBytes;
begin
Bytes := IndyTextEncoding_ASCII.GetBytes(Payload);
try
if gReqID < MaxInt then Inc(gReqID)
else gReqID := 1;
Result := gReqID;
IdTCPClient1.IOHandler.WriteBufferOpen;
try
IdTCPClient1.IOHandler.Write(Int32(Length(Bytes)+10), False);
IdTCPClient1.IOHandler.Write(Result, False);
IdTCPClient1.IOHandler.Write(PktType, False);
IdTCPClient1.IOHandler.Write(Bytes);
IdTCPClient1.IOHandler.Write(UInt16(0), False);
IdTCPClient1.IOHandler.WriteBufferClose;
except
IdTCPClient1.IOHandler.WriteBufferCancel;
raise;
end;
except
IdTCPClient1.Disconnect;
raise;
end;
end;
procedure TForm1.SendRECONLogin(const Password: String);
var
ReqID, RespID, PktType: Int32;
Reply: String;
begin
{
From https://developer.valvesoftware.com/wiki/Source_RCON_Protocol#SERVERDATA_AUTH_RESPONSE:
When the server receives an auth request, it will respond with an empty SERVERDATA_RESPONSE_VALUE,
followed immediately by a SERVERDATA_AUTH_RESPONSE indicating whether authentication succeeded or
failed. Note that the status code is returned in the packet id field, so when pairing the response with the
original auth request, you may need to look at the packet id of the preceeding SERVERDATA_RESPONSE_VALUE.
}
// in testing, there is no empty SERVERDATA_RESPONSE_VALUE sent before SERVERDATA_AUTH_RESPONSE!
ReqID := SendRECONPacket(SERVERDATA_AUTH, Password);
RespID := ReadRECONPacket(PktType, Reply);
if PktType = SERVERDATA_RESPONSE_VALUE then
begin
if RespID <> ReqID then
raise Exception.Create('Received unexpected packet');
RespID := ReadRECONPacket(PktType, Reply);
end;
if PktType <> SERVERDATA_AUTH_RESPONSE then
raise Exception.Create('Received unexpected packet');
if RespID <> ReqID then
begin
if RespID <> -1 then
raise Exception.Create('Received unexpected packet');
raise Exception.Create('Authentication failed');
end;
end;
function TForm1.SendRECONCommand(const Cmd: String): string;
var
ReqID, TermReqID, RespID, PktType: Int32;
Reply: string;
begin
{
From https://developer.valvesoftware.com/wiki/Source_RCON_Protocol#Multiple-packet_Responses:
Most responses are small enough to fit within the maximum possible packet size of 4096 bytes.
However, a few commands such as cvarlist and, occasionally, status produce responses too
long to be sent in one response packet. When this happens, the server will split the response
into multiple SERVERDATA_RESPONSE_VALUE packets. Unfortunately, it can be difficult to
accurately determine from the first packet alone whether the response has been split.
One common workaround is for the client to send an empty SERVERDATA_RESPONSE_VALUE
packet after every SERVERDATA_EXECCOMMAND request. Rather than throwing out the
erroneous request, SRCDS mirrors it back to the client, followed by another RESPONSE_VALUE
packet containing 0x0000 0001 0000 0000 in the packet body field. Because SRCDS always
responds to requests in the order it receives them, receiving a response packet with an empty
packet body guarantees that all of the meaningful response packets have already been received.
Then, the response bodies can simply be concatenated to build the full response.
}
// in testing, there is no mirrored SERVERDATA_RESPONSE_VALUE! The sent SERVERDATA_RESPONSE_VALUE
// is responded with a single SERVERDATA_RESPONSE_VALUE that says 'Unknown request' in its payload!
ReqID := SendRECONPacket(SERVERDATA_EXECCOMMAND, Cmd);
TermReqID := SendRECONPacket(SERVERDATA_RESPONSE_VALUE, '');
repeat
RespID := ReadRECONPacket(PktType, Reply);
if PktType <> SERVERDATA_RESPONSE_VALUE then
raise Exception.Create('Received unexpected packet');
if RespID <> ReqID then
begin
if RespID <> TermReqID then
raise Exception.Create('Received unexpected packet');
{
RespID := ReadRECONPacket(PktType, Reply);
if (PktType <> SERVERDATA_RESPONSE_VALUE) or (RespID <> TermReqID) then
raise Exception.Create('Received unexpected packet');
}
Break;
end;
Result := Result + Reply;
until False;
end;
function TForm1.ReadRECONPacket(var PktType: Integer; var Payload: String): Int32;
var
Len: Int32;
begin
try
Len := IdTCPClient1.IOHandler.ReadInt32(False);
Result := IdTCPClient1.IOHandler.ReadInt32(False);
PktType := IdTCPClient1.IOHandler.ReadInt32(False);
Payload := IdTCPClient1.IOHandler.ReadString(Len-10, IndyTextEncoding_ASCII);
IdTCPClient1.IOHandler.Discard(2);
except
IdTCPClient1.Disconnect;
raise;
end;
end;

indy TCP and activex connect to server issues

I am trying to transform my delphi project from VCL to ActiveX. I have issues with a client thread. Here is my client thread type:
type
TClientThread = class(TThread)
private
Command: string;
procedure HandleInput;
protected
procedure Execute; override;
end;
And here is the implementation:
procedure TClientThread.HandleInput;
begin
activext.ProcessCommands(Command);
Command := '';
end;
procedure Tactivextest.ProcessCommands(Command: string);
var
Params: array [1 .. 10] of String;
ParamsCount, P: Integer;
PackedParams: TPackedParams;
PStr: String;
IdBytes: TIdBytes;
Ms: TMemoryStream;
ReceiveParams, ReceiveStream: Boolean;
Size: Int64;
begin
Ms := TMemoryStream.Create;
ReceiveParams := False;
ReceiveStream := False;
if Command[1] = '1' then // command with params
begin
Command := Copy(Command, 2, Length(Command));
ReceiveParams := True;
end
else if Command[1] = '2' then // command + memorystream
begin
Command := Copy(Command, 2, Length(Command));
ReceiveStream := True;
Ms.Position := 0;
end
else if Command[1] = '3' then // command with params + memorystream
begin
Command := Copy(Command, 2, Length(Command));
ReceiveParams := True;
ReceiveStream := True;
end;
if ReceiveParams then // params incomming
begin
TCPClient.Socket.ReadBytes(IdBytes, SizeOf(PackedParams), False);
BytesToRaw(IdBytes, PackedParams, SizeOf(PackedParams));
ParamsCount := 0;
repeat
Inc(ParamsCount);
P := Pos(Sep, String(PackedParams.Params));
Params[ParamsCount] := Copy(String(PackedParams.Params), 1, P - 1);
Delete(PackedParams.Params, 1, P + 4);
until PackedParams.Params = '';
end;
if ReceiveStream then // stream incomming
begin
Size := TCPClient.Socket.ReadInt64;
TCPClient.Socket.ReadStream(Ms, Size, False);
Ms.Position := 0;
end;
if Command = 'SIMPLEMESSAGE' then
begin
MessageDlg(Params[1], mtInformation, [mbOk], 0);
end;
if Command = 'INVALIDPASSWORD' then
begin
TCPClient.Disconnect;
MessageDlg('Invalid password!', mtError, [mbOk], 0);
end;
if Command = 'SENDYOURINFO' then // succesfully loged in
begin
UniqueID := StrToInt(Params[1]);
Panel1.Caption := 'connect ' + namewithicon + ')';
PStr := namewithicon + Sep;
SendCommandWithParams(TCPClient, 'TAKEMYINFO', PStr);
end;
if Command = 'DISCONNECTED' then
begin
if TCPClient.Connected then
TCPClient.Disconnect;
end;
if Command = 'TEXTMESSAGE' then
begin
memo1.Lines.Add(Params[1] + ' : ' + Params[2] )
end;
end;
procedure TClientThread.Execute;
begin
inherited;
while not Terminated do
begin
if not activext.TCPClient.Connected then
Terminate
else
begin
if activext.TCPClient.Connected then
Command := activext.TCPClient.Socket.ReadLn('', 5);
if Command <> '' then
Synchronize(HandleInput);
end;
end;
end;
initialization
TActiveFormFactory.Create(
ComServer,
TActiveFormControl,
Tactivextest,
Class_activextest,
0,
'',
OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
tmApartment);
end.
And here is how I start the client thread with Indy's TCP OnConnected event:
procedure Tactivextest.TCPClientConnected(Sender: TObject);
begin
ClientThread := TClientThread.Create(True);
ClientThread.Start;
SendCommandWithParams(TCPClient, 'LOGIN', namewithicon + Sep);
end;
And here is how I connect to the server on the Form's OnCreate event:
begin
if not TCPClient.Connected then
begin
TCPClient.Host := 'localhost';
TCPClient.Port := 31000;
try
TCPClient.Connect;
except
on E: Exception do
begin
MessageDlg('Cannot connect to server!', mtInformation, [mbOk], 0);
Application.Terminate;
end;
end;
end
else
begin
SendCommand(TCPClient, 'DISCONNECTED');
if TCPClient.Connected then
TCPClient.Disconnect;
end;
end;
send commands
procedure Tactivextest.SendBuffer(TCPClient: TIdTCPClient; Buffer: TIdBytes;
BufferSize: Cardinal);
begin
if not TCPClient.Connected then
Exit;
TCPClient.Socket.WriteLn('AUDIO');
TCPClient.Socket.Write(BufferSize);
TCPClient.Socket.Write(Buffer, BufferSize);
end;
procedure Tactivextest.SendCommand(TCPClient: TIdTCPClient; Command: string);
begin
if not TCPClient.Connected then
Exit;
TCPClient.Socket.WriteLn(Command);
end;
procedure Tactivextest.SendCommandWithParams(TCPClient: TIdTCPClient;
Command, Params: String);
var
PackedParams: TPackedParams;
begin
if not TCPClient.Connected then
Exit;
TCPClient.Socket.WriteLn('1' + Command);
PackedParams.Params := ShortString(Params);
TCPClient.Socket.Write(RawToBytes(PackedParams, SizeOf(PackedParams)));
end;
procedure Tactivextest.SendStream(TCPClient: TIdTCPClient; Ms: TMemoryStream);
begin
if not TCPClient.Connected then
Exit;
Ms.Position := 0;
with TCPClient.Socket do
begin
Write(Ms.Size);
WriteBufferOpen;
Write(Ms, 0);
WriteBufferClose;
end;
end;
procedure Tactivextest.SendCommandAndStream(TCPClient: TIdTCPClient; Command: String;
Ms: TMemoryStream);
begin
if not TCPClient.Connected then
Exit;
TCPClient.Socket.WriteLn('2' + Command);
Ms.Position := 0;
with TCPClient.Socket do
begin
Write(Ms.Size);
WriteBufferOpen;
Write(Ms, 0);
WriteBufferClose;
end;
end;
procedure Tactivextest.SendCommandWithParamsAndStream(TCPClient: TIdTCPClient;
Command, Params: String; Ms: TMemoryStream);
var
PackedParams: TPackedParams;
begin
if not TCPClient.Connected then
Exit;
SendCommand(TCPClient, '3' + Command);
PackedParams.Params := ShortString(Params);
TCPClient.Socket.Write(RawToBytes(PackedParams, SizeOf(PackedParams)));
Ms.Position := 0;
with TCPClient.Socket do
begin
Write(Ms.Size);
WriteBufferOpen;
Write(Ms, 0);
WriteBufferClose;
end;
end;
I am able to connect to the server, but the client thread cannot be started same as VCL so I am unable to call SendCommands() as I have been disconnected because I cannot use client thread inside ActiveX. I have searched for many days about how to solve, and I cannot find a solution to this problem. I know ActiveX is dead, but this is for education purposes.
It is not possible for TIdTCPClient.OnConnected to not be triggered if Connect() is successful, so the client thread has to be getting created. And if Start() is not raising an exception, then the thread will start running.
However, a major problem with your thread code is that HandleInput() is being run in the context of the main thread via TThread.Synchronize(), which DOES NOT work in a DLL (ActiveX or otherwise) without extra cooperation of the main thread of the hosting EXE. HandleInput() should not be synchronized at all, but then once you fix that, ProcessCommands() is doing things that are not thread-safe (using MessageDlg(), and accessing Panel1 and Memo1 directly), which do need to be synchronized.
So, you need to re-write your thread logic to avoid these pitfalls. Try something more like this:
type
TClientThread = class(TThread)
protected
procedure Execute; override;
end;
procedure TClientThread.Execute;
begin
activext.SendCommandWithParams(activext.TCPClient, 'LOGIN', activext.namewithicon + activext.Sep);
while (not Terminated) and activext.TCPClient.Connected do
begin
Command := activext.TCPClient.Socket.ReadLn('', 5);
if Command <> '' then
activext.ProcessCommands(Command);
end;
end;
type
Tactivextest = class(TActiveForm)
TCPClient: TIdTCPClient;
...
private
...
LineToAdd: string;
procedure UpdatePanel;
procedure AddLineToMemo;
...
end;
procedure Tactivextest.FormCreate(Sender: TObject);
begin
TCPClient.Host := 'localhost';
TCPClient.Port := 31000;
try
TCPClient.Connect;
except
on E: Exception do
begin
MessageBox(0, 'Cannot connect to server!', 'Error', MB_OK);
raise;
end;
end;
end;
// TTimer OnTimer event handler
procedure Tactivextest.Timer1Timer(Sender: TObject);
begin
// needed for TThread.Synchronize() to work in a DLL...
CheckSynchronize;
end;
procedure Tactivextest.TCPClientConnected(Sender: TObject);
begin
ClientThread := TClientThread.Create(False);
end;
procedure Tactivextest.UpdatePanel;
begin
Panel1.Caption := 'connect ' + namewithicon + ')';
end;
procedure Tactivextest.AddLineToMemo;
begin
Memo1.Lines.Add(LineToAdd);
end;
procedure Tactivextest.ProcessCommands(Command: string);
var
Params: array [1 .. 10] of String;
ParamsCount, P: Integer;
PackedParams: TPackedParams;
IdBytes: TIdBytes;
Ms: TMemoryStream;
ReceiveParams, ReceiveStream: Boolean;
Size: Int64;
begin
ReceiveParams := False;
ReceiveStream := False;
Ms := TMemoryStream.Create;
try
case Command[1] of
'1': // command with params
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := True;
end;
'2': // command + stream
begin
Command := Copy(Command, 2, MaxInt);
ReceiveStream := True;
end;
'3': // command with params + stream
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := True;
ReceiveStream := True;
end;
end;
if ReceiveParams then // params incoming
begin
TCPClient.Socket.ReadBytes(IdBytes, SizeOf(PackedParams), False);
BytesToRaw(IdBytes, PackedParams, SizeOf(PackedParams));
ParamsCount := 0;
repeat
Inc(ParamsCount);
P := Pos(Sep, String(PackedParams.Params));
Params[ParamsCount] := Copy(String(PackedParams.Params), 1, P - 1);
Delete(PackedParams.Params, 1, P + 4);
until (PackedParams.Params = '') or (ParamsCount = 10);
end;
if ReceiveStream then // stream incoming
begin
Size := TCPClient.Socket.ReadInt64;
if Size > 0 then
begin
TCPClient.Socket.ReadStream(Ms, Size, False);
Ms.Position := 0;
end;
end;
if Command = 'SIMPLEMESSAGE' then
begin
MessageBox(0, PChar(Params[1]), 'Message', MB_OK);
end
else if Command = 'INVALIDPASSWORD' then
begin
TCPClient.Disconnect;
MessageBox(0, 'Invalid password!', 'Error', MB_OK);
end
else if Command = 'SENDYOURINFO' then // successfully logged in
begin
UniqueID := StrToInt(Params[1]);
TThread.Synchronize(nil, UpdatePanel);
SendCommandWithParams(TCPClient, 'TAKEMYINFO', namewithicon + Sep);
end
else if Command = 'DISCONNECTED' then
begin
TCPClient.Disconnect;
end
else if Command = 'TEXTMESSAGE' then
begin
LineToAdd := Params[1] + ' : ' + Params[2];
TThread.Synchronize(nil, AddLineToMemo);
end;
finally
Ms.Free;
end;
end;
initialization
TActiveFormFactory.Create(
ComServer,
TActiveFormControl,
Tactivextest,
Class_activextest,
0,
'',
OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
tmApartment);
end.

Indy Dynamic Create Server Client connecting error 10061

I am having trouble dynamically creating some INDY communication. I have not used Indy before and I can't get the server set up right. I get the error 10061. I have added a rule to the fire wall to allow this application and the port. It works if I use TServerSocket and TClientSocket but I need to use Indy.
This code does not work
procedure TForm3.Button3Click(Sender: TObject);
var
temp : TIdSocketHandles;
begin
fIdTCPServer1 := TIdTCPServer.Create(nil);
fIdTCPClient1 := TIdTCPClient.Create(nil);
temp := TIdSocketHandles.Create(fIdTCPServer1);
temp.Add.IP := 'xxx.xx.xxx.xx';//'localhost'; //gave error when tryingn to use local host
temp.Add.Port := 20200;
fIdTCPServer1.Bindings := temp;
fIdTCPServer1.OnExecute := IdTCPServer1Execute;
fIdTCPServer1.StartListening();
fIdTCPClient1.Port := 20200;
fIdTCPClient1.Host := 'xxx.xx.xxx.xx';//'localhost';
fIdTCPClient1.Connect; //error 10061 here
fIdTCPClient1.IOHandler.WriteLn('Some message');
end;
procedure TForm3.IdTCPServer1Execute(AContext: TIdContext);
var
inStr : String;
begin
inStr := AContext.Connection.IOHandler.ReadLn;
ShowMessage('Server received : ' + inStr);
end;
This code works
procedure TForm3.Button1Click(Sender: TObject);
begin
serverSocket1 := TServerSocket.Create(nil);
clientSocket1 := TClientSocket.Create(nil);
serverSocket1.Port := 20200;
serverSocket1.OnClientRead := ServerSocket1ClientRead;
serverSocket1.Active := True;
clientSocket1.Port := 20200;
clientSocket1.Host := 'localhost';
clientSocket1.Active := True;
clientSocket1.Socket.SendText('Some message');
end;
procedure TForm3.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
inStr : String;
begin
inStr := Socket.ReceiveText();
ShowMessage('Server received : ' + inStr);
end;
You need to set both IP address and port on each binding.
// Here you're adding a binding and setting only the IP address
temp.Add.IP := 'xxx.xx.xxx.xx';
// Here you're adding another binding and setting only the port
temp.Add.Port := 20200;
Here's an easy way to do it properly:
with fIdTCPServer1.Bindings.Add do
begin
IP := '127.0.0.1'; // Use IP address, not host name. Localhost = 127.0.0.1
Port := 20200;
end;
Here's another, more verbose, way to do it (add IdSocketHandle to your uses clause):
var
socketHandle: TIdSocketHandle;
begin
socketHandle := fIdTCPServer1.Bindings.Add;
socketHandle.IP := '127.0.0.1';
socketHandle.Port := 20200;
end;
Also, to start it up, you just need to set Active to true like this:
fIdTCPServer1.Active := True;
There are a few problems with your code.
you are misusing the TIdTCPServer.Bindings, and you are not activating the server correctly.
you are calling ShowMessage() in the OnExecute event, but TIdTCPServer is multithreaded component (each connected client runs in its own thread) and ShowMessage() is not thread-safe.
you have some potential memory leaks in your code.
Try this instead:
procedure TForm3.Button3Click(Sender: TObject);
var
temp : TIdSocketHandle;
begin
if fIdTCPServer1 = nil then
begin
fIdTCPServer1 := TIdTCPServer.Create(Self);
temp := fIdTCPServer1.Bindings.Add;
temp.IP := 'xxx.xx.xxx.xx';//'localhost'; //gave error when tryingn to use local host
temp.Port := 20200;
fIdTCPServer1.OnExecute := IdTCPServer1Execute;
fIdTCPServer1.Active := True;
end;
if fIdTCPClient1 = nil then
begin
fIdTCPClient1 := TIdTCPClient.Create(Self);
fIdTCPClient1.Port := 20200;
fIdTCPClient1.Host := 'xxx.xx.xxx.xx';//'localhost';
end;
fIdTCPClient1.Connect;
fIdTCPClient1.IOHandler.WriteLn('Some message');
end;
procedure TForm3.IdTCPServer1Execute(AContext: TIdContext);
var
inStr : String;
begin
inStr := AContext.Connection.IOHandler.ReadLn;
Windows.MessageBox(0, PChar(inStr), PChar('Server received'), MB_OK);
end;

File not received if I free the instance of filestream anywhere?

I am trying to send a file using TServerSocket/TClientSocket. The file is sent completely as long as I do not free the filestream anywhere and by anywhere I mean form.OnCreate event too. If I do free anywhere only 1 or 2 percent is sent.
I also have to put the TFileStream.Create line of code on the server side OnCreate event. If I create a stream in TForm2.ServerSocket1ClientRead then I get an EFcreateerror: 'the process cannot access file because it is being used by another process''.
procedure TForm2.FormCreate(Sender: TObject);
begin
FStream := TFileStream.Create('c:\temp\log.txt', fmCreate or
fmShareDenyWrite);
end;
procedure TForm2.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
var
fs: TFileStream;
begin
fs := TFileStream.Create('c:\log.txt', fmOpenRead);
socket.SendStream(fs);
end;
procedure TForm2.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
iLen: Integer;
Bfr: Pointer;
begin
iLen := Socket.ReceiveLength;
GetMem(Bfr, iLen);
Socket.ReceiveBuf(Bfr^, iLen);
FStream.Write(Bfr^, iLen);
FreeMem(bfr);
//fstream.free
end;
Even if I put my code this way:
if fstream.Size = fstream.position then
fstream.free
Even then it gives me problem.
What is this strange phenomena? Is it a bug in Delphi? If yes is there a
work-around? If it matters: I am using Delphi 2010.
Update: sorry I meant if I put my code this way:
if fileSize = fstream.position then
fstream.free
Sorry, not fstream.size but filesize. I have already initialised file size as 300000 (size of file to be received).
Solved: Solved by replacing
FStream := TFileStream.Create('c:\temp\log.txt',
fmCreate or fmShareDenyWrite);
with
if not FileExists('c:\temp\log.txt') then
FStream := TFileStream.Create('c:\temp\log.txt',
fmCreate or fmShareDenyWrite);
You are trying to free your FStream object as soon as you receive the first block of data. Do not do that. That block will usually be smaller than the full file, especially if you are sending a large file. Also, checking for Position = Size on the receiving end is useless as well, as it will always evaluate be true since the current Position will always be at the end of the stream. As I already told you in the other discussion, you are not using the SendStream() and ReceiveBuf() methods effectively, and the sender needs to send the file size before sending the file data (or alternatively disconnect at the end of the file) so the receiver knows exactly when to stop its reading.
Edit:
Try something like this:
type
TSocketBuffer = class
public
Stream: TStream;
ExpectedSize: Int64;
Data: array[0..1023] of Byte;
DataOffset, DataSize: Integer;
destructor Destroy; override;
end;
TServerSocketBuffer = class(TSocketBuffer)
public
FileName: String;
destructor Destroy; override;
end;
destructor TSocketBuffer.Destroy;
begin
if Stream <> nil then Stream.Free;
inherited;
end;
destructor TServerSocketBuffer.Destroy;
begin
if Stream <> nil then FreeAndNil(Stream);
if FileName <> '' then DeleteFile(FileName);
inherited;
end;
procedure TForm2.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
var
Buffer: TSocketBuffer;
begin
Buffer := TSocketBuffer.Create;
Socket.Data := Buffer;
// open the file to send...
Buffer.Stream := TFileStream.Create('c:\log.txt', fmOpenRead or fmShareDenyWrite);
Buffer.ExpectedSize := Buffer.Stream.Size;
// buffer the stream size...
Move(Buffer.Data[0], Buffer.ExpectedSize, Sizeof(Int64));
Buffer.DataOffset := 0;
Buffer.DataSize := SizeOf(Int64);
// begin sending...
ClientSocket1Write(Sender, Socket);
end;
procedure TForm2.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
TSocketBuffer(Socket.Data).Free;
end;
procedure TForm2.ClientSocket1Write(Sender: TObject; Socket: TCustomWinSocket);
var
Buffer: TSocketBuffer;
NumBytes: Integer;
begin
// in case OnWrite is fired before OnConnect...
if Socket.Data = nil then Exit;
Buffer := TSocketBuffer(Socket.Data);
if Buffer.Stream = nil then Exit;
// keep sending until EOF is reached, or until the socket blocks/errors...
repeat
// if there is pending data buffered, send it now...
while Buffer.DataOffset < Buffer.DataSize do
begin
NumBytes := Socket.SendBuf(Buffer.Data[Buffer.DataOffset], Buffer.DataSize-Buffer.DataOffset);
if NumBytes <= 0 then Exit; // wait for next event...
Inc(Buffer.DataOffset, NumBytes);
end;
// has EOF been reached?
if Buffer.ExpectedSize <= 0 then Break;
// read the next block of data from the stream...
Buffer.DataOffset := 0;
Buffer.DataSize := 0;
NumBytes := Buffer.Stream.Read(Buffer.Data[0], Min(Buffer.ExpectedSize, SizeOf(Buffer.Data)));
if NumBytes <= 0 then Break; // stream error, stop sending...
Buffer.DataSize := NumBytes;
Dec(Buffer.ExpectedSize, NumBytes);
// the next loop iteration will start sending it...
until False;
// all done...
FreeAndNil(Buffer.Stream);
Socket.Close;
end;
procedure TForm2.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Socket.Data := TServerSocketBuffer.Create;
end;
procedure TForm2.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
TServerSocketBuffer(Socket.Data).Free;
end;
procedure TForm2.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
Buffer: TServerSocketBuffer;
FileName: String;
NumBytes: Integer;
begin
Buffer := TServerSocketBuffer(Socket.Data);
if Buffer.Stream = nil then
begin
// keep reading until stream size has been received in full...
while Buffer.DataSize < SizeOf(Int64) do
begin
NumBytes := Socket.ReceiveBuf(Buffer.Data[Buffer.DataOffset], SizeOf(Int64)-Buffer.DataOffset);
if NumBytes <= 0 then Exit; // wait for next event...
Inc(Buffer.DataSize, NumBytes);
Inc(Buffer.DataOffset, NumBytes);
end;
Move(Buffer.ExpectedSize, Buffer.Data[0], SizeOf(Int64));
// create the file to store in...
FileName := 'c:\temp\log.txt';
Buffer.Stream := TFileStream.Create(FileName, fmCreate);
Buffer.FileName := FileName;
// (optional) pre-size the file...
Buffer.Stream.Size := Buffer.ExpectedSize;
end;
// keep reading until EOF is reached, or until the socket blocks/errors...
while Buffer.ExpectedSize > 0 do
begin
// read the next block of data from the socket...
Buffer.DataOffset := 0;
Buffer.DataSize := 0;
NumBytes := Socket.ReceiveBuf(Buffer.Data[0], Min(Buffer.ExpectedSize, SizeOf(Buffer.Data)));
if NumBytes <= 0 then Exit; // wait for next event...
Buffer.DataSize := NumBytes;
// save the data to the stream....
repeat
NumBytes := Buffer.Stream.Write(Buffer.Data[Buffer.DataOffset], Buffer.DataSize-Buffer.DataOffset);
if NumBytes <= 0 then
// stream error, stop reading...
Socket.Close;
Exit;
end;
Inc(Buffer.DataOffset, NumBytes);
Dec(Buffer.ExpectedSize, NumBytes);
until Buffer.DataOffset >= Buffer.DataSize;
end;
// all done...
FreeAndNil(Buffer.Stream);
Buffer.FileName := '';
end;

Resources