i have created a tcp server using Twsocket but after 40 clients connected
the server stopped from listing
i dont use any VCL inside the server i just do some database query and send
some data to all connected clients
i dont know what i am doing wrong
here is my server code
unit Mainserv;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdGlobal, Vcl.StdCtrls,
Vcl.ExtCtrls,
Vcl.Imaging.GIFImg, Vcl.Imaging.pngimage, JPEG, System.DateUtils,
OverbyteIcsWndControl, OverbyteIcsWSocket, OverbyteIcsWSocketS;
const
Sep = '~';
type
TConnection = class(TWSocketClient)
private
procedure ISALIVE;
public
cName: String;
cpassword : string;
IP: String;
Connected: TDateTime;
Cuserid: string;
CisLoggedin : string;
CANENETR : string;
status : integer;
ForceDC : String;
procedure broadcastleft(const usernameleft: string);
procedure SendCommandWithParams(const Command: String);
procedure HandleLogin;
procedure broadcastjoin;
procedure broadcastmsg(const msgtxt: String);
procedure SendClientsList;
end;
type
TForm3 = class(TForm)
Panel1: TPanel;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
servertcp: TWSocketServer;
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure servertcpBgException(Sender: TObject; E: Exception;
var CanClose: Boolean);
procedure servertcpClientConnect(Sender: TObject; Client:
TWSocketClient;
Error: Word);
procedure servertcpClientDisconnect(Sender: TObject; Client:
TWSocketClient;
Error: Word);
procedure servertcpDataAvailable(Sender: TObject; ErrCode: Word);
private
procedure UpdateBindings;
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
uses crypto, mysql_qry, constant;
{$R *.dfm}
{ TConnection }
procedure TForm3.Button1Click(Sender: TObject);
begin
UpdateBindings;
servertcp.ClientClass := TConnection;
LastUniqueID := 100;
end;
procedure TForm3.Button2Click(Sender: TObject);
begin
servertcp.Close;
end;
procedure TForm3.FormDestroy(Sender: TObject);
begin
servertcp.Close;
end;
procedure TConnection.ISALIVE;
var
I: integer;
uclient: TConnection;
begin
if self.CnotAllowed = 'YES' then
begin
exit;
end;
self.Connected := Now;
for i := 0 to TWSocketServer(Server).ClientCount -1 do
begin
uclient := TConnection(TWSocketServer(Server).Client[i]);
if (sametext(uclient.Chatname, self.Chatname))
And (uclient.ForceDC = 'NO')
And (SecondsBetween(Now, uclient.Connected) >= 75) then
begin
uclient.ForceDC := 'YES';
uclient.Close;
end;
end;
end;
procedure TForm3.servertcpDataAvailable(Sender: TObject; ErrCode: Word);
var
CCLIENT: TConnection;
Command: String;
cmdhandle : string;
Startercommand : String;
Params: array [1 .. 200] of String;
ParamsCount, P: integer;
ReceiveParams: BOOLEAN;
I: integer;
DECODES : String;
begin
CCLIENT := Sender as TConnection;
Startercommand := CCLIENT.ReceiveStrW(CP_UTF8);
Command := Startercommand;
if Command = '' then
begin
exit;
end;
Command := replace(Command,#13,'');
Command := replace(Command,#10,'');
ReceiveParams := False;
//Command Type
if Command[1] = '1' then // none crypted
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := true;
end else
if Command[1] = '2' then // crypted
begin
Command := Copy(Command, 2, MaxInt);
Command := Decryptstrs(Command);
ReceiveParams := true;
end;
if ReceiveParams = true then // params is incomming
begin
DECODES := Command;
ParamsCount := 0;
while (DECODES <> '') and (ParamsCount < 200) do
begin
Inc(ParamsCount);
P := Pos(Sep, DECODES);
if P = 0 then
Params[ParamsCount] := DECODES
else
begin
Params[ParamsCount] := Copy(DECODES, 1, P - 1);
Delete(DECODES, 1, P);
end;
end;
end;
cmdhandle := Params[1];
if cmdhandle = '' then
begin
Exit;
end;
if cmdhandle = 'LGN' then
begin
if Paramscount <> 3 then
begin
exit;
end;
CCLIENT.cName := Params[2];
CCLIENT.cpassword := Params[3];
CCLIENT.HandleLogin;
end else
if cmdhandle = 'msg' then
begin
if Paramscount <> 2 then
begin
exit;
end;
CCLIENT.broadcastmsg(Params[2]);
end else
if cmdhandle = 'ISALIVE' then
begin
CCLIENT.ISALIVE;
end else
if cmdhandle = 'GETLIST' then
begin
if Paramscount <> 1 then
begin
exit;
end;
CCLIENT.SendClientsList;
end;
end;
procedure TForm3.servertcpBgException(Sender: TObject; E: Exception;
var CanClose: Boolean);
begin
CanClose := True;
end;
procedure TForm3.servertcpClientConnect(Sender: TObject; Client:
TWSocketClient;
Error: Word);
var
CLIENTCONN: TConnection;
begin
CLIENTCONN := Client as TConnection;
CLIENTCONN.LineMode := TRUE;
CLIENTCONN.LineEdit := TRUE;
CLIENTCONN.LineLimit := Maxint; { Do not accept long lines }
CLIENTCONN.LineEnd := #10;
CLIENTCONN.OnDataAvailable := servertcpDataAvailable;
CLIENTCONN.Banner := '';
CLIENTCONN.IP := Client.GetPeerAddr;
CLIENTCONN.Connected := Now;
CLIENTCONN.CisLoggedin := 'NO';
end;
procedure TForm3.servertcpClientDisconnect(Sender: TObject;
Client: TWSocketClient; Error: Word);
var
CLIENTCONN: TConnection;
begin
CLIENTCONN := Client as TConnection;
CLIENTCONN.ForceDC := 'YES';
if CLIENTCONN.CisLoggedin = 'YES' then
begin
CLIENTCONN.CisLoggedin := 'NO';
CLIENTCONN.broadcastleft(CLIENTCONN.cName);
end;
end;
procedure TConnection.SendCommandWithParams(const Command : String);
begin
self.SendStr('1'+Command + #10, CP_UTF8);
end;
procedure TConnection.HandleLogin;
var
I: integer;
cclient: TConnection;
begin
if Checkbanusrindatabase(self.Cname) = True then
begin
Self.Cnotallowed := 'YES';
self.SendCommandWithParams('REJECT&');
exit;
end;
for i := 0 to TWSocketServer(Server).ClientCount -1 do
begin
cclient := TConnection(TWSocketServer(Server).Client[i]);
if (sametext(cclient.cName, self.cName))
And (cclient.CisLoggedin = 'YES') then
begin
self.CANENETR := 'NO';
break;
end;
end;
if self.CANENETR = 'NO' then
begin
self.SendCommandWithParams('invalidin&');
exit;
end;
self.cname := replace(self.cname,' ','');
self.cname := replace(self.cname,#32,'');
if self.cName.Length < 3 then
begin
self.SendCommandWithParams('invalidnn&');
exit;
end;
self.SendCommandWithParams('Logged&' + self.cName + Sep);
self.broadcastjoin;
end;
procedure TConnection.broadcastmsg(const msgtxt: String);
var
I: integer;
Connection: TConnection;
begin
if self.CisLoggedin <> 'YES' then
begin
Exit;
end;
for i := 0 to TWSocketServer(Server).ClientCount -1 do
begin
connection := TConnection(TWSocketServer(Server).Client[i]);
if (Connection.CisLoggedin = 'YES') then
begin
Connection.SendCommandWithParams('msg&' + msgtxt + Sep);
end;
end;
end;
procedure TConnection.broadcastjoin;
var
I: integer;
Connection: TConnection;
begin
if self.CisLoggedin <> 'YES' then
begin
Exit;
end;
for i := 0 to TWSocketServer(Server).ClientCount -1 do
begin
connection := TConnection(TWSocketServer(Server).Client[i]);
if (Connection.CisLoggedin = 'YES') then
begin
Connection.SendCommandWithParams('JOIN&' + self.cName + Sep);
end;
end;
end;
procedure TConnection.broadcastleft(Const usernameleft, useridleft,
usrroomid, usrchatname : string);
var
I: integer;
Connection: TConnection;
begin
for i := 0 to TWSocketServer(Server).ClientCount -1 do
begin
connection := TConnection(TWSocketServer(Server).Client[i]);
if (Connection.CisLoggedin = 'YES') then
begin
Connection.SendCommandWithParams('LEFT&' + usernameleft + Sep + useridleft
+ sep);
end;
end;
end;
procedure TForm3.UpdateBindings;
begin
servertcp.Close;
servertcp.Addr := '0.0.0.0';
servertcp.Port := edit1.Text;
servertcp.Listen;
end;
function SortChannelConnections(List: TStringList; Index1, Index2:
integer): integer;
var
Conn1, Conn2: TConnection;
begin
Conn1 := TConnection(List.Objects[Index1]);
Conn2 := TConnection(List.Objects[Index2]);
if (Conn1.status) > (Conn2.status) then
Result:=1;
if (Conn1.status) < (Conn2.status) then
Result:=-1;
if (Conn1.status) = (Conn2.status) then
Result:=0;
end;
procedure TConnection.SendClientsList;
var
I: integer;
P : integer;
ClientlistStringL: TStringList;
USRCLIENTS: TConnection;
usrlsttext : string;
begin
if self.CisLoggedin <> 'YES' then
begin
Exit;
end;
if self.CnotAllowed = 'YES' then
begin
exit;
end;
ClientlistStringL := TStringList.Create;
try
for i := 0 to TWSocketServer(Server).ClientCount -1 do
begin
USRCLIENTS := TConnection(TWSocketServer(Server).Client[i]);
if (USRCLIENTS.CisLoggedin = 'YES') then
begin
ClientlistStringL.AddObject(USRCLIENTS.cName + Sep, USRCLIENTS);
end;
end;
ClientlistStringL.CustomSort(SortChannelConnections);
for p := 0 to ClientlistStringL.Count - 1 do
begin
usrlsttext := ClientlistStringL.Strings[p];
usrlsttext := replace(usrlsttext,#13,'');
usrlsttext := replace(usrlsttext,#10,'');
usrlsttext := replace(usrlsttext,#$A,'');
usrlsttext := replace(usrlsttext,#$D,'');
usrlsttext := trim(usrlsttext);
usrlsttext := 'GETLIST&'+usrlsttext;
self.SendCommandWithParams(usrlsttext);
end;
finally
FreeAndNil(ClientlistStringL);
end;
self.SendCommandWithParams('LREADY&');
end;
end.
--
To unsubscribe or change your settings for TWSocket mailing list
please goto http://lists.elists.org/cgi-bin/mailman/listinfo/twsocket
Visit our website at http://www.overbyte.be
