{ *********************************************************************** }
{                                                                         }
{ Copular Chat Server and Client v3.0 Source Code                         }
{ Core Libary Unit                                                        }
{                                                                         }
{ Copyright (c) 1998-2002 SAF Studio                                      }
{                                                                         }
{ Author  : Niu Yu Ping                                                   }
{ Nickname: DecimalOX                                                     }
{ Address : Jilin City China                                              }
{                                                                         }
{ QICQ    : 103106262                                                     }
{ Homepage: www.safree.com                                                }
{ EMail   : decimalox@sohu.com                                            }
{                                                                         }
{ *********************************************************************** }

unit Core;

interface

uses
  ScktComp, Windows, SysUtils, Dialogs;

const
  MAX_ONLINE= 200;

  MAIN_ROOM_SOCKET: Integer = 8064;

  USER_DATA_PATH: string = 'users';

  HOST_FILE: string = 'host.dat';

  SERVER_VERSION: string ='Copular Chat v3.0.0.2';

  CMD_FLAG: string = '¡¤';
  PARAM_FLAG: string = '¡¬';

  NO_PARAM: string = 'No Param Found';
  NO_COMMAND_LINE: string = 'No Command Line Found';
  NO_COMMAND: string = 'No Command Found';

  CHECK_VERSION: DWORD = $0001; //string = 'Check Client And Server Version';
  NEW_USER: DWORD = $0002; //string = 'Create New User';
  NEW_USER_OK: DWORD = $0003; //string = 'Create New User Ok';
  UPDATE_USER: DWORD = $0004; //string = 'Update User';
  UPDATE_USER_OK: DWORD = $0005; //string = 'Update User Ok';
  LOGON_SERVER: DWORD = $0006; //string = 'Client Logon Chat Server';
  LOGON_SERVER_OK: DWORD = $0007; //string = 'Client Logon Chat Server Ok';
  GET_ONLINE_LIST: DWORD = $0008; //string = 'Client Get Online List';
  GET_ONLINE_LIST_OK: DWORD = $0009; //string = 'Client Get Online List Ok';
  GET_USER_INFO: DWORD = $000A; //string = 'Get User Information';
  GET_USER_INFO_OK: DWORD = $000B; //string = 'Get User Information Ok';
  LOGOUT_SERVER: DWORD = $000C; //string = 'Client Logout Chat Server';
  LOGOUT_SERVER_OK: DWORD = $000D; //string = 'Client Logout Chat Server Ok';
  TALK: DWORD = $000E; //string = 'Client Talk To Others';
  ADVER_TEXT: DWORD = $000F; //string = 'Advertisement Text';
  DISABLE_TALK: DWORD = $0010; //string ='Disable User Talking';
  DROP_FROM_CHAT: DWORD = $0011; //string = 'Drop User From Chat';
  GRANT_TO_USER: DWORD = $0012; //string = 'Grant To User';
  PLAYER_MOVE = $0013;

type
  //TUser structor is designed for TUserList
  TUser = record
    Name,                 //NickName
    Sex,
    Age,
    Picture,
    Color,                //Text Color
    Introduce,
    Password,
    ICQ,                  //ICQ Account
    OICQ,                 //OICQ Account
    EMAIL,
    HomePage,
    Marks,                //Integral
    Grant,
    LastOnline: string;

    Online: Boolean;

    HSocket: TCustomWinSocket;     //Client Socket Handle
    X, Y: Double; //Position
  end;

  //TUserList structor is designed for TRoom
  TUserList = class
  private
    Users: array[1..MAX_ONLINE] of TUser;
    FUserCount: Integer;
    procedure SetUserCount(const Value: Integer);
  public
    property UserCount:Integer read FUserCount write SetUserCount;

    constructor Create;

    //Register a new user's information to user file
    function NewUser(NUser: TUser): Integer;

    //Update an old user's information
    function UpdateUser(UNewUser: TUser): Integer;

    //Search user by 'name' in all user files
    function FindUser(FUserName: string; var UserInfo: TUser): Integer;

    //Search user by 'name' in online list
    function FindOnlineUserByName(FOUserName: string; var UserInfo: TUser): Integer;

    //Search user by Socket Handle in online list
    function FindOnlineUserBySocket(FOSocketHandle: Integer; var UserInfo: TUser): Integer;

    //Add an user's information to online list
    function AddOnlineUser(AOUserName, AOUserPassword: string; UserSocket: TCustomWinSocket):Integer;

    //Delete an user's information by Socket Handle from online list
    function DeleteOnlineUser(DOUserSocket: Integer; var DUser: TUser): Integer;

    //Return an online list as string
    function CreateOnlineList: string;

    //Increase of the user point
    procedure AddMarksToUsers(ATMarks: Integer);

    //Update an user's position
    procedure SetXY(AUserName: string; X, Y: Double);
  end;

  //TRoom structor is designed for Server
  TRoom = class
  private
    //The room's socket is used to connect with Client
    ServerSocket: TServerSocket;
  public
    //An online list of the room
    OnlineList: TUserList;

    constructor Create(RoomPort: Integer);
    destructor Destroy; override;

    //Event for ServerSocket: OnSocketClientRead
    procedure SocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);

    //Event for ServerSocket: OnSocketAccept
    procedure SocketAccept(Sender: TObject;
      Socket: TCustomWinSocket);

    //Event for ServerSocket: OnClientDisconnect
    procedure ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);

    //Event for ServerSocket: OnSocketClientError
    procedure SocketClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);

    //Send text to a user's Client Socket
    procedure SendTextTo(Name, SText: string);

    //Send text to all of Client Sockets
    procedure SendTextToAll(SText: string);
end;

// Initialize TUser structor
procedure InitUser(var IUser: TUser);

//Compress TUser structor to a string
function CompressUserInfo(CUIUser: TUser):string;

//Extract TUser structor from a string
function ExtractUserInfo(UserInfoStr: string; var EUIUser: TUser):Integer;

//Save TUser structor to a file
procedure SaveUserInfoToFile(FileName: string; SUser: TUser);

//Load TUser structor from a file
procedure LoadUserInfoFromFile(FileName: string; var LUser: TUser);

//Custom error dialog
procedure ErrorDlg(Sender: HWND; ErrorMsg: string);

//Custom information dialog
procedure InfoDlg(Sender:HWnd; Info: string);

//Get command from a string with custom structor
function GetCommand(CmdLine: string): DWORD;

//Get parameter from a string with custom structor
function GetParam(CmdLine: string; ParamNo: Integer=-1): string;

//Create a string with command and parameters
function CreateCommandLine(Command:DWORD; Param: string): string;

//Create a string with parameter list
function CreateParamLine(CParams: array of string): string;

implementation

function CreateParamLine(CParams: array of string): string;
var
  I:Integer;
  TmpStr: string;
begin
  TmpStr:='';
  for I:=Low(CParams) to High(CParams) do
    TmpStr:=TmpStr+CParams[I]+PARAM_FLAG;
  Result:=TmpStr;
end;

procedure SaveUserInfoToFile(FileName: string; SUser: TUser);
var
  f:TextFile;
begin
  AssignFile(f,FileName);
  Rewrite(f);
  Writeln(f,CompressUserInfo(SUser));
  CloseFile(f);
end;

procedure LoadUserInfoFromFile(FileName: string; var LUser: TUser);
var
  f:TextFile;
  TmpStr1,TmpStr2: string;
begin
  TmpStr1:='';
  TmpStr2:='';
  AssignFile(f,FileName);
  Reset(f);
  while not Eof(f) do
  begin
    Readln(f,TmpStr1);
    TmpStr2:=TmpStr2+TmpStr1;
  end;
  CloseFile(f);
  ExtractUserInfo(TmpStr2,LUser);
end;

function CreateCommandLine(Command: DWORD; Param: string): string;
var
  TmpStr: string;
begin
  TmpStr:=Param;
  if Copy(TmpStr,Length(TmpStr)-1,2)<>PARAM_FLAG then
    TmpStr:=TmpStr+PARAM_FLAG;
  Result:=CMD_FLAG+IntToStr(Command)+PARAM_FLAG+TmpStr+CMD_FLAG;
end;

procedure ErrorDlg(Sender:HWND; ErrorMsg: string);
begin
  MessageBox(Sender,PChar(ErrorMsg),'´íÎó',MB_OK or MB_ICONERROR);
end;

procedure InfoDlg(Sender:HWND; Info: string);
begin
  MessageBox(Sender,PChar(Info),'ÐÅÏ¢',MB_OK or MB_ICONINFORMATION);
end;

function CompressUserInfo(CUIUser: TUser): string;
var
  TmpStr:string;
begin
  TmpStr:='';
  with CUIUser do
  begin
    TmpStr:=Name+PARAM_FLAG+Sex+PARAM_FLAG+Age+PARAM_FLAG+Picture+PARAM_FLAG+Color+PARAM_FLAG+
      Introduce+PARAM_FLAG+Password+PARAM_FLAG+ICQ+PARAM_FLAG+OICQ+PARAM_FLAG+EMail+PARAM_FLAG+HomePage+
      PARAM_FLAG+Marks+PARAM_FLAG+Grant+PARAM_FLAG+LastOnline+PARAM_FLAG;
  end;
  Result:=TmpStr;
end;

function ExtractUserInfo(UserInfoStr: string;
  var EUIUser: TUser): Integer;
var
  I, ParamNo: Integer;
  Param: string;
begin
  ParamNo:=1;
  Param:='';
  I:=1;
  with EUIUser do
    while I<Length(UserInfoStr) do
    begin
      if Copy(UserInfoStr,I,2)<>PARAM_FLAG then
        Param:=Param+UserInfoStr[I]
      else
      begin
        case ParamNo of
          1: Name:=Param;
          2: Sex:=Param;
          3: Age:=Param;
          4: Picture:=Param;
          5: Color:=Param;
          6: Introduce:=Param;
          7: Password:=Param;
          8: ICQ:=Param;
          9: OICQ:=Param;
          10:EMAIL:=Param;
          11:HomePage:=Param;
          12:Marks:=Param;
          13:Grant:=Param;
          14:LastOnline:=Param;
        end;
        Inc(ParamNo);
        Inc(I);
        Param:='';
    end;
    Inc(I);
  end;
  Result:=ParamNo-1;
end;

procedure InitUser(var IUser: TUser);
begin
  with IUser do
  begin
    Name:='';
    Sex:='';
    Age:='';
    Picture:='';
    Color:='';
    Introduce:='';
    Password:='';
    ICQ:='';
    OICQ:='';
    EMAIL:='';
    HomePage:='';
    Marks:='';
    Grant:='';
    LastOnline:='';
    Online:=False;
    HSocket:=nil;
    X:=0;
    Y:=0;
  end;
end;

function GetCommand(CmdLine: string): DWORD;
var
  I: Integer;
begin
  I:=1;
  while (I<Length(CmdLine)) and (Copy(CmdLine,I,2)<>PARAM_FLAG) do
    Inc(I);
  Result:=StrToIntDef(Copy(CmdLine,3,I-3),0);
end;

function GetParam(CmdLine: string; ParamNo: Integer=-1): string;
var
  I,J,Pos: Integer;
  TmpStr: string;
begin
  I:=1;
  while (I<=Length(CmdLine)) and (Copy(CmdLine,I-1,2)<>PARAM_FLAG) do
    Inc(I);

  J:=3;

  while (J<Length(CmdLine)) and (Copy(CmdLine,J,2)<>CMD_FLAG) do
    Inc(J);

  TmpStr:=Copy(CmdLine,I+1,J-I);

  if ParamNo=-1 then
  begin
    Result:=TmpStr;
    Exit;
  end;

  I:=1;
  J:=1;
  Pos:=1;
  while (I<Length(TmpStr)-1) and (J<=ParamNo) do
  begin
    if Copy(TmpStr,I,2)=PARAM_FLAG then
    begin
      Inc(J);
      if J<=ParamNo then
        Pos:=I+2;
      Inc(I);
    end;
    Inc(I);
  end;

  if I>Length(TmpStr) then
    Result:=NO_PARAM
  else
    Result:=Copy(TmpStr,Pos,I-Pos-2);
end;

{ TUserList }

procedure TUserList.AddMarksToUsers(ATMarks: Integer);
var
  I: Integer;
begin
  for I:=1 to MAX_ONLINE do
    if Users[I].Online then
    begin
      Users[I].Marks:=IntToStr(StrToInt(Users[I].Marks)+AtMarks);
      Users[I].Grant:=IntToStr(StrToInt(Users[I].Marks) div 600);
    end;
end;

function TUserList.AddOnlineUser(AOUserName, AOUserPassword: string; UserSocket: TCustomWinSocket): Integer;
var
  TmpUser: TUser;
  I: Integer;
begin
  Result:=-1;

  InitUser(TmpUser);

  if FindUser(AOUserName,TmpUser)=-1 then
  begin
    Result:=1;
    Exit;
  end;

  if TmpUser.Password<>AOUserPassword then
  begin
    Result:=2;
    Exit;
  end;

  if FindOnlineUserByName(AOUserName,TmpUser)<>-1 then
  begin
    Result:=3;
    Exit;
  end;

  if FUserCount>MAX_ONLINE then
  begin
    Result:=4;
    Exit;
  end;

  for I:=1 to MAX_ONLINE do
    if not Users[I].Online then
    begin
      Users[I]:=TmpUser;
      Users[I].Online:=True;
      Users[I].HSocket:=UserSocket;
      Users[I].LastOnline:=DateTimeToStr(Now);
      Inc(FUserCount);
      Result:=0;
      Exit;
    end;
end;

constructor TUserList.Create;
var
  I: Integer;
begin
  inherited Create;

  for I:=1 to 200 do
    InitUser(Users[I]);

  FUserCount:=0;
end;

function TUserList.CreateOnlineList: string;
var
  I: Integer;
  TmpStr: string;
begin
  TmpStr:='';
  for I:=1 to MAX_ONLINE do
    if Users[I].Online then
      TmpStr:=TmpStr+Users[I].Name+PARAM_FLAG+Users[I].Sex+PARAM_FLAG+
        Users[I].Grant+PARAM_FLAG+Users[I].Picture+PARAM_FLAG+FloatToStr(Users[I].X)
        +PARAM_FLAG+FloatToStr(Users[I].Y)+PARAM_FLAG;
  Result:=TmpStr;
end;

function TUserList.DeleteOnlineUser(DOUserSocket: Integer; var DUser: TUser): Integer;
var
  I: Integer;
begin
  Result:=-1;
  I:=FindOnlineUserBySocket(DOUserSocket,DUser);

  if I<>-1 then
  begin
    SaveUserInfoToFile(USER_DATA_PATH+'\'+Users[I].Name+'.ccd',Users[I]);
    InitUser(Users[I]);
    Dec(FUserCount);
    Result:=0;
  end;
end;

function TUserList.FindOnlineUserByName(FOUserName: string; var UserInfo: TUser): Integer;
var
  I:Integer;
begin
  Result:=-1;

  for I:=1 to MAX_ONLINE do
    if (Users[I].Online) and (LowerCase(Users[I].Name)=LowerCase(FOUserName)) then
    begin
      UserInfo:=Users[I];
      Result:=I;
      Exit;
    end;
end;

function TUserList.FindOnlineUserBySocket(FOSocketHandle: Integer;
  var UserInfo: TUser): Integer;
var
  I:Integer;
begin
  Result:=-1;

  for I:=1 to MAX_ONLINE do
    if (Users[I].Online) and (Users[I].HSocket.SocketHandle=FOSocketHandle) then
    begin
      UserInfo:=Users[I];
      Result:=I;
      Exit;
    end;
end;

function TUserList.FindUser(FUserName: string; var UserInfo: TUser): Integer;
var
  SearchRec:TSearchRec;
begin
  Result:=-1;
  if FindFirst(USER_DATA_PATH+'\'+FUserName+'.ccd',faAnyFile,SearchRec)=0 then
  begin
    LoadUserInfoFromFile(USER_DATA_PATH+'\'+SearchRec.Name,UserInfo);
    Result:=0;
  end;
end;

function TUserList.NewUser(NUser: TUser): Integer;
var
  f: TextFile;
  TmpUser: TUser;
begin
  Result:=-1;
  if FindUser(NUser.Name, TmpUser)=-1 then
  begin
    AssignFile(f,USER_DATA_PATH+'\'+NUser.Name+'.ccd');
    Rewrite(f);
    Writeln(f,CompressUserInfo(NUser));
    CloseFile(f);
    Result:=0;
  end;
end;

procedure TUserList.SetUserCount(const Value: Integer);
begin
  FUserCount := Value;
end;

procedure TUserList.SetXY(AUserName: string; X, Y: Double);
var
  I: Integer;
  TmpUser: TUser;
begin
  I:=FindOnlineUserByName(AUserName, TmpUser);
  if I<>-1 then
  begin
    Users[I].X:=X;
    Users[I].Y:=Y;
  end;
end;

function TUserList.UpdateUser(UNewUser: TUser): Integer;
var
  TmpUser: TUser;
begin
  Result:=-1;
  if FindUser(UNewUser.Name, TmpUser)=-1 then
  begin
    Result:=1;
    Exit;
  end;

  if TmpUser.Password<>UNewUser.Password then
  begin
    Result:=2;
    Exit;
  end;

  UNewUser.Marks:=TmpUser.Marks;
  UNewUser.Grant:=TmpUser.Grant;

  DeleteFile(USER_DATA_PATH+'\'+UNewUser.Name+'.ccd');
  if NewUser(UNewUser)=0 then
    Result:=0;
end;

{ TRoom }

procedure TRoom.ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  TmpUser: TUser;
begin
  InitUser(TmpUser);
  if OnlineList.DeleteOnlineUser(Socket.SocketHandle,TmpUser)<>-1 then
    SendTextToAll(CreateCommandLine(LOGOUT_SERVER,TmpUser.Name+
      PARAM_FLAG+TmpUser.Sex+PARAM_FLAG+TmpUser.Grant));
end;

constructor TRoom.Create(RoomPort: Integer);
begin
  inherited Create;

  OnlineList:=TUserList.Create;

  ServerSocket:=TServerSocket.Create(nil);
  ServerSocket.Port:=RoomPort;
  ServerSocket.ServerType:=stNonBlocking;
  ServerSocket.OnClientRead:=SocketClientRead;
  ServerSocket.OnAccept:=SocketAccept;
  ServerSocket.OnClientDisconnect:=ClientDisconnect;
  ServerSocket.OnClientError:=SocketClientError;
  ServerSocket.Active:=True;
end;

destructor TRoom.Destroy;
begin
  OnlineList.Free;
  ServerSocket.Free;
end;

procedure TRoom.SendTextToAll(SText: string);
var
  I:Integer;
begin
  for I:=0 to ServerSocket.Socket.ActiveConnections-1 do
    ServerSocket.Socket.Connections[I].SendText(SText);
end;

procedure TRoom.SocketClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
var
  TmpUser:TUser;
begin
  InitUser(TmpUser);
  if OnlineList.DeleteOnlineUser(Socket.SocketHandle,TmpUser)<>-1 then
    SendTextToAll(CreateCommandLine(LOGOUT_SERVER,TmpUser.Name+
      PARAM_FLAG+TmpUser.Sex+PARAM_FLAG+TmpUser.Grant));
    ErrorCode:=0;
end;

procedure TRoom.SocketAccept(Sender: TObject; Socket: TCustomWinSocket);
begin
  //socket accept client connect
end;

procedure TRoom.SocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  TmpUser: TUser;
  TmpCmdLn,TmpParam: string;
  TmpCmd:DWORD;
  TmpResult: Integer;
begin
  TmpCmdLn:=Socket.ReceiveText;

  if Copy(TmpCmdLn,1,2)<>CMD_FLAG then
    Exit;

  TmpCmd:=GetCommand(TmpCmdLn);

  if TmpCmd=0 then
    Exit;

  if TmpCmd=CHECK_VERSION then
    Socket.SendText(CreateCommandLine(CHECK_VERSiON,IntToStr(Ord(SERVER_VERSION=GetParam(TmpCmdLn,1)))));

  if TmpCmd = TALK then
  begin
    if GetParam(TmpCmdLn,3)='1' then
    begin
      SendTextTo(GetParam(TmpCmdLn,2),TmpCmdLn);
      SendTextTo(GetParam(TmpCmdLn,1),TmpCmdLn);
    end
    else
      SendTextToAll(TmpCmdLn);
    Exit;
  end;

  if TmpCmd=NEW_USER then
  begin
    TmpParam:=GetParam(TmpCmdLn);
    InitUser(TmpUser);
    ExtractUserInfo(TmpParam,TmpUser);
    TmpResult:=OnlineList.NewUser(TmpUser);
    Socket.SendText(CreateCommandLine(NEW_USER_OK,
                          IntToStr(TmpResult)));
    Exit;
  end;

  if TmpCmd=UPDATE_USER then
  begin
    TmpParam:=GetParam(TmpCmdLn);
    InitUser(TmpUser);
    ExtractUserInfo(TmpParam,TmpUser);
    TmpResult:=OnlineList.UpdateUser(TmpUser);
    Socket.SendText(CreateCommandLine(UPDATE_USER_OK,
                       IntToStr(TmpResult)));
    Exit;
  end;

  if TmpCmd=LOGON_SERVER then
  begin
    TmpResult:=OnlineList.AddOnlineUser(GetParam(TmpCmdLn,1),
                 GetParam(TmpCmdLn,2),Socket);
    Socket.SendText(CreateCommandLine(LOGON_SERVER_OK,
                       IntToStr(TmpResult)));
    if TmpResult=0 then
    begin
      Socket.SendText(CreateCommandLine(GET_ONLINE_LIST_OK,
                        IntToStr(OnlineList.FUserCount)+PARAM_FLAG+
                        OnlineList.CreateOnlineList));
      InitUser(TmpUser);
      if OnlineList.FindOnlineUserBySocket(Socket.SocketHandle,TmpUser)<>-1 then
        SendTextToAll(CreateCommandLine(LOGON_SERVER,TmpUser.Name+PARAM_FLAG+
                           TmpUser.Sex+PARAM_FLAG+TmpUser.Grant+PARAM_FLAG+TmpUser.Picture));
    end;
    Exit;
  end;

  if TmpCmd=GET_ONLINE_LIST then
  begin
    Socket.SendText(CreateCommandLine(GET_ONLINE_LIST_OK,
                      IntToStr(OnlineList.FUserCount)+PARAM_FLAG+
                      OnlineList.CreateOnlineList));
  end;

  if TmpCmd=LOGOUT_SERVER then
  begin
    InitUser(TmpUser);
    TmpResult:=OnlineList.DeleteOnlineUser(Socket.SocketHandle,TmpUser);
    Socket.SendText(CreateCommandLine(LOGOUT_SERVER_OK,IntToStr(TmpResult)));
    if TmpResult<>-1 then
      SendTextToAll(CreateCommandLine(LOGOUT_SERVER,TmpUser.Name+
         PARAM_FLAG+TmpUser.Sex+PARAM_FLAG+TmpUser.Grant));
    Exit;
  end;

  if (TmpCmd=DISABLE_TALK) or (TmpCmd=DROP_FROM_CHAT) then
  begin
    InitUser(TmpUser);
    SendTextToAll(TmpCmdLn);
    Exit;
  end;

  if TmpCmd=PLAYER_MOVE then
  begin
    OnlineList.SetXY(GetParam(TmpCmdLn, 1),
      StrToFloat(GetParam(TmpCmdLn, 2)), StrToFloat(GetParam(TmpCmdLn, 3)));
    SendTextToAll(TmpCmdLn);
    Exit;
  end;

  if TmpCmd=GRANT_TO_USER then
  begin
    InitUser(TmpUser);
    TmpResult:=OnlineList.FindOnlineUserByName(GetParam(TmpCmdLn,2),TmpUser);
    if TmpResuLt<>-1 then
      if StrToIntDef(OnlineList.Users[TmpResult].Grant,0)<80 then
        OnlineList.Users[TmpResult].Marks:=IntToStr(StrToInt(GetParam(TmpCmdLn,1))*600);
    SendTextToAll(TmpCmdLn);
    Exit;
  end;

  if TmpCmd=GET_USER_INFO then
  begin
    InitUser(TmpUser);
    if OnlineList.FindOnlineUserByName(GetParam(TmpCmdLn,1),TmpUser)<>-1 then
      Socket.SendText(CreateCommandLine(GET_USER_INFO_OK,CompressUserInfo(TmpUser)));
    Exit;
  end;
end;

procedure TRoom.SendTextTo(Name, SText: string);
var
  I: Integer;
  TmpUser: TUser;
begin
  I:=OnlineList.FindOnlineUserByName(Name,TmpUser);
  if I<>-1 then
    OnLineList.Users[I].HSocket.SendText(SText);
end;

end.
