unit SunriseChatCoreUnit;

interface

uses                                                                       
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, StdCtrls, ExtCtrls, SunriseChatCoreUtils, DateUtils, Dialogs;

const
  ProtocolVersion = 3;
  CoreVersion = '3.0';
  RemoveTimeout = 33/24/3600; // 33 seconds
  AliveCommandSendingPeriod = 5; // in seconds

  UserStatusModeText: array[0..4] of string  = ('Online', 'Away', 'Writing',
    'Invisible', 'Offline');

  DefaultEventsFormat: array[0..22] of string = ('<%0:s> %1:s', '<%0:s> %3:s: %1:s',
    'User %0:s connected from %1:s', 'User %0:s disconnected', 'User %0:s restored',
    'User %0:s timeout', 'User %0:s went off', 'User %0:s got beck',
    'Callup sended to user %0:s', 'Callup received from user %0:s',
    'Ping sended to user %0:s', 'Ping response received from user %0:s',
    'User %0:s changed nick to %1:s', 'Nick %0:s conflict',
    'Room %1:s created by user %0:s', 'User %0:s left room %1:s',
    'User %0:s gone to auto away mode', 'User %0:s returned from auto away mode',
    '%0:s hours', 'Welcome %0:s!', 'Goodbye %0:s!', 'User %0:s invited to private room',
    'Custom event');

type
  TSunriseChatCore = class;

  TSystemCommand = (scUnknown, scMessage, scConnect, scDisconnect, scCallUp,
    scCallUpResponse, scPing, scPingResponse, scAlive, scWhoIs, scCreateRoom,
    scLeaveRoom, scUserInfo, scCustomCommand);

  TAppEventType = (aeCommonMessage, aeOneUserMessage, aeUserConnect,
    aeUserDisconnect, aeUserRestore, aeUserTimeout, aeUserGoAway, aeUserGoBack,
    aeSendCallUp, aeReceiveCallUp, aeSendPing, aePingResponse, aeUserChangeNick,
    aeUserChangeNickConflict, aeCreateRoom, aeLeaveRoom, aeUserAutoGoAway,
    aeUserAutoGoBack, aeShowHours, aeStart, aeEnd, aeUserInvited, aeCustomEvent);

  TMessageEvent = procedure (Text: string; Color: Integer) of object;
  TClassMethod = procedure of object;

  TRoomType = (rtPublic, rtPrivate);
  TRoomLine = class(TPersistent)
  public
    Nick: string;
    Text: string;
    Font: TFont;
    Time: TDateTime;
    EventType: TAppEventType;
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    destructor Destroy; override;
  end;

  TRoom = class
  private
    FParent: TSunriseChatCore;
  public
    Id: Cardinal;
    Name: string;
    Typ: TRoomType;
    StartLine: Integer;
    Count: Integer;
    Lines: TList; // of TRoomLine;
    constructor Create(Parent: TSunriseChatCore);
    procedure Select;
    procedure Remove;
    destructor Destroy; override;
  end;

  TUserStatusMode = (usOnline, usAway, usWriting, usInvisible, usOffline);

  TClientIdentification = record
    Machine: Cardinal;
    User: Cardinal;
  end;

  TUser = class(TPersistent)
  private
    FParent: TSunriseChatCore;
    FNick: string;
    procedure SetNick(const Value: string);
  public
    HostName: string;
    Id: TClientIdentification;
    Female: Boolean;
    Color: Integer;
    Client: string;
    ClientVersion: string;
    CoreVersion: string;
    OSVersion: string;
    OSUser: string;
    Status: TUserStatusMode;
    LastTime: TDateTime;            // Time of last Alive command (local)
    Delay: TDateTime;               // Time between LastTime
    IdleTime: Integer;              // User inactivity delay in seconds
    UpTime: TDateTime;              // Time of start of user client application
    LocalSystemTime: TDateTime;     // Current system time on user computer
    UserInfoTime: TDateTime;        // Time of last UserInfo command
    NickTime: TDateTime;            // Time of start of using nick
    Reason: string;                 // Reason in away mode
    Sequence: Integer;              // Command sequence number
    ErrorCount: Integer;            // Number of sequence errors
    BlockMessages: Boolean;         // Blocking user activity
    DetailInfo: string;             // User description
    property Nick: string read FNick write SetNick;
    constructor Create(Parent: TSunriseChatCore);
    procedure Assign(Source: TPersistent); override;
  end;

  TAddMessageMethod = procedure(EventType: TAppEventType; Room: TRoom;
    const Args: array of const; RoomLine: TRoomLine) of object;

  TSunriseChatCore = class(TComponent)
  private
    FCounter: Integer;
    FTimer1: TTimer;
    FOnAddMessage: TAddMessageMethod;
    FOnChangeNetworkState: TClassMethod;
    FOnUserListUpdate: TClassMethod;
//    FOnPingResponse: TClassMethod;
//    FOnCallUp: TClassMethod;
//    FOnNickChange: TClassMethod;
    FOnRoomListChanged: TClassMethod;
    FMaxRoomLines: Integer;
    LastHour: Word;
    FOnSendCommand: TGetStrProc;
    FUseDefaultEventsText: Boolean;
    procedure FTimer1Timer(Sender: TObject);
    procedure SetMaxRoomLines(Number: Integer);
    function SameClientId(Id1, Id2: TClientIdentification): Boolean;
  protected
    FActive: Boolean;
    procedure SetActive(const Value: Boolean);
  public
    LocalUser: TUser;
    UserList: TList; // of TUser;
    ActiveRoom: TRoom;
    RoomList: TList; // of TRoom;
    FAutoAwayDelay: Integer;
    constructor Create(AOwner: TComponent); override;
    procedure DeleteRoom(RoomIndex: Integer);
    procedure AddMessage(MessageEventType: TAppEventType; Room: TRoom; const Args: array of const);
    procedure DeleteOfflineUsers;
    procedure UpdateUser(User: TUser);
    procedure SendCommand(Command: TSystemCommand; Text: string = '';
      DestinationMachineId: Cardinal = 0; DestinationUserId: Cardinal = 0);
    procedure ProcessCommand(Text: string);
    destructor Destroy; override;
  published
    property AutoAwayDelay: Integer read FAutoAwayDelay write FAutoAwayDelay;
    property UseDefaultEventsText: Boolean read FUseDefaultEventsText write FUseDefaultEventsText;
    property Active: Boolean read FActive write SetActive;
    property MaxRoomLines: Integer read FMaxRoomLines write SetMaxRoomLines;
//    property OnNickChange: TClassMethod read FOnNickChange write FOnNickChange;
    property OnUserListUpdate: TClassMethod read FOnUserListUpdate write FOnUserListUpdate;
    property OnAddMessage: TAddMessageMethod read FOnAddMessage write FOnAddMessage;
    property OnChangeNetworkState: TClassMethod read FOnChangeNetworkState write FOnChangeNetworkState;
//    property OnPingResponse: TClassMethod read FOnPingResponse write FOnPingResponse;
//    property OnCallUp: TClassMethod read FOnCallUp write FOnCallUp;
    property OnRoomListChanged: TClassMethod read FOnRoomListChanged write FOnRoomListChanged;
    property OnSendCommand: TGetStrProc read FOnSendCommand write FOnSendCommand;
  end;

procedure Register;

implementation

uses
  UProtocolMessageLog;

procedure Register;
begin
  RegisterComponents('Chronosoft', [TSunriseChatCore]);
end;

{ TSunriseChatCore }

constructor TSunriseChatCore.Create(AOwner: TComponent);
var
  NewRoom: TRoom;
begin
  inherited;
  RoomList := TList.Create;
  UserList := TList.Create;
  LastHour := HourOf(Now);
  LocalUser := TUser.Create(Self);
  with LocalUser do begin
    OSVersion := GetWindowsVersionStr;
    OSUser := GetUserName;
    Status := usOnline;
    HostName := LocalHostName;
    //HostName := LocalHostName;
    Uptime := Now;
    Id.Machine := Random(High(Integer));
    Id.User := Random(High(Integer));
  end;
  LocalUser.CoreVersion := CoreVersion;
  FMaxRoomLines := 100;
  NewRoom := TRoom.Create(Self);
  with NewRoom do begin
    Id := 0;
    Name := 'Public';
    Typ := rtPublic;
  end;
  ActiveRoom := NewRoom;
  RoomList.Add(NewRoom);
  FActive := False;
   
  // Initialise timer
  FTimer1 := TTimer.Create(Self);
  FCounter := 0;
  with FTimer1 do begin
    Interval := 1000; // 1 second
    OnTimer := FTimer1Timer;
    Enabled := False;
  end;
  FUseDefaultEventsText := True;
  FAutoAwayDelay := 5;
end;

destructor TSunriseChatCore.Destroy;
var
  I: Integer;
begin
  Active := False;
  for I := 0 to UserList.Count - 1 do TList(UserList[I]).Free;
  UserList.Free;
  LocalUser.Free;
  for I := 0 to RoomList.Count - 1 do TRoom(RoomList[I]).Free;
  RoomList.Free;
  inherited;
end;

function TSunriseChatCore.SameClientId(Id1, Id2: TClientIdentification): Boolean;
begin
  Result := (Id1.Machine = Id2.Machine) and (Id1.User = Id2.User);
end;

procedure TSunriseChatCore.ProcessCommand(Text: string);
var
  SourceUser: TUser;
  TargetUSer: TUser;
  ProtocolVersion: Integer;
  Seq: Integer;
  Command: TSystemCommand;
//  Data: string;
  Part: string;
  I: Integer;
  IdleTime2: Integer;
  NewRoom: TRoom;
  UserListCount: Integer;
  Args: array of TVarRec;
  RoomId: Cardinal;
  RoomName: string;
  RoomType: TRoomType;
  TextMessage: string;

function Parse: string;
begin
  Result := Copy(Text, 1, Pos('|', Text)-1);
  Delete(Text, 1, Length(Result)+1);
end;

begin
  UserListCount := UserList.Count;
  SourceUser := TUser.Create(Self);
  TargetUSer := TUser.Create(Self);
//  OnAddMessage(Text,clSysMessage);
  //AddMessage(Command);
  with SourceUser do try
    ProtocolVersion := StrToInt(Parse);
    case ProtocolVersion of
      3: begin
        SourceUser.Id.Machine := StrToInt64(Parse);                // Source IP
        SourceUser.Id.User := StrToInt64(Parse);                   // Source ID
        TargetUser.Id.Machine := StrToInt64(Parse);                // Destination IP
        TargetUser.Id.User := StrToInt64(Parse);                   // Destination ID
        Seq := StrToInt(Parse);       // sequence command number

        ProtocolMessageLogForm.Memo1.Lines.Add('ProcessCommand: ' + Text);
        // Load source user data
        if SameClientId(TargetUser.Id, LocalUser.Id) then begin
          I := 0;
          while (I < UserList.Count) and not SameClientId(TUser(UserList[I]).Id, TargetUser.Id) do
            I := I + 1;
          if I < UserList.Count then
            TargetUser.Assign(UserList[I]);
        end;

        // Load source user data
        I := 0;
        while (I < UserList.Count) and not SameClientId(TUser(UserList[I]).Id, Id) do
          I := I + 1;
        if I < UserList.Count then begin
          SourceUser.Assign(UserList[I]);
        end else Sequence := Seq - 1;
        if Seq <> (SourceUser.Sequence + 1) then ErrorCount := ErrorCount + 1;
        Sequence := Seq;
        ProtocolMessageLogForm.Memo1.Lines.Add('ProcessCommand: UpdateUser ');
        UpdateUser(SourceUser);

        begin
          Command := TSystemCommand(StrToInt(Parse));                  // Command
          case Command of

            scMessage: begin
              TextMessage := Parse;
              RoomId := StrToInt64(Parse);
              RoomName := Parse;
              RoomType := TRoomType(StrToInt(Parse));

              // Search room
              I := 0;
              while (I < RoomList.Count) and (TRoom(RoomList[I]).Id <> RoomId) do
                I := I + 1;
              if (RoomType = rtPublic) and (I = RoomList.Count) then begin
                NewRoom := TRoom.Create(Self);
                with NewRoom do begin
                  Id := RoomId;
                  Name := RoomName;
                  Typ := RoomType;
                end;
                RoomList.Add(NewRoom);
                if Assigned(FOnRoomListChanged) then FOnRoomListChanged;
              end;

              UpdateUser(SourceUser);
              if (I < RoomList.Count) and not BlockMessages then begin
                if not SameClientId(TargetUser.Id, LocalUser.Id) then
                  AddMessage(aeCommonMessage, TRoom(RoomList[I]), [Nick, TextMessage, Color])
                    else AddMessage(aeOneUserMessage, TRoom(RoomList[I]), [Nick, TextMessage, Color, TargetUser.Nick]);
              end;
            end;

            scCreateRoom: begin
              RoomId := StrToInt64(Parse);
              RoomName := Parse;
              RoomType := TRoomType(StrToInt(Parse));
              //ShowMessage(LocalUser.IP+','+IP+' '+IntToStr(LocalUser.ID)+','+IntToStr(ID));
              if (RoomType = rtPublic) or ((RoomType = rtPrivate) and
                SameClientId(LocalUser.Id, TargetUser.Id)) then begin
                // Search room
                I := 0;
                while (I < RoomList.Count) and (TRoom(RoomList[I]).Id <> RoomId) do
                  I := I + 1;
                if I < RoomList.Count then
                else begin
                  NewRoom := TRoom.Create(Self);
                  with NewRoom do begin
                    Id := RoomId;
                    Name := RoomName;
                    Typ := RoomType;
                  end;
                  RoomList.Add(NewRoom);
                end;
                if Assigned(FOnRoomListChanged) then FOnRoomListChanged;
                AddMessage(aeCreateRoom, TRoom(RoomList[I]), [SourceUser.Nick, RoomName]);
              end;
            end;

            scLeaveRoom: begin
              RoomId := StrToInt64(Parse);
              RoomName := Parse;

              // Search room
              I := 0;
              while (I < RoomList.Count) and (TRoom(RoomList[I]).Id <> RoomId) do
                I := I + 1;
              if I < RoomList.Count then begin
                if Assigned(FOnRoomListChanged) then FOnRoomListChanged;
                AddMessage(aeLeaveRoom, TRoom(RoomList[I]), [Nick, RoomName]);
              end;
            end;

            scConnect: begin
              Nick := Parse;
              NickTime := StrToDateTime(Parse);
              if not SameClientId(LocalUser.Id, Id) then
                AddMessage(aeUserConnect, nil, [Nick, HostName])
                  else AddMessage(aeStart, nil , [Nick]);
              SendCommand(scUserInfo);
              UpdateUser(SourceUser);
            end;

            scDisconnect: begin
              if not SameClientId(LocalUser.Id, Id) then
                AddMessage(aeUserDisconnect, nil, [Nick])
                  else AddMessage(aeEnd, nil , [Nick]);

              // Delete disconnected user
              I := 0;
              while (I < UserList.Count) and not SameClientId(TUser(UserList[I]).Id, Id) do
                I := I + 1;
              if I < UserList.Count then begin
                TUser(UserList[I]).Free;
                UserList.Delete(I);
              end;
              if Assigned(OnUserListUpdate) then OnUserListUpdate;
            end;

            scCallUp: begin
              if (not BlockMessages) and SameClientId(LocalUser.Id, TargetUser.Id) then AddMessage(aeReceiveCallUp, nil, [Nick]);
            end;

            scPing: begin
              if SameClientId(LocalUser.Id, TargetUser.Id) then SendCommand(scPingResponse, Parse, TargetUser.Id.Machine, TargetUSer.Id.User);
            end;

            scPingResponse: begin
              if SameClientId(LocalUser.Id, TargetUser.Id) then AddMessage(aePingResponse, nil, [Nick,TimeToStr(Now - StrToTime(Parse))]);
            end;

            scAlive: begin
              Delay := Now - LastTime;
              LastTime := Now;
              if not TryStrToInt(Parse, IdleTime2) then IdleTime2 := 0;
              if (IdleTime2 > AutoAwayDelay * 60) and (IdleTime < AutoAwayDelay * 60) and (Status = usOnline) then begin
                AddMessage(aeUserGoAway, nil, [Nick, IntToStr(AutoAwayDelay)]);
              end;
              if (IdleTime > AutoAwayDelay * 60) and (IdleTime2 < AutoAwayDelay * 60) and (Status = usOnline) then begin
                AddMessage(aeUserAutoGoBack, nil, [Nick, IntToStr(IdleTime div 60)]);
              end;
              IdleTime := IdleTime2;
              UpdateUser(SourceUser);
            end;

            scWhoIs: begin
              //if SameClientId(LocalUser.Id, TargetUser.Id) then
              SendCommand(scUserInfo);
            end;

            scCustomCommand: begin
              while Length(Text) > 0 do begin
                SetLength(Args, Length(Args)+1);
                Args[High(Args)].VPChar := PChar(Parse);
              end;
              AddMessage(aeCustomEvent, nil, Args);
            end;

            scUserInfo: begin
              Part := Parse;
              if (Part <> Nick) and (NickTime <> 0) then AddMessage(aeUserChangeNick, nil, [Nick, Part]);
              FNick := Part;
              ProtocolMessageLogForm.Memo1.Lines.Add('ProcessCommand: UserInfo ' + FNick);
              NickTime := StrToDateTime(Parse);
              Color := StrToInt(Parse);
              Reason := Parse;
              Part := Parse;
              if TUserStatusMode(StrToInt(Part)) <> Status then
                case TUserStatusMode(StrToInt(Part)) of
                  usAway: begin
                    AddMessage(aeUserGoAway, nil, [Nick, Reason]);
                    UpdateUser(SourceUser);
                  end;
                  usOnline: begin
                    AddMessage(aeUserGoBack, nil, [Nick]);
                    UpdateUser(SourceUser);
                  end;
                end;
              Status := TUserStatusMode(StrToInt(Part));
              HostName := Parse;
              OSVersion := Parse;
              OSUser := Parse;
              Uptime := StrToDateTime(Parse);
              Client := Parse;
              ClientVersion := Parse;
              CoreVersion := Parse;
              LocalSystemTime := StrToDateTime(Parse);
              DetailInfo := Parse;
              UserInfoTime := Now;

              // Nick conflict test
              if (LocalUser.Nick = Nick) and not SameClientId(LocalUser.Id, Id) then begin
                if LocalUser.NickTime > NickTime then begin
                  // Set nick to Host(Guest) n
                  if Copy(LocalUser.Nick, 1, 4) = 'Host' then begin
                    if TryStrToInt(Copy(LocalUser.Nick, 5, 255), I) then I := I + 1 else I := 1;
                  end else I := 1;
                  LocalUser.Nick := 'Host' + IntToStr(I);
                  AddMessage(aeUserChangeNickConflict, nil, [LocalUser.Nick]);
                end else SendCommand(scUserInfo);
              end;
              UpdateUser(SourceUser);
            end;
          end;
          if (UserListCount <> UserList.Count) and (Command <> scConnect) and
          (Command <> scUserInfo) then
            AddMessage(aeUserRestore, nil, [SourceUser.Nick]);
          if Nick = '' then SendCommand(scWhoIs, '', Id.Machine, Id.User);
        end;
      end;
    end;
  except
  end;
  SourceUser.Free;
  TargetUSer.Free;
end;

procedure TSunriseChatCore.SendCommand(Command: TSystemCommand;
  Text: string = '';
  DestinationMachineId: Cardinal = 0; DestinationUserId: Cardinal = 0);
var
  Data: string;

procedure AddPart(Part: string);
begin
  Data := Data + Part + '|';
end;

begin
  if LocalUser.Status <> usInvisible then begin
    //if not NoResloveHostName then
    Data := '';
    with LocalUser do begin
      AddPart(IntToStr(ProtocolVersion));                  // Version of protocol
      AddPart(IntToStr(Int64(Id.Machine)));                // Source machine id
      AddPart(IntToStr(Int64(Id.User)));                   // Source user id
      AddPart(IntToStr(Int64(DestinationMachineId)));      // Destination machine id
      AddPart(IntToStr(Int64(DestinationUserId)));         // Destination user id
      Sequence := Sequence + 1;
      AddPart(IntToStr(Sequence));       // Command sequence number
      AddPart(IntToStr(Integer(Command)));         // Command
      case Command of

        scMessage: begin
          AddPart(Text);                   // Text
          AddPart(IntToStr(ActiveRoom.Id));        // Room name
          AddPart(ActiveRoom.Name);        // Room name
          AddPart(IntToStr(Integer(ActiveRoom.Typ))); // Public or private room
        end;

        scConnect: begin
          AddPart(Nick);
          AddPart(DateTimeToStr(NickTime));
        end;

        scDisconnect: begin
        end;

        scCallUp: begin
        end;

        scCallUpResponse: begin
        end;

        scPing: begin
          AddPart(TimeToStr(Now));         // Send time
        end;

        scPingResponse: begin
          AddPart(Text);                   // Send time
        end;

        scAlive: begin
          AddPart(IntToStr(SecondsIdle));
        end;

        scWhoIs: begin
        end;

        scCreateRoom: begin
          AddPart(IntToStr(Int64(ActiveRoom.Id)));         // Room Id
          AddPart(ActiveRoom.Name);                    // Room name
          AddPart(IntToStr(Integer(ActiveRoom.Typ))); // Public or private room
        end;

        scLeaveRoom: begin
          AddPart(IntToStr(Int64(Id)));         // Room Id
          AddPart(ActiveRoom.Name);             // Room name
        end;

        scUserInfo: begin
          AddPart(Nick);                       // User name
          AddPart(DateTimeToStr(NickTime));    // User name time
          AddPart(IntToStr(Color));            // Text color
          AddPart(Reason);                     // Away mode reason
          AddPart(IntToStr(Integer(Status)));  // User status
          AddPart(HostName);                   // Local host name
          AddPart(OSVersion);                  // OS version
          AddPart(OSUser);                     // Logged user
          AddPart(DateTimeToStr(Uptime));      // Application uptime
          AddPart(Client);                     // Name of client application
          AddPart(ClientVersion);              // Version of application
          AddPart(CoreVersion);                // SunriseChatCoreVersion
          AddPart(DateTimeToStr(Now));         // Local system time
          AddPart(DetailInfo);                 // Detailed info about user
        end;
      end;
    end;
    //if Assigned(ProtocolMessageLogForm) then
    //  ProtocolMessageLogForm.Memo1.Lines.Add('SendCommand: ' + Data);
    if Assigned(FOnSendCommand) then FOnSendCommand(Data);
  end;
end;

procedure TSunriseChatCore.FTimer1Timer(Sender: TObject);
begin
  if (FCounter mod AliveCommandSendingPeriod) = 0 then SendCommand(scAlive);
  DeleteOfflineUsers;
  if HourOf(Now) <> LastHour then begin
    LastHour := HourOf(Now);
    AddMessage(aeShowHours, nil, [HourOf(Now), MinuteOf(Now)]);
  end;
  FCounter := FCounter + 1;
end;

procedure TSunriseChatCore.DeleteOfflineUsers;
var
  I: Integer;
  Changed: Boolean;
begin
  I := 0;
  Changed := False;
  while (I < UserList.Count) do begin
    if (Now - TUser(UserList[I]).LastTime) > RemoveTimeout then begin
      AddMessage(aeUserTimeout, nil, [TUser(UserList[I]).Nick]);
      TUser(UserList[I]).Free;
      UserList.Delete(I);
      Changed := True;
    end else I := I + 1;
  end;
  if Changed and Assigned(FOnUserListUpdate) then FOnUserListUpdate;
end;

procedure TSunriseChatCore.UpdateUser(User: TUser);
var
  I: Integer;
  NewUser: TUser;
begin
  I := 0;
  while (I < UserList.Count) and not SameClientId(TUser(UserList[I]).Id, User.Id) do
    I := I + 1;
  if I = UserList.Count then begin
    NewUser := TUser.Create(Self);
    UserList.Add(NewUser);
  end;
  User.LastTime := Now;
  TUser(UserList[I]).Assign(User);
  if Assigned(FOnUserListUpdate) then FOnUserListUpdate;
end;

procedure TSunriseChatCore.AddMessage(MessageEventType: TAppEventType;
  Room: TRoom; const Args: array of const);
var
  NewRoomLine: TRoomLine;
  RoomIndex: Integer;
  I: Integer;
  RoomListStartIndex: Integer;
  RoomListEndIndex: Integer;
begin
  //if (StrPas(PChar(Args[0].VString)) <> '') then
  begin
    // Create new room line
    NewRoomLine := TRoomLine.Create;
    with NewRoomLine do begin
      if UseDefaultEventsText then try
        Text := Format(DefaultEventsFormat[Integer(MessageEventType)], Args);
      except
        raise Exception.Create('Default event text format error');
      end else Text := '';
      Time := Now;
      if MessageEventType in [aeOneUserMessage, aeCommonMessage] then begin
        Font.Color := Args[2].VInteger;
      end;
    end;
    NewRoomLine.EventType := MessageEventType;

    if Assigned(OnAddMessage) then OnAddMessage(MessageEventType, Room, Args, NewRoomLine);

    // Select target rooms
    if not Assigned(Room) then begin  // nil = add to all rooms
      RoomListStartIndex := 0;
      RoomListEndIndex := RoomList.Count - 1;
    end else begin
      RoomListStartIndex := RoomList.IndexOf(Room);
      RoomListEndIndex := RoomList.IndexOf(Room);
    end;

    // Add new line
    for RoomIndex := RoomListStartIndex to RoomListEndIndex do
    if (RoomIndex < RoomList.Count) and (RoomIndex >= 0) then
    with TRoom(RoomList[RoomIndex]) do begin
      Count := Count + 1;
      if Count > FMaxRoomLines then begin
        StartLine := (StartLine + 1) mod FMaxRoomLines;
        Count := FMaxRoomLines;
      end;
      I := (StartLine + Count - 1) mod FMaxRoomLines;
      TRoomLine(Lines[I]).Assign(NewRoomLine);
    end;
    NewRoomLine.Free;
  end;
end;

procedure TSunriseChatCore.DeleteRoom(RoomIndex: Integer);
begin
  TRoom(RoomList[RoomIndex]).Free;
  RoomList.Delete(RoomIndex);
  if Assigned(FOnRoomListChanged) then FOnRoomListChanged;
end;

procedure TSunriseChatCore.SetMaxRoomLines(Number: Integer);
var
  I, II: Integer;
begin
  FMaxRoomLines := Number;
  for I := 0 to RoomList.Count-1 do with TRoom(RoomList[I]) do begin
    for II := 0 to Lines.Count-1 do TRoomLine(Lines[II]).Free;
    Lines.Count := Number;
    for II := 0 to Lines.Count-1 do Lines[II] := TRoomLine.Create;
  end;
end;

procedure TSunriseChatCore.SetActive(const Value: Boolean);
begin
  FTimer1.Enabled := Value;
  FActive := Value;
end;

{ TRoom }

constructor TRoom.Create(Parent: TSunriseChatCore);
var
  I: Integer;
begin
  FParent := Parent;
  ID := Random(High(Integer));
  Lines := TList.Create;
  Lines.Count := FParent.FMaxRoomLines;
  for I := 0 to Lines.Count-1 do begin
    Lines[I] := TRoomLine.Create;
  end;
  StartLine := 0;
  Count := 0;
end;

destructor TRoom.Destroy;
var
  I: Integer;
begin
  for I := 0 to Lines.Count-1 do TRoomLine(Lines[I]).Free;
  Lines.Free;
  inherited;
end;

procedure TRoom.Remove;
begin
  with FParent.RoomList do
    if Id <> 0 then Delete(IndexOf(Self));
end;

procedure TRoom.Select;
begin
  FParent.ActiveRoom := Self;
end;

{ TUser }

procedure TUser.Assign(Source: TPersistent);
begin
  if Source is TUser then
    with TUser(Source) do begin
      Self.FNick := FNick;
      Self.HostName := HostName;
      Self.Id := Id;
      Self.Female := Female;
      Self.Color := Color;
      Self.Client := Client;
      Self.ClientVersion := ClientVersion;
      Self.CoreVersion := CoreVersion;
      Self.OSVersion := OSVersion;
      Self.OSUser := OSUser;
      Self.Status := Status;
      Self.LastTime := LastTime;
      Self.UpTime := UpTime;
      Self.LocalSystemTime := LocalSystemTime;
      Self.UserInfoTime := UserInfoTime;
      Self.NickTime := NickTime;
      Self.Reason := Reason;
      Self.Sequence := Sequence;
      Self.ErrorCount := ErrorCount;
      Self.BlockMessages := BlockMessages;
      Self.Delay := Delay;
      Self.DetailInfo := DetailInfo;
      Self.IdleTime := IdleTime;
    end else inherited;
end;

constructor TUser.Create(Parent: TSunriseChatCore);
begin
  FParent := Parent;
end;

procedure TUser.SetNick(const Value: string);
begin
  NickTime := Now;
  FNick := Value;
  FParent.SendCommand(scUserInfo);
end;

{ TRoomLine }

procedure TRoomLine.Assign(Source: TPersistent);
begin
  if Source is TRoomLine then
  with TRoomLine(Source) do begin
    Self.Text := Text;
    Self.Font.Assign(Font);
    Self.Time := Time;
    Self.EventType := EventType;
  end else inherited;
end;

constructor TRoomLine.Create;
begin
  Font := TFont.Create;
end;

destructor TRoomLine.Destroy;
begin
  Font.Free;
  inherited;
end;

end.