Oto mój program:
unit OverbyteIcsTcpSrv1;
interface
uses
WinTypes, WinProcs, Messages, SysUtils, Dialogs, Classes, Graphics, Controls, Forms,
IniFiles, StdCtrls, ExtCtrls, OverbyteIcsWSocket, OverbyteIcsWSocketS, OverbyteIcsWndControl, mysql;
type
{ TTcpSrvClient is the class which will be instanciated by server component }
{ for each new client. N simultaneous clients means N TTcpSrvClient will be }
{ instanciated. Each being used to handle only a single client. }
{ We can add any data that has to be private for each client, such as }
{ receive buffer or any other data needed for processing. }
TTcpSrvClient = class(TWSocketClient)
public
RcvdLine : String;
ConnectTime : TDateTime;
end;
TTcpSrvForm = class(TForm)
cmd: TMemo;
WSocketServer1: TWSocketServer;
start: TTimer;
procedure WSocketServer1ClientConnect(Sender: TObject;
Client: TWSocketClient; Error: Word);
procedure WSocketServer1BgException(Sender: TObject; E: Exception;
var CanClose: Boolean);
procedure startTimer(Sender: TObject);
procedure WSocketServer1ClientDisconnect(Sender: TObject;
Client: TWSocketClient; Error: Word);
private
procedure ClientDataAvailable(Sender: TObject; Error: Word);
procedure ProcessData(Client : TTcpSrvClient);
procedure ClientBgException(Sender : TObject;
E : Exception;
var CanClose : Boolean);
procedure ClientLineLimitExceeded(Sender : TObject;
Cnt : LongInt;
var ClearData : Boolean);
public
{Public Declarations}
end;
var
TcpSrvForm: TTcpSrvForm;
clients:cardinal; //ilosc klientów
(...)
implementation
{$R *.DFM}
procedure blad(txt:string; const fatal:boolean=false);
var
ef:TextFile;
begin
AssignFile(ef, srv_src+'error.log');
if FileExists(srv_src+'error.log') then Append(ef) else ReWrite(ef);
WriteLn(ef, DateTimeToStr(Now)+'> '+txt+' |Fatal?'+BoolToStr(fatal));
TcpSrvForm.cmd.Lines.Add(DateTimeToStr(Now)+'> '+txt+' |Fatal?'+BoolToStr(fatal));
CloseFile(ef);
if fatal then Application.Terminate;
end;
(...)
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTcpSrvForm.WSocketServer1ClientConnect(
Sender : TObject;
Client : TWSocketClient;
Error : Word);
begin
blad('New Client');
with Client as TTcpSrvClient do begin
clients:=TWSocketServer(Sender).ClientCount;
LineMode := TRUE;
LineEdit := TRUE;
LineLimit := 10000; { Do not accept long lines }
OnDataAvailable := ClientDataAvailable;
OnLineLimitExceeded := ClientLineLimitExceeded;
OnBgException := ClientBgException;
ConnectTime := Now;
SendStr('0 ok');
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTcpSrvForm.ClientLineLimitExceeded(
Sender : TObject;
Cnt : LongInt;
var ClearData : Boolean);
begin
with Sender as TTcpSrvClient do begin
// Display('Line limit exceeded from ' + GetPeerAddr + '. Closing.');
ClearData := TRUE;
Close;
end;
end;
(...)
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is called when listening (server) socket experienced }
{ a background exception. Should normally never occurs. }
procedure TTcpSrvForm.WSocketServer1BgException(
Sender : TObject;
E : Exception;
var CanClose : Boolean);
begin
Blad('Server exception occured: ' + E.ClassName + ': ' + E.Message);
CanClose := FALSE; { Hoping that server will still work ! }
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is called when a client socket experience a background }
{ exception. It is likely to occurs when client aborted connection and data }
{ has not been sent yet. }
procedure TTcpSrvForm.ClientBgException(
Sender : TObject;
E : Exception;
var CanClose : Boolean);
begin
Blad('Client exception occured: ' + E.ClassName + ': ' + E.Message);
CanClose := TRUE; { Goodbye client ! }
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTcpSrvForm.startTimer(Sender: TObject);
begin
//ustalenie wszelkich Parametrów startowych zmiennych:
(...)
start.Enabled:=False;
WSocketServer1.Proto := 'tcp'; { Use TCP protocol }
WSocketServer1.Port := '6138';
WSocketServer1.Addr := '0.0.0.0'; { Use any interface }
WSocketServer1.ClientClass := TTcpSrvClient; { Use our component }
WSocketServer1.Listen; { Start litening }
(...)
end;
(...)
procedure TTcpSrvForm.WSocketServer1ClientDisconnect(Sender: TObject;
Client: TWSocketClient; Error: Word);
begin
ShowMessage('ch*j wi');
with Client as TTcpSrvClient do begin
blad('Odlaczony pedal z IP: '+GetPeerAddr);
Close;
Free;
end;
end;
end.
A oto lista problemów.. Poważnych...
- Serwer po prostu nie zawsze widzi Klienta... Nie wiem od czego zależy - być może coś źle poustawiałem... Chodź wydaje się, że gdy odczekam dłuuuzej od włączenia serwera to się połączy
- Największy problem - jeżeli Klient się rozłączy, to potem już po prostu nie może się podłączyć - po prostu serwer go nie zobaczy... ;/
Dodaje jeszcze użyte właściwości komponentów, bo może coś w nich jest źle...:
Klient:
object c: TWSocket
LineMode = False
LineLimit = 65536
LineEnd = #13#10
LineEcho = False
LineEdit = False
Proto = 'tcp'
LocalAddr = '127.0.0.1'
LocalPort = '6137'
MultiThreaded = False
MultiCast = False
MultiCastIpTTL = 1
FlushTimeout = 60
SendFlags = wsSendNormal
LingerOnOff = wsLingerOn
LingerTimeout = 0
KeepAliveOnOff = wsKeepAliveOff
KeepAliveTime = 0
KeepAliveInterval = 0
SocksLevel = '5'
SocksAuthentication = socksNoAuthentication
LastError = 0
ReuseAddr = False
ComponentOptions = []
ListenBacklog = 5
ReqVerLow = 1
ReqVerHigh = 1
OnDataAvailable = cDataAvailable
OnBgException = cBgException
Left = 48
Top = 96
end
Serwer:
object WSocketServer1: TWSocketServer
LineMode = False
LineLimit = 65536
LineEnd = #13#10
LineEcho = False
LineEdit = False
Proto = 'tcp'
LocalAddr = '127.0.0.1'
LocalPort = '0'
MultiThreaded = True
MultiCast = False
MultiCastIpTTL = 1
FlushTimeout = 60
SendFlags = wsSendNormal
LingerOnOff = wsLingerOn
LingerTimeout = 0
KeepAliveOnOff = wsKeepAliveOff
KeepAliveTime = 0
KeepAliveInterval = 0
SocksLevel = '5'
SocksAuthentication = socksNoAuthentication
LastError = 0
ReuseAddr = False
ComponentOptions = []
ListenBacklog = 5
ReqVerLow = 1
ReqVerHigh = 1
OnBgException = WSocketServer1BgException
Banner = '0 ok'
BannerTooBusy = '0 too'
MaxClients = 0
OnClientDisconnect = WSocketServer1ClientDisconnect
OnClientConnect = WSocketServer1ClientConnect
Top = 48
end
Z góry dziękuję za podpowiedzi!
Dodam, że teraz jest tak, że łączy mnie ten drugi raz po rozłączeniu z serwerem... Lecz, co zabawne, musze odczekać ok. 5 min przez ponownym łączeniem, aby mnie połączyło znowu... ;| xD
Jakieś pomysły...?
A może to NOD (chodź wątpie)??