RnQ/RnQ/events.pas

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

interface

uses
  Windows, Graphics, Classes, Types, SysUtils, RDGlobal, RQThemes, RnQStrings, ICQCommon, ICQContacts;

{$I NoRTTI.inc}

const
  EK_null         = 00;
  EK_msg          = 01;
//  EK_url          = 02;
  EK_contacts     = 03;
//  EK_file         = 04;
  EK_authReq      = 05;
  EK_AddedYou     = 06;
  EK_incoming     = 07;
  EK_outgoing     = 08;
  EK_auth         = 09;
  EK_authDenied   = 10;
  EK_statuschange = 11;
//  EK_automsgreq   = 12;
//  EK_gcard        = 13;
//  EK_automsg      = 14;
  EK_typingBeg    = 15;
  EK_typingFin    = 16;
  EK_XstatusMsg   = 17;
//  EK_Xstatusreq   = 18;
  EK_BirthDay     = 18;
  EK_buzz         = 19;
  EK_last         = 19;

// adding events remember to initialize supportedBehactions
const
  ActiveEvents: array [0..14] of Integer = (EK_null, EK_msg, EK_contacts, EK_authReq, EK_AddedYou, EK_incoming, EK_outgoing,
                                           EK_auth, EK_authDenied, EK_statuschange, EK_typingBeg, EK_typingFin, EK_XstatusMsg,
                                           EK_BirthDay, EK_buzz);

  event2str: array [0..EK_last] of String = (
    '', 'msg', 'url', 'contacts', 'file', 'authreq', 'addedyou', 'incoming', 'outgoing', 'auth', 'authdenied',
    'statuschange', 'automsgreq', 'gcard', 'automsg', 'begtyping', 'fintyping', 'xstatusmsg', 'xstatusreq', 'buzz'
  );
  event2ShowStr: array [0..EK_last] of String = (
    '', Str_message, 'URL', 'Contacts', 'File', 'Authorization request',
    'Added you', 'Incoming', 'Outgoing', 'Authorization given',
    'Authorization denied', 'Status changed', 'Auto-message request',
    'Green-card', 'Auto-message', 'Begin typing', 'Finish typing',
    'XStatus message', 'XStatus request', 'Contact buzzing'
  );
  trayEvent2str: array [0..EK_last] of String = (
    '', 'message from %s', 'URL from %s', 'contacts from %s','file',
    '%s requires authorization', '%s added you', '%s is online','%s is offline',
    '%s authorized you', '%s denied authorization', '%s changed status',
    'auto-message requested by %s', 'greeting card from %s',
    'auto-message for %s', 'Started typing', 'Finished typing', '%s changed status',
    'XStatus requested by %s', ''
  );
  tipevent2str: array [0..EK_last] of String = (
    '', Str_message, 'Sent you an URL', 'Sent you contacts', 'Sent you file',
    'Requires authorization', 'Added you', 'is online', 'is offline',
    'Authorized you', 'Denied authorization', 'Changed status',
    'Requested your auto-message', 'Sent you a greeting card',
    'Auto-message', 'Started typing', 'Finished typing', 'Changed status',
    'Requested your XStatus', 'Tried to buzz you!'
  );
  tipBirth2str: array[0..2] of String = (
    'Has a birthday!', 'Has a birthday tomorrow!', 'Has a birthday after tomorrow!'
  );
  histHeadevent2str: array [0..EK_last] of String = (
    '', '', '', '', ' sent file', ': authorization request', '',
    ' is online', ' is offline', ': authorized', ': denied authorization', ': status %0:s',
    ': auto-message request', ': greeting card', ': auto-message', ' started typing',
    ' finished typing', ': status %0:s', ' requested your XStatus', '%0:s'
  );
  histBodyEvent2str: array [EK_null..EK_last] of String = (
    '', '', '', '',
    'Filename: %s\nCount: %d\nSize: %s\nMessage: %s', // EK_FILE
    '%s',   // EK_authReq
    'Added you to his/her contact list', // EK_AddedYou
    '', '', '', '%s', '', '',
    'Watch the greeting card', '', '', '', '%s', '', ''
  );

  EI_flags=1;
//  EI_shit=3;
  EI_UID = 11;
  EI_WID = 12;

  HI_event=-1;
  HI_hashed=-2;
  HI_cryptMode=-3;

type
  THeader = record
    Prefix: String;
    What: String;
    Date: String;
  end;

  Thevent = class
  private
    f_flags: Integer;
    f_chat, f_who: TICQContact;
    f_bin: TBytes;
    f_txt: String;
    class function toBytes(const bin: array of Variant): TBytes;
//    function getAsUTF8: RawByteString;
  public
    old_f_info: RawByteString;
    old_fIsMyEvent: Boolean;
    outgoing: Boolean;
    WID: String;
    ID: UInt64;
    kind,
    expires: Integer;  // tenths of second, negative if permanent
    when: TDateTime;
    cryptMode: Byte;
    cl: TRnQCList;
    fImgElm: TRnQThemedElementDtls;
    rowID: Integer;
    HistoryToken: Cardinal;
    PaintHeight: Integer;
    otherpeer: TICQContact; // used to keep track of other peer when "who" is us

    class function new(kind_: Integer; chat_, who_: TICQContact; when_: TDateTime; const text_: String; const bin_: array of Variant; flags_: Integer; pID: UInt64 = 0; const guID: String = ''): Thevent;
    class var hisFont: TFont;
    class var myFont: TFont;
    class var fntToken: Integer;
    class constructor Create;
    class destructor Destroy;

    destructor Destroy; override;
    function pic: TPicName;
    function PicSize: TSize;
    function Draw(DC: HDC; x, y: Integer): TSize;
    procedure applyFont(font: Tfont);
    function getFont: Tfont;
    function clone: Thevent;
    function urgent: boolean;
    function hasBody: Boolean;
    procedure writeToHistory(par: TUID = '');
    function old_getTextPart: String;
    function old_getBinPart: TBytes;
    procedure old_decryptInfo(const info: RawByteString);

    function GetBodyBin: TBytes;
    function GetBodyText: String;
    function GetHeaderTexts: THeader;
    function deleteBinary(const pMsg: String): String;
    procedure parseData(const pMsg: String);
    procedure setText(const txt: String);
    procedure setBinary(const bin: array of Variant);
    procedure setData(const txt: String; const bin: array of Variant);
    procedure setFlags(f: integer);
    procedure setWho(w: TICQContact);
    function isHis(c: TICQContact): Boolean;
    procedure setRawBin(bin: TBytes);
    procedure setImgBin(bin: TBytes);
//   published
    property flags: Integer read f_flags write setFlags;
    property chat: TICQContact read f_chat write f_chat;
    property who: TICQContact read f_who write setWho;
    property old_isMyEvent: Boolean read old_fIsMyEvent;
    property binaryData: TBytes read f_bin;
    property textData: String read f_txt;
    property rawBin: TBytes write setRawBin;
  end; // Thevent

  Thevents = array of Thevent;

  TeventQ = class(Tlist)
  public
    OnNewTop: procedure of object;

    constructor Create;
    destructor Destroy; override;
    function add(kind_: Integer; c: TICQContact; when: TDateTime; flags_: Integer): Thevent; overload;
    procedure add(ev: Thevent); overload;
    function Get(Index: Integer): Thevent;
    procedure Put(Index: Integer; Item: Thevent);
    function pop: Thevent;
    function top: Thevent;
    function empty: boolean;
    function chop: boolean;
    function find(kind_: Integer; c: TICQContact): Integer;
    function removeAt(i: Integer): Boolean;
    function firstEventFor(c: TICQContact): Thevent;
    function getNextEventFor(c: TICQContact; idx: Integer): Integer;
    function removeEvent(kind_: Integer; c: TICQContact): Boolean; overload;
    function removeEvent(c: TICQContact): Boolean; overload;
    procedure Clear; override;
    procedure fromString(const Qs: RawByteString);
    function toString: RawByteString;
    procedure removeExpiringEvents;
    property Items[Index: Integer]: Thevent read Get write Put; default;
  end; // TeventQ

  function event2imgName(e: Integer): TPicName;

var
  hasMsgOK :  Boolean;
  hasMsgSRV : Boolean;

implementation

uses
  Forms, StrUtils,
{$IFDEF UNICODE}
  AnsiStrings,
{$ENDIF UNICODE}
  RQUtil, RDUtils, RnQBinUtils, RnQLangs, RnQCrypt, RnQGlobal, RnQPics,
  chatDlg, utilLib, globalLib, roasterLib, pluginutil, history,
  ICQConsts, protocol_ICQ, SQLiteDB;

function Thevent.clone:Thevent;
begin
  Result := Thevent.Create;
  Result.rowID := rowID;
  Result.ID := ID;
  Result.WID := WID;
  Result.kind := kind;
  Result.chat := chat;
  Result.who := who;
  Result.otherpeer := otherpeer;
  Result.when := when;
  Result.old_fIsMyEvent := old_fIsMyEvent;
  Result.outgoing := outgoing;
  Result.f_txt := f_txt;
  Result.f_bin := f_bin;
  Result.old_f_info := old_f_info;
  Result.flags := flags;
  Result.cryptMode := cryptMode;
  Result.HistoryToken := 0;
  Result.fImgElm.ThemeToken := -1;
  try
    if cl <> nil then // By Rapid !
      Result.cl := cl.clone
    else
      Result.cl := nil;
  except
    Result.cl := nil
  end;
  Result.expires := expires;
end; // clone

destructor Thevent.Destroy;
begin
  FreeAndNil(cl);
  SetLength(f_txt, 0);
  SetLength(f_bin, 0);
  SetLength(old_f_info, 0);
  inherited;
end;

procedure Thevent.WriteToHistory(par: TUID = '');
begin
  if (par = '') and Assigned(chat) then
    par := chat.UID2cmp;
  if (par = '') and Assigned(who) then
    par := who.UID2cmp;
  SQLDB.WriteEvent(par, Self);
end;

function Thevent.urgent: Boolean;
begin
  Result := flags and IF_urgent > 0;
end;

procedure Thevent.applyFont(font:Tfont);
begin
 if outgoing then
  theme.ApplyFont('history.my', font) //history.myfont
 else
  theme.ApplyFont('history.his', font); //history.hisfont
end;

function Thevent.getFont:Tfont;
begin
 if theme.token <> fntToken then
   begin
     if not Assigned(myFont) then
      myFont := TFont.Create;
     myFont.Assign(Screen.MenuFont);
     theme.ApplyFont('history.my', myFont); //history.myfont
     if not Assigned(hisFont) then
      hisFont := TFont.Create;
     hisFont.Assign(Screen.MenuFont);
     theme.ApplyFont('history.his', hisFont); //history.hisFont
     fntToken := theme.token;
   end;
 if outgoing then
  result := myFont
 else
  result := hisFont;
end;

function Thevent.pic: TPicName;
begin
  if (kind = EK_msg) then
  begin
    if hasMsgOK and ((Self.flags and IF_not_delivered) > 0)then
      Result := PIC_MSG_BAD// + 'ok'
    else
      if hasMsgOK and
//    ((Self.flags and (IF_delivered or IF_not_delivered)) > 0) then
//    if
      ((Self.flags and IF_delivered) > 0) then
        Result := PIC_MSG_OK// + 'ok'
      else
        if hasMsgSRV and ((Self.flags and IF_SERVER_ACCEPT) > 0)then
          Result := PIC_MSG_SERVER// + 'ok'
        else
          Result := PIC_MSG// + 'ok'
  end else if kind = EK_buzz then
    Result := PIC_BUZZ
  else
    Result := event2imgName(kind)
end;

function Thevent.PicSize : TSize;
begin
  if fImgElm.ThemeToken <> theme.token then
   begin
    fImgElm.picName := pic;
   end;
  PicSize := theme.GetPicSize(fImgElm);
end;

function Thevent.Draw(DC : HDC; x, y : Integer) : TSize;
begin
  if fImgElm.ThemeToken <> theme.token then
   begin
    fImgElm.picName := pic;
   end;
  Draw := theme.drawPic(dc, Point(x, y), fImgElm);
end;

class constructor Thevent.Create;
begin
  myFont := nil;
  hisFont := nil;
  hasMsgOK := False;
  fntToken := -1;
end;

class destructor Thevent.Destroy;
begin
  FreeAndNil(myFont);
  FreeAndNil(hisFont);
end;

class function Thevent.new(kind_: Integer; chat_, who_: TICQContact; when_: TDateTime; const text_: String; const bin_: array of Variant; flags_: Integer; pID: UInt64 = 0; const guID: String = ''): Thevent;
begin
  Result := Thevent.create;
  Result.kind := kind_;
  Result.chat := chat_;
  Result.who := who_;
  Result.when := when_;
  Result.flags := flags_;
  Result.outgoing := False;
  Result.expires := -1;
  Result.cl := nil;
  Result.ID := pID;
  Result.WID := guID;
  Result.f_txt := text_;
  Result.f_bin := toBytes(bin_);
  Result.HistoryToken := 0;
  Result.fImgElm.ThemeToken := -1;
end; // new

function Thevent.deleteBinary(const pMsg: String): String;
var
  i, k: Integer;
begin
  Result := pMsg;
  i := Pos(RnQImageExTag, Result);
  while i > 0 do
  begin
    k := PosEx(RnQImageExUnTag, Result, i+12);
    if k <= 0 then Break;
    Delete(Result, i, k-i+13);
    i := PosEx(RnQImageExTag, Result, i);
  end;
  i := Pos(RnQImageTag, Result);
  while i > 0 do
  begin
    k := PosEx(RnQImageUnTag, Result, i+10);
    if k <= 0 then Break;
    Delete(Result, i, k-i+11);
    i := PosEx(RnQImageTag, Result, i);
  end;
end;

procedure Thevent.parseData(const pMsg: String);
begin
  setText(deleteBinary(pMsg));
  setRawBin(parseMsgImages(pMsg));
end;

function Thevent.GetHeaderTexts: THeader;
var
  Dsp, Res: String;
  s: TStrings;
begin
  if not Assigned(Self) then
    Exit;

  if kind in [EK_INCOMING, EK_OUTGOING, EK_STATUSCHANGE] then
    Res := statusNameExt2(binToStatus(f_bin), binToXStatus(f_bin))
  else if kind = EK_XstatusMsg then
  try
    s := TStringList.Create;
    str2strings(dword_Zero, f_txt, s);
    Res := s[0];
    s.Free;
  except
    Res := '';
  end;

  if Assigned(who) then
  begin
    if (kind = EK_buzz) then
      if outgoing then
      begin
        Dsp := GetTranslation('You');
        Res := ' ' + GetTranslation('tried to buzz this contact!');
      end
        else
      begin
        Dsp := who.displayed;
        Res := ' ' + GetTranslation('tried to buzz you!');
      end
    else
      Dsp := who.Displayed
  end else
    Dsp := '';

  Result.Prefix := IfThen(IF_multiple and flags > 0, GetTranslation('(multi-send)'));
  Result.What := Dsp + GetTranslation(histheadevent2str[kind], [Res]);
  Result.Date := FormatDateTime(timeformat.chat, when);
end; // GetHeaderText

function Thevent.old_getTextPart: String;
var
  sa: RawByteString;
  i, k : integer;
begin
  Result := '';
  case kind of
    EK_AUTH,
    EK_ADDEDYOU,
    EK_AUTHREQ,
    EK_AUTHDENIED:
      Result := old_UnUTF(old_f_info);
    EK_statuschange:
      if flags and IF_XTended_EVENT > 0 then
      begin
        if Length(old_f_info) > 6+4 then
          Result := old_UnUTF(copy(old_f_info, 11, length(old_f_info)))
        else
          Result := '';
      end;
    EK_XstatusMsg:
      if length(old_f_info) > 1+4 then
      begin
        i := _int_at(old_f_info, 2) + 1 + 4 + 1;
        if (i > 0) and (length(old_f_info) > i+4) then
        begin
          k := _int_at(old_f_info, i);
          Result := old_UnUTF(copy(old_f_info, i+4, k));
        end;
      end;
    EK_CONTACTS:
      begin
        sa := old_f_info;
        // backward compatibility (converts old format)
        i := length(sa);
        if i > 30 then i := 30;
        while (i > 0) and (sa[i] <> #2) do dec(i);
        if i <= 0 then
        begin
          Result := sa;
          Exit;
        end;
//      s:=sa; result:='';
        while sa > '' do
        begin
          chop(#2, sa);
            Result := Result + chop(', ', sa) + CRLF;
        end;
      end;
    EK_MSG:
      Result := old_UnUTF(deleteBinary(old_f_info));
  end;
end;

function Thevent.old_getBinPart: TBytes;
begin
  case kind of
    EK_incoming,
    EK_statuschange:
      Result := bytesOf(copy(old_f_info, 1, 6));
    EK_XstatusMsg:
      Result := bytesOf(copy(old_f_info, 1, 1));
    EK_MSG:
      Result := parseMsgImages(old_f_info);
    else
      Result := nil;
  end;
end;

procedure Thevent.old_decryptInfo(const info: RawByteString);
begin
  case cryptMode of
    CRYPT_SIMPLE:
      old_f_info := decritted(info, StrToIntDef(who.uid, 0));
    CRYPT_KEY1:
      old_f_info := decritted(info, histcrypt.pwdKey);
  end;
end;

function Thevent.GetBodyText: String;
var
  str: TStrings;
begin
  Result := '';
  case kind of
    EK_AUTH,
    EK_ADDEDYOU:
      Result := getTranslation(histBodyEvent2str[kind]);
    EK_AUTHREQ,
    EK_AUTHDENIED:
      Result := getTranslation(histBodyEvent2str[kind], [f_txt]);
    EK_statuschange:
      if flags and IF_XTended_EVENT > 0 then
        Result := f_txt;
    EK_XstatusMsg:
      try
        str := TStringList.Create;
        str2strings(dword_Zero, f_txt, str);
        Result := str[1];
        str.Free;
      except end;
    EK_CONTACTS, EK_MSG:
      Result := f_txt;
  end;
  convertAllNewlinesToCRLF(Result);
end; // getBodyText

function Thevent.getBodyBin: TBytes;
begin
  Result := f_bin;
end;
{
function Thevent.getAsUTF8: RawByteString;
begin
  Result := UTF(f_txt);
end;
}
function Thevent.hasBody: Boolean;
begin
case kind of
  EK_AUTH,
  EK_ADDEDYOU,
  EK_AUTHREQ,
  EK_AUTHDENIED:
    Result := True;
  EK_statuschange:
    Result := flags and IF_XTended_EVENT > 0;
  EK_XstatusMsg,
  EK_CONTACTS,
  EK_MSG:
    Result := Length(f_txt) > 0;
  else
    Result := False;
  end;
end;

procedure Thevent.setText(const txt: String);
begin
  setData(txt, []);
end;

procedure Thevent.setBinary(const bin: array of Variant);
begin
  setData('', bin);
end;

class function Thevent.toBytes(const bin: array of Variant): TBytes;
var
  v: Variant;
  l, s: Integer;

  function GetVarSize: Integer;
  begin
    case TVarData(v).VType of
      varInteger: Result := SizeOf(Integer);
      varByte: Result := SizeOf(Byte);
      varBoolean: Result := SizeOf(Boolean);
    end;
  end;

begin
  SetLength(Result, 0);
  if Length(bin) > 0 then
  for v in bin do
  with TVarData(v) do
  begin
    l := Length(Result);
    s := GetVarSize;
    SetLength(Result, l + s);
    case VType of
      varInteger:
        Move(VInteger, Result[l], s);
      varByte:
        Move(VByte, Result[l], s);
      varBoolean:
        Move(VBoolean, Result[l], s);
    end;
  end;
end;

procedure Thevent.setRawBin(bin: TBytes);
begin
  if (bin = nil) or (Length(bin) = 0) then
    SetLength(f_bin, 0)
  else
    f_bin := bin;
end;

procedure Thevent.setImgBin(bin: TBytes);
var
  OutSize: LongWord;
  OutSizeBytes: array[0..3] of Byte;
begin
  if (bin = nil) or (Length(bin) = 0) then
    SetLength(f_bin, 0)
  else begin
    OutSize := Length(bin);
    PInteger(@OutSizeBytes)^ := OutSize;
    SetLength(f_bin, 4 + OutSize);
    Move(OutSizeBytes[0], f_bin[0], 4);
    Move(bin[0], f_bin[4], Length(bin));
  end;
end;

procedure Thevent.setData(const txt: String; const bin: array of Variant);
begin
  if not (txt = '') then
    f_txt := txt;
  if (Length(bin) > 0) then
    f_bin := toBytes(bin);
end;

procedure Thevent.setFlags(f : integer);
begin
  f_flags := f;
  fImgElm.ThemeToken := -1;
  fImgElm.Element := RQteDefault;
  fImgElm.pEnabled := True;
end;

procedure Thevent.setWho(w : TICQContact);
begin
  f_Who := w;
  old_fIsMyEvent := (not Assigned(f_Who)) or Account.AccProto.IsMyAcc(w);
end;

function Thevent.isHis(c: TICQContact): Boolean;
begin
  if Assigned(c) then
    if Assigned(otherpeer) then
      Result := c.equals(otherpeer)
    else
      Result := c.equals(who)
  else
    Result := False;
end;

constructor TeventQ.create;
begin
inherited create;
blinking:=TRUE;
end; // create

function TeventQ.find(kind_:integer; c: TICQContact):integer;
begin
result:=count;
while result > 0 do
  begin
  dec(result);
  with Thevent(items[result]) do
    if (kind = kind_) and isHis(c) then
      exit;
  end;
result:=-1;
end; // find

function TeventQ.Get(Index: Integer): Thevent;
begin
  Result := Thevent(inherited get(Index));
end;

procedure TeventQ.Put(Index: Integer; Item: Thevent);
begin
  inherited put(Index, Item);
end;

procedure TeventQ.add(ev:Thevent);
begin
//  if sortBy = SB_event then
//    roasterLib.sort(ev.who);
  inherited add(ev);
  if ev.kind in [EK_INCOMING, EK_OUTGOING] then
    ev.expires := tempBlinkTime;        // tenth of second
  if count = 1 then
    if assigned(OnNewTop) then OnNewTop;
  saveInboxDelayed := True;
  if Assigned(chatFrm) then
    chatFrm.RefreshTaskbarButtons;
  roasterLib.UpdateInPlace(ev.who);
end; // add

function TeventQ.add(kind_:integer; c: TICQContact; when:Tdatetime; flags_:integer):Thevent;
begin
  result := Thevent.create;
  result.kind := kind_;
  result.who := c;
  result.when := when;
  result.flags := flags_;
  add(result);
end; // add

function TeventQ.pop:Thevent;
begin
  result := top;
  removeAt(0);
end; // pop

function TeventQ.top:Thevent;
begin if count=0 then result:=NIL else result:=first end;

procedure TeventQ.clear;
begin
  while count > 0 do
    pop.free;
end; // clear

destructor TeventQ.Destroy;
begin
  clear;
  inherited;
end; // destroy

function TeventQ.empty:boolean;
begin
  result := count = 0
end;

function TeventQ.chop:boolean;
begin
  result := False;
  if not empty then
  begin
    pop.free;
    result := True;
  end;
end; // chop

function TeventQ.removeAt(i: integer): boolean;
var
  c, c2: TICQContact;
begin
  Result := (i >= 0) and (i < count);
  if Result then
  begin
    c := Thevent(items[i]).who;
    c2 := Thevent(items[i]).otherpeer;
    delete(i);
    if i = 0 then
      if Assigned(OnNewTop) then
        OnNewTop;
    if Assigned(c2) and (c2 <> c) then
      roasterLib.UpdateInPlace(c2);
    roasterLib.UpdateInPlace(c);
  end;
end; // removeAt

function TeventQ.firstEventFor(c: TICQContact): Thevent;
var
  i: integer;
begin
  Result := nil;
  i := 0;
  if Assigned(c) then
  while i < count do
  begin
    try
      if Thevent(items[i]).isHis(c) then
        Exit(Thevent(items[i]));
    except end;
    inc(i);
  end;
end; // firstEventFor

function TeventQ.getNextEventFor(c: TICQContact; idx: Integer): Integer;
var
  i: integer;
begin
  if idx >= 0 then
    i:=idx
   else
    i := 0;
  if Assigned(c) then
//result := NIL;
  while i < count do
    begin
     try
      result := i;
      if Thevent(items[i]).isHis(c) then
       exit;
     except
       result := -1;
       exit;
     end;
    inc(i);
    end;
  result:=-1;
end; // firstEventFor

function TeventQ.removeEvent(kind_: integer; c: TICQContact): boolean;
var
  i : Integer;
begin
  Result := false;
  repeat
    i := find(kind_, c);
    if i >= 0 then
     result := removeAt(i);
  until (i < 0);
end;

function TeventQ.removeEvent(c: TICQContact): boolean;
var
  i: integer;
begin
  result := FALSE;
  i := count;
  while i > 0 do
    begin
     dec(i);
     if Thevent(items[i]).isHis(c) then
      begin
       result:=TRUE;
       removeAt(i)
      end
    end;
end; // removeEvent

const
  FK_KIND    = 00;
  FK_EXPIRES = 01;
  FK_WHO     = 02;
  FK_CL      = 03;
  FK_WHEN    = 04;
//  FK_URGENT  = 05;  OBSOLETE
  FK_BIN     = 06;
  FK_FLAGS   = 07;

  FK_WHO_STR = 12;
  FK_TXT     = 16; // UTF8 text

procedure TeventQ.fromString(const Qs: RawByteString);
var
  t,l:integer;
  e:Thevent;
  uin : Integer;
  s : RawByteString;
  ofs : Integer;
begin
  ofs := 1;
  try
    clear;
    e:=NIL;
    while length(Qs) >= 8+ofs do
     begin
      t:=integer((@Qs[ofs])^); // 1234
      inc(ofs, 4);
      l:=integer((@Qs[ofs])^); // 5678
      inc(ofs, 4);

      if not within(0,l,1000000)
       or not within(0,t,100)
       or (length(Qs)-ofs < 8+l) then break; // corrupted file

      s := Copy(Qs, ofs, l);
      inc(ofs, l);
      case t of
        FK_KIND: begin
                if Assigned(e) then
                 try
                   if Not Assigned(e.who) then
                    begin
                     Remove(e);
                     FreeAndNil(e);
                    end;
                  except
                 end;
                e:=add(integer((@s[1])^), Account.AccProto.getmyInfo, 0, 0);
             end;
        FK_EXPIRES: e.expires:=integer((@s[1])^);
        FK_WHO:
      begin
        uin := integer((@s[1])^);
        if uin > 0 then
          e.who := Account.AccProto.getContact(uin)
        else
          e.who := nil;
        if Assigned(e.who) then
          NILifNIL(e.who, True)
        else
          e.who:= Account.AccProto.getMyInfo;
      end;
        FK_WHO_STR:
      begin
        e.who := Account.AccProto.getContact(s);
        if Assigned(e.who) then
          NILifNIL(e.who, True)
        else
          e.who:= Account.AccProto.getMyInfo;
      end;
        FK_WHEN: e.when:=Tdatetime((@s[1])^);
        FK_FLAGS: e.flags:=integer((@s[1])^);
        FK_BIN: e.rawBin := BytesOf(s);
        FK_TXT: e.setText(s);
        FK_CL:
          if l > 0 then
           begin
            e.cl := TRnQCList.create;
            e.cl.fromString(s, Account.AccProto.contactsDB);
           end;
    end;//case
     end;
   finally
    saveListsDelayed := True; // If we added to NIL, then it would be need!
  end;
end; // fromString

function TeventQ.toString: RawByteString;
var
  i: Integer;
  s: RawByteString;
begin
  Result := '';
  i := 0;
  while i < count do
  with Thevent(items[i]) do
  begin
    try
      s := TLV2(FK_KIND, int2str(kind))
         + TLV2(FK_EXPIRES, int2str(expires))
         + TLV2(FK_WHO, int2str(StrToIntDef(who.uid, 0)))
         + TLV2(FK_WHEN, dt2str(when))
         + TLV2(FK_FLAGS, int2str(flags))
         + TLV2(FK_BIN, StringOf(f_bin))
         + TLV2(FK_TXT, f_txt);

      if assigned(cl) then s := s + TLV2(FK_cl, cl.toString);
      if StrToIntDef(who.uid, 0) = 0 then
        s := s + TLV2(FK_WHO_STR, who.uid);

      Result := Result + s;
    except
      s := '';
    end;
    inc(i);
  end;
end; // toString

procedure TeventQ.removeExpiringEvents;
var
  i:integer;
begin
i:=0;
while i < count do
  if Thevent(items[i]).expires >= 0 then
    removeAt(i)
  else
    inc(i);
end; // removeExpiringEvents

// function event2imgidx(e:integer):integer;
function event2imgName(e: integer): TPicName;
begin
  case e of
    EK_MSG:
      result := PIC_MSG;
    EK_CONTACTS:
      result := PIC_CONTACTS;
    EK_ADDEDYOU:
      result := PIC_ADDEDYOU;
    EK_AUTHREQ:
      result := PIC_AUTH_REQ;
    EK_typingBeg:
      result := PIC_TYPING;
    EK_typingFin:
      result := PIC_TYPING;
    EK_incoming:
      result := PIC_INCOMING;
    EK_outgoing:
      result := PIC_OUTGOING;
    EK_BUZZ:
      result := PIC_BUZZ;
  else
    result := PIC_OTHER_EVENT;
  end;
end; // event2imgidx

initialization

hasMsgOK := False;

end.