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
  Winapi.Windows, System.Classes, System.Types, System.SysUtils, Vcl.Graphics, Vcl.ExtCtrls,
  RDGlobal, RQThemes, RnQStrings, ICQCommon, ICQContacts;

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;

{$I PubRTTI.inc}

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

  {$I NoRTTI.inc}

  Phevent = ^Thevent;
  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: Integer;
    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
    GUID: String;

    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 = ''; patch: Boolean = False);
    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;

  Thevents = TArray;

  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 Notify(Ptr: Pointer; Action: TListNotification); override;
    procedure FromString(const Qs: RawByteString);
    function ToString: RawByteString;
    procedure RemoveExpiredEvents;
    property Items[Index: Integer]: Thevent read Get write Put; default;
  end;

  function Event2ImgName(e: Integer): TPicName;

var
  HasMsgOK:  Boolean;
  HasMsgSRV: Boolean;
  BlinkTimer: TTimer;

implementation

uses
  System.StrUtils, System.DateUtils, Vcl.Forms,
{$IFDEF UNICODE}
  System.AnsiStrings,
{$ENDIF UNICODE}
  RDUtils, RnQBinUtils, RnQLangs, RnQCrypt, RnQGlobal, RnQPics,
  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;
  Result.GUID := GUID;
  try
    if cl <> nil then // By Rapid !
      Result.cl := cl.clone
    else
      Result.cl := nil;
  except
    Result.cl := nil
  end;
end;

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 = ''; patch: Boolean = False);
begin
  if (par = '') and Assigned(chat) then
    par := chat.UID;
  if (par = '') and Assigned(who) then
    par := who.UID;
  if patch then
    SQLDB.PatchEvent(par, Self)
  else
    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.cl := nil;
  Result.ID := pID;
  Result.WID := guID;
  Result.GUID := Account.AccProto.CreateNewGUID;
  Result.f_txt := text_;
  Result.f_bin := toBytes(bin_);
  Result.HistoryToken := 0;
  Result.fImgElm.ThemeToken := -1;
end;

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;

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, calculate_KEY1(AccPass));
  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;

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);
    else
      Result := 0;
    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 := False;
end;

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;

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 (Count = 1) and Assigned(OnNewTop) then
    OnNewTop;
  ActionManager.Execute(AK_SAVEINBOX, SaveDelay);
  roasterLib.UpdateInPlace(ev.who);
end;

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;

function TeventQ.Pop: Thevent;
begin
  Result := Top;
  RemoveAt(0);
end;

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;

procedure TeventQ.Notify(Ptr: Pointer; Action: TListNotification);
var
  State: Boolean;
begin
  State := Count > 0;
  if BlinkTimer.Enabled = State then
    Exit;
  Blinking := False;
  BlinkTimer.Enabled := State;
  if Assigned(StatusIcon) then
    StatusIcon.Update;
end;

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

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;

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;

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;

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;

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;

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, uin, ofs: Integer;
  e: Thevent;
  s: RawByteString;
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_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
    ActionManager.Execute(AK_SAVECONFIG, SaveDelay);
  end;
end;

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_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;

procedure TeventQ.RemoveExpiredEvents;
var
  I: Integer;
  Diff: Int64;
begin
  I := 0;
  while I < Count do
  if Thevent(Items[I]).kind in [EK_incoming, EK_outgoing] then
  begin
    Diff := MilliSecondsBetween(Now, Thevent(Items[I]).when);
    if Diff >= TempBlinkTime then
    begin
      Thevent(Items[I]).Free;
      RemoveAt(I);
    end else
      Inc(I);
  end else
    Inc(I);
end;

// 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;

initialization
  HasMsgOK := False;
  BlinkTimer := TTimer.Create(nil);

finalization
  FreeAndNil(BlinkTimer);

end.