why when i give each client its own DataAvaialbe i hav eno problems at all
what is the diffrence ? and should i do that with all other events ?
في الأحد، 12 أغسطس 2018 في 7:48 م تمت كتابة ما يلي بواسطة عاشقه كبريائي <
madamma...@gmail.com>:
> 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
