I will do the logging I am just a bit confused because this is my first
time to use ics ,
Is there any clear demo to run tcp server in threaded manner ? The demos in
the source confused me too much is there any updated demo to better serv
tcp with threading as you suggested ?
On Sat, Aug 11, 2018, 1:01 PM عاشقه كبريائي <madamma...@gmail.com> wrote:
> 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
