var
MyStream : TWinSocketStream;
ReadBuffer : array[0..(BufferSize-1)] of char;
WriteBuffer: array[0..(BufferSize-1)] of char;
CurrentConnect:string;
iLen:integer;
iLoop:integer;
iReadCount:Longint;
begin
{ make sure connection is active }
while (not Terminated) and ClientSocket.Connected do
begin
try
MyStream := TWinSocketStream.Create(ClientSocket, 60000);
MyStream.Size := BufferSize ;
try
FillChar(ReadBuffer,BufferSize,0); //初始化
if MyStream.WaitForData(60000) then
begin
iReadCount:=0;
try
iReadCount:= MyStream.Read(ReadBuffer, buffersize);
except
raise ESocketError.Create (ReadSocketError)
end;
if iReadCount = 0 then
ClientSocket.Close // 在规定时间内不能读,关闭连接
else
begin
Form1.Memo1.Lines.Add('ThreadID:'+inttostr(GetCurrentThreadID )
+' Now is '+ReadBuffer);
FillChar(WriteBuffer,BufferSize,0);
CurrentConnect:=GetConnectInfomation;
iLen:=length(CurrentConnect);
if iLen > BufferSize then iLen:=BufferSize;
for iLoop:=0 to (iLen-1) do WriteBuffer[iLoop]:=CurrentConnect[iLoop+1];
try
MyStream.Write(WriteBuffer,iLen);
except
raise ESocketError.Create (WriteSocketError)
end;
end;
end
else
ClientSocket.Close;
finally
MyStream.Free;
end;
except
HandleException;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Server.Active:=true;
end;
procedure TForm1.ServerAccept(Sender: TObject; Socket: TCustomWinSocket);
begin
Memo1.Lines.add('Accepted ! '+'Con Num '+IntToStr(Server.Socket.ActiveConnections));
end;
procedure TForm1.ServerClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Memo1.Lines.add('Client Connected Now!');
end;
procedure TForm1.ServerGetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
begin
SocketThread:=TMyServerThread.Create(False,ClientSocket);
end;
procedure TForm1.ServerListen(Sender: TObject; Socket: TCustomWinSocket);
begin
Memo1.Lines.add('Now listening');
end;
procedure TForm1.ServerClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.add('Client Disconnect ! '+'Con Num '+IntToStr(Server.Socket.ActiveConnections-1));
end;
function TMyServerThread.GetConnectInfomation: string;
begin
result:='Current Thread Id='+inttostr( GetCurrentThreadID )
+' Server Time ='+DateTimeToStr(Now);
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
ShowInfomation:string;
i,j : integer;
WriteBuffer:string;
begin
WriteBuffer:='Server Close';
j:=Length(WriteBuffer);
ShowInfomation:='还有 '+inttostr(Server.Socket.ActiveConnections)+' 个连接'
+' , 确实要退出?';
if Server.Socket.ActiveConnections>0 then
begin
if Application.MessageBox(
PChar(ShowInfomation),
'提示',
MB_OKCANCEL+MB_ICONQUESTION+MB_DEFBUTTON2)=IDOK
then
begin
i:= Server.Socket.ActiveConnections;
while Server.Socket.ActiveConnections>0
do
begin
Server.Socket.Connections[i-1].SendBuf (WriteBuffer,j);
Server.Socket.Connections[i-1].Close ;
i:=i-1;
end;
CanClose:=true;
end
else
CanClose:=false;
end;
end;