RnQ/RnQ/outboxLib.pas

{
  This file is part of R&Q.
  Under same license
}
unit outboxLib;
{$I RnQConfig.inc}

interface

uses
  classes, sysutils, RnQStrings, RnQProtocol, RDGlobal;

{$I NoRTTI.inc}

const
  OE_msg = 1;
  OE_contacts = 2;
  OE_addedYou = 3;
  OE_auth = 4;
  OE_authDenied = 5;
  OE_file = 6;
  OE_email = 7;
  OE_automsgreq = 8;

  OEvent2ShowStr: array [OE_msg .. OE_automsgreq] of string = (Str_message, 'Contacts', 'Added you', 'Authorization given',
    'Authorization denied', 'File', 'E-Mail', 'Auto-message');

type
  POEvent = ^TOEvent;

  TOEvent = class
  public
    kind: integer;
    // uin:integer;
    flags: Cardinal;
    whom: TRnQContact;
    // UID   : TUID;
    email: string;
    info: string;
    cl: TRnQCList;
    wrote, lastmodify: Tdatetime;
    // ack fields
    timeSent: Tdatetime;
    ID: integer;
    filepos: integer;
    // constructor Create;// override;
    constructor Create; // override;
    destructor Destroy; override;
    function toString: RawByteString;
    function fromString(s: RawByteString): Boolean;
    function Clone: TOEvent;
  end; // TOEvent

  Toutbox = class(Tlist)
  public
    // destructor Destroy; override;

    function toString: RawByteString;
    procedure fromString(s: RawByteString);

    function empty: Boolean;
    function pop: TOEvent;
    function popVisible: TOEvent;

    procedure Clear; override;
    procedure clearU;
  protected
    procedure Notify(Ptr: Pointer; Action: TListNotification); OverRide;
  public
    function add(kind: integer; dest: TRnQContact; flags: integer = 0; const info: string = ''): TOEvent; overload;
    function add(kind: integer; dest: TRnQContact; flags: integer; cl: TRnQCList): TOEvent; overload;
    function getAt(idx: integer): TOEvent;
    function remove(ev: TOEvent): Boolean; overload;
    function stFor(who: TRnQContact): Boolean;
    function findID(ID: integer): integer;

    procedure updateScreenFor(cnt: TRnQContact);
  end; // Toutbox

implementation

uses
  globalLib, mainDlg, utilLib, chatDlg,
  // RnQProtocol,
  roasterLib, RnQCrypt,
  RQUtil, RnQDialogs, RDUtils, RnQBinUtils;

{ destructor Toutbox.Destroy;
  begin
  clear;
  inherited
  end; // destroy
}

function Toutbox.toString: RawByteString;
var
  s: RawByteString;
  res: RawByteString;
  i: integer;
begin
  res := ''; // file version
  if count > 0 then
  begin
    for i := 0 to count - 1 do
    begin
      s := getAt(i).toString;
      res := res + int2str(length(s)) + s;
    end;
    critt(res, StrToIntDef(Account.AccProto.ProtoElem.MyAccNum, 0));
  end;
  result := 'VER' + int2str(1) + res;
end; // toString

procedure Toutbox.fromString(s: RawByteString);
var
  i, l: integer;
  ev: TOEvent;
begin
  s := decritted(copy(s, 8, length(s)), StrToIntDef(Account.AccProto.ProtoElem.MyAccNum, 0));
  clearU;
  i := 1;
  if length(s) < 4 then
    exit;
  try
    while i < length(s) do
    begin
      l := integer((@s[i])^);
      inc(i, 4);
      ev := TOEvent.Create;
      if ev.fromString(copy(s, i, l)) then
        add(ev)
      else
        ev.Free;
      inc(i, l);
    end;
  except
    msgDlg('Error on load outbox', True, mtError);
  end;
end; // fromString

procedure Toutbox.Clear;
// var
// i:integer;
// oe : TOEvent;
begin
  { for i:=count-1 downto 0 do
    begin
    oe := getAt(i);
    Items[i] := NIL;
    if oe <> NIL then
    with oe do
    try
    //     updateScreenFor(uid);
    free;
    except
    end;
    end; }
  inherited;
  saveOutboxDelayed := True;
end; // clear

procedure Toutbox.clearU;
var
  i: integer;
  oe: TOEvent;
begin
  for i := count - 1 downto 0 do
  begin
    oe := getAt(i);
    if oe <> NIL then
      with oe do
        try
          // if upd then
          updateScreenFor(whom);
          // free;
          Items[i] := NIL;
        except
        end;
  end;
  inherited;
  saveOutboxDelayed := True;
end;

function Toutbox.add(kind: integer; dest: TRnQContact; flags: integer; cl: TRnQCList): TOEvent;
begin
  result := add(kind, dest, flags);
  result.cl := TRnQCList.Create;
  result.cl.assign(cl);
end; // add

function Toutbox.add(kind: integer; dest: TRnQContact; flags: integer = 0; const info: string = ''): TOEvent;
var
  found: Boolean;
  i: integer;
begin
  result := NIL;
  found := FALSE;
  if (kind in [OE_addedYou, OE_auth, OE_authDenied]) then
    for i := 0 to count - 1 do
    begin
      result := getAt(i);
      if (kind = result.kind) and (dest.equals(result.whom)) then
      begin
        found := True;
        break;
      end;
    end;
  if not found then
  begin
    result := TOEvent.Create;
    add(result);
  end;
  result.kind := kind;
  result.flags := flags;
  result.whom := dest;
  result.info := info;
  result.wrote := now;
  result.lastmodify := now;
  result.cl := NIL;
  updateScreenFor(result.whom);
  saveOutboxDelayed := True;
end; // add

function Toutbox.getAt(idx: integer): TOEvent;
begin
  if (idx >= 0) and (idx < count) then
    result := list[idx]
  else
    result := NIL;
end;
// getAt

procedure Toutbox.Notify(Ptr: Pointer; Action: TListNotification);
begin
  inherited;
  if (Action = lnDeleted) and (Ptr <> NIL) then
    TOEvent(Ptr).Free;
end;

function Toutbox.remove(ev: TOEvent): Boolean;
var
  i: integer;
begin
  // Result := inherited remove(ev)>=0;
  i := IndexOf(ev);
  if i >= 0 then
  begin
    result := True;
    list[i] := NIL;
    Delete(i);
    updateScreenFor(ev.whom);
    saveOutboxDelayed := True;
  end
  else
    result := FALSE;
end; // remove

function Toutbox.popVisible: TOEvent;
var
  i: integer;
begin
  i := 0;
  while i < count do
  begin
    result := getAt(i);
    if (result.flags and IF_sendWhenImVisible = 0) or result.whom.imVisibleTo then
    begin
      list[i] := NIL;
      Delete(i);
      saveOutboxDelayed := True;
      updateScreenFor(result.whom);
      exit;
    end;
    inc(i);
  end;
  result := NIL;
end; // popVisible

function Toutbox.pop: TOEvent;
begin
  result := NIL;
  if count > 0 then
  begin
    result := getAt(0);
    list[0] := NIL;
    Delete(0);
    updateScreenFor(result.whom);
  end;
  saveOutboxDelayed := True;
end; // pop

function Toutbox.empty: Boolean;
begin
  result := count = 0
end;

function Toutbox.stFor(who: TRnQContact): Boolean;
var
  i: integer;
  ev: TOEvent;
begin
  result := FALSE;
  if Assigned(who) and (who is TRnQContact) then
    for i := 0 to count - 1 do
    begin
      ev := getAt(i);
      if Assigned(ev) and (ev.whom <> NIL) then
        if who.equals(ev.whom) then
        begin
          result := True;
          exit;
        end;
    end;
end; // stFor

procedure Toutbox.updateScreenFor(cnt: TRnQContact);
begin
  // if (uin = '') or (uin = '0') then exit;
  if (cnt = NIL) or (cnt.UID2cmp = '0') then
    exit;
  // redrawUIN(uin);
  roasterLib.redraw(cnt);
  if chatFrm <> NIL then
    with chatFrm do
      if (thischat <> NIL) and (thischat.who.equals(cnt)) then
        sbar.repaint;
  // RnQmain.sbar.Repaint;
  RnQmain.PntBar.repaint;
end; // updateScreenFor

function Toutbox.findID(ID: integer): integer;
var
  e: TOEvent;
begin
  for result := count - 1 downto 0 do
  begin
    e := getAt(result);
    if (e <> NIL) AND (e.ID = ID) then
      exit;
  end;
  result := -1;
end; // findID

/// /////////////////////////////////////////////////////////////////////

const
  OEK_kind = 1;
  OEK_flags = 2;
  OEK_email = 3;
  OEK_uin = 4;
  OEK_info = 5;
  OEK_wrote = 6;
  OEK_cl = 7;
  OEK_UID = 10;

function TOEvent.toString: RawByteString;

  procedure writeDown(code: integer; const data: RawByteString);
  begin
    result := result + int2str(length(data)) + int2str(code) + data
  end;

begin
  result := '';
  writeDown(OEK_kind, int2str(kind));
  writeDown(OEK_flags, int2str(flags));
  if kind = OE_email then
    writeDown(OEK_email, StrToUTF8(email))
  else
    // writeDown(OEK_uin, int2str(uid));
    if Assigned(whom) then
      writeDown(OEK_UID, StrToUTF8(whom.UID2cmp));
  writeDown(OEK_info, StrToUTF8(info));
  writeDown(OEK_wrote, dt2str(wrote));
  if Assigned(cl) then
    writeDown(OEK_cl, cl.toString);
end; // toString

function TOEvent.fromString(s: RawByteString): Boolean;
var
  i, l, code, next: integer;
  uid: TUID;
begin
  i := 1;
  result := True;
  try
    while i < length(s) do
    begin
      l := integer((@s[i])^);
      inc(i, 4);
      code := integer((@s[i])^);
      inc(i, 4);
      next := i + l;
      case code of
        OEK_kind:
          kind := integer((@s[i])^);
        OEK_flags:
          flags := integer((@s[i])^);
        OEK_wrote:
          wrote := Tdatetime((@s[i])^);
        OEK_info:
          info := UnUTF(copy(s, i, l));
        OEK_email:
          email := UnUTF(copy(s, i, l));
        OEK_uin:
          begin
{$IFDEF UID_IS_UNICODE}
            uid := IntToStr(integer((@s[i])^));
{$ELSE ansi}
            uid := IntToStrA(integer((@s[i])^));
{$ENDIF UID_IS_UNICODE}
            whom := Account.AccProto.getContact(uid);
          end;
        OEK_UID:
          begin
{$IFDEF UID_IS_UNICODE}
            uid := UnUTF(copy(s, i, l));
{$ELSE ansi}
            uid := copy(s, i, l);
{$ENDIF UID_IS_UNICODE}
            whom := Account.AccProto.getContact(uid);
          end;
        OEK_cl:
          begin
            if cl = NIL then
              cl := TRnQCList.Create;
            cl.fromString(Account.AccProto, copy(s, i, l), contactsDB);
          end;
      end;
      i := next;
    end;
  except
    result := FALSE;
  end;
end; // fromString

function TOEvent.Clone: TOEvent;
begin
  result := TOEvent.Create;
  result.kind := Self.kind;
  result.flags := Self.flags;
  result.whom := Self.whom;
  result.email := Self.email;
  result.info := Self.info;
  if Self.cl <> NIL then
    result.cl := cl.Clone
  else
    result.cl := NIL;
  result.wrote := Self.wrote;
  result.lastmodify := lastmodify;
  result.timeSent := timeSent;
  result.ID := ID;
  result.filepos := filepos;
end;

destructor TOEvent.Destroy;
begin
  if Assigned(cl) then
    FreeAndNil(cl);
  // FreeAndNil(whom);
  whom := NIL;
  // SetLength(UID, 0);
  SetLength(email, 0);
  SetLength(info, 0);
  inherited;
end;

constructor TOEvent.Create;
begin
  inherited;
  kind := OE_msg;
  // uin:integer;
  flags := 0;
  // UID   := '';
  whom := NIL;
  email := '';
  info := '';
  cl := NIL;
end;

end.