ServerSocket
Добрый день!
Столкнулся с проблемой при увеличении числа клиентов, сервер как бы умирает и программа пропадает, выглядит как утечка памяти после которой закрывается без вопросов приложение. Видно как то не правильно реализован сервер. Кто сталкивался с подобной проблемой? Может кто то знает как правильно реализовать серверную часть. Ниже приведу исходные коды.
Код:
type
TPackMsg = packed record
ID:Byte;
UserTO:array [0..127] of char;
UserFrom:array [0..127] of char;
Msg:array [0..1023] of char;
end;
Клиент
Код:
procedure TMainForm.ClientSocketRead(Sender: TObject;
Socket: TCustomWinSocket);
var s,from_,to_,user: string;
begin
Socket.ReceiveBuf(PackRead,SizeOf(PackRead));
{Если пришла команда закрыть окно чата}
if PackRead.ID = 103 then
begin
if (PackRead.UserTO = DM1.User_Name) then
if FormMessageChat.Visible then
begin
FormMessageChat.MessageList.Clear;
FormMessageChat.MessageSend.Clear;
FormMessageChat.Close;
end;
Exit;
end;
{Если сервер посылает нам User List}
if PackRead.ID = 101 then
begin
if (PackRead.UserTO = '') then
begin
s := PackRead.Msg;
FormMessageChatAdmin.clear_users_list();
while Pos(';',s) > 0 do
begin
user := Copy(s,1,Pos(';',s)-1);
if (copy(user,1,pos(' ',user)-1) <> DM1.User_Name) then
FormMessageChatAdmin.UserList.Items.Add(user);
Delete(s,1,Pos(';',s));
end;
end
else
if (PackRead.UserTO = DM1.User_Name) then
begin
s := PackRead.Msg;
FormMessageChatAdmin.clear_users_list();
while Pos(';',s) > 0 do begin
user := Copy(s,1,Pos(';',s)-1);
if (copy(user,1,pos(' ',user)-1) <> DM1.User_Name) then
FormMessageChatAdmin.UserList.Items.Add(user);
Delete(s,1,Pos(';',s));
end;
end;
FormMessageChatAdmin.Label3.Caption := 'Online: '+IntToStr(FormMessageChatAdmin.UserList.Items.Count);
Exit;
end;
{Если нам прислали общее сообщение (видимое для всех юзеров)}
if PackRead.ID = 104 then
begin
rMsgBox(PackRead.Msg,MB_OK+MB_ICONINFORMATION);
Exit;
end;
{Если нам прислали запрос на наше имя юзера}
if PackRead.ID = 102 then
begin
{Посылаем ответ}
PackSend.ID := 102;
StrLCopy(PackSend.UserTO, Pchar('Server'), SizeOf(PackSend.UserTO));
StrLCopy(PackSend.UserFrom, Pchar(DM1.User_Name), SizeOf(PackSend.UserFrom));
StrLCopy(PackSend.Msg, Pchar(DM1.User_Name +' ('+DM1.client_version+')'), SizeOf(PackSend.Msg));
Socket.SendBuf(PackSend,SizeOf(PackSend));
Exit;
end;
{Если стп написало письмо пользователю}
if PackRead.ID = 105 then
begin
{Выделяем в to_ - кому оно предназначено}
to_ := PackRead.UserTO;
{Выделяем в from_ - кем отправлено}
from_ := PackRead.UserFrom;
user_stp := from_;
if (to_ = DM1.User_Name) then
begin
s := from_+' > '+PackRead.Msg;
FormMessageChat.ins_message(s);
end;
if (from_ = DM1.User_Name) then
begin
s := from_+' > '+PackRead.Msg;
FormMessageChatAdmin.ins_message(s);
end;
Exit;
end;
{Если пользователь ответил для стп}
if PackRead.ID = 106 then
begin
{Выделяем в to_ - кому оно предназначено}
to_ := PackRead.UserTO;
{Выделяем в from_ - кем отправлено}
from_ := PackRead.UserFrom;
if (from_ = DM1.User_Name) then
begin
s := from_ + ' > '+PackRead.Msg;
FormMessageChat.ins_message(s);
end;
if (to_ = DM1.User_Name) then
begin
s := from_+' > '+PackRead.Msg;
FormMessageChatAdmin.ins_message(s);
end;
Exit;
end;
{Пришла команда закрыть АРМ всем пользователям}
if (PackRead.ID = 107) and (PackRead.UserTO = '') then
begin
Application.Terminate;
Exit;
end;
{Если пришла команда закрыть АРМ для конкретного пользователя}
if (PackRead.ID = 107) and (PackRead.UserTO <> '') then
begin
{Выделяем в to_ - кому оно предназначено}
to_ := PackRead.UserTO;
if (to_ = DM1.User_Name) then
begin
Application.Terminate;
end;
Exit;
end;
end;
Сервер
Код:
procedure TMainForm.ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
i: integer;
s: string;
begin
Socket.ReceiveBuf(PackRead,SizeOf(PackRead));
{Если кто то запросил список пользователей}
if PackRead.ID = 100 then
begin
s := '';
for i := 0 to UserList.Items.Count-1 do
s := s+UserList.Items[i]+';';
PackSend.ID := 101;
StrLCopy(PackSend.UserTO, PackRead.UserFrom, SizeOf(PackSend.UserTO));
StrLCopy(PackSend.UserFrom, Pchar('Server'), SizeOf(PackSend.UserFrom));
StrLCopy(PackSend.Msg, Pchar(s), SizeOf(PackSend.Msg));
for i := 0 to ServerSocket.Socket.ActiveConnections-1 do
begin
ServerSocket.Socket.Connections[i].SendBuf(PackSend,SizeOf(PackSend));
end;
Exit;
end;
{Если кто-то прислал нам свое имя}
if PackRead.ID = 102 then
begin
UserList.Items.Add(PackRead.Msg);
s := '';
for i := 0 to UserList.Items.Count-1 do
s := s+UserList.Items[i]+';';
PackSend.ID := 101;
StrLCopy(PackSend.UserTO, Pchar(''), SizeOf(PackSend.UserTO));
StrLCopy(PackSend.UserFrom, Pchar('Server'), SizeOf(PackSend.UserFrom));
StrLCopy(PackSend.Msg, Pchar(s), SizeOf(PackSend.Msg));
for i := 0 to ServerSocket.Socket.ActiveConnections-1 do
begin
ServerSocket.Socket.Connections[i].SendBuf(PackSend,SizeOf(PackSend));
end;
Exit;
end;
if PackRead.ID in [103,104,105,106,107] then
begin
PackSend.ID := PackRead.ID;
StrLCopy(PackSend.UserTO, PackRead.UserTO, SizeOf(PackSend.UserTO));
StrLCopy(PackSend.UserFrom, PackRead.UserFrom, SizeOf(PackSend.UserFrom));
StrLCopy(PackSend.Msg, PackRead.Msg, SizeOf(PackSend.Msg));
for i := 0 to ServerSocket.Socket.ActiveConnections-1 do
ServerSocket.Socket.Connections[i].SendBuf(PackSend,SizeOf(PackSend));
Exit;
end;
end;
procedure TMainForm.ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Socket.Close;
ErrorCode := 0;
end;
|