RnQ/RnQ/ICQ/ICQContacts.pas

{
  This file is part of R&Q.
  Under same license
}
unit ICQContacts;
{$I RnQConfig.inc}
{$I-}
{$X+}
interface

uses
  System.Classes, System.SysUtils, System.Types,
  RDGlobal, RnQGraphics32, ICQCommon, ICQConsts;

{$I PubRTTI.inc}

type
  TLanguages = array [1..3] of String;
//  TInterestBlock = record
//    Code: Integer;
////    Str: String;
//    Names: TStrings;
//  end;
//  TInterests = record
//    InterestBlock: array[0..3] of TInterestBlock;
//    Count: Integer;
//  end;
  TColors = record
    AvatarBack: String;
    AvatarText: String;
    PhotoBack: String;
    PhotoText: String;
  end;

  TAnketa = record
    UID, First, Nick, Friendly: String;
    AvatarURL: String;
    Bot: Boolean;
  end;

  {$I NoRTTI.inc}

  TRnQCList = class;
  TICQContact = class;
  TContactProc = procedure(c: TICQContact);

  TCListEnumerator = class
    private
      FIndex: Integer;
      FCL: TRnQCList;
    public
      constructor Create(pCL: TRnQCList);
      function GetCurrent: TICQContact; inline;
      function MoveNext: Boolean;
      property Current: TICQContact read GetCurrent;
  end;

  TRnQCList = class(TList)
  protected
    enumIdx: Integer;
  public
    function GetEnumerator: TCListEnumerator;
    procedure ResetEnumeration;
    function hasMore:boolean;
    function getNext: TICQContact;
    function get(const UID: TUID): TICQContact; OverLoad;
    function get(const uin: Integer): TICQContact; overload; //OverRide;
    function getAt(const idx: Integer): TICQContact;
    function putAt(const idx: Integer; c: TICQContact): Boolean;
    function exists(c: TICQContact):boolean; overload;
    function exists(const uin: TUID):boolean; overload;
    function empty: Boolean;
    function add(const UID: TUID): TICQContact; overload; //OverRide;
    function add(c: TICQContact):boolean; overload;
    function add(p:pointer):boolean; overload;
    function add(cl:TRnQCList):TRnQCList; overload;
    function remove(c: TICQContact):boolean; overload;
    function remove(p:pointer):boolean; overload;
    function remove(cl:TRnQCList):TRnQCList; overload;
    function intersect(cl:TRnQCList):TRnQCList;
    function Text: String;
    function toString:RawByteString; reintroduce;
    function fromString(const s: RawByteString; db:TRnQCList):boolean;
    function clone:TRnQCList;
    procedure assign(cl:TRnQCList);
    procedure apply(p: TContactProc);
    function idxOf(const uin: TUID):integer; overload;
    function idxOf(uin: Integer):integer; overload;
    function _idxOf(const uid:TUID):integer; overload;
    function toIntArray: TIntegerDynArray;
    procedure ForEach(const AIteratorEvent: TProc);
//    procedure ForEachAsync(const AIteratorEvent: TProc);
    function GetCount(Group: Integer; Divisor: Integer = -1; OnlyOnline: Boolean = False): Integer;
    procedure getOnlOfflCount(var pOnlCount, pOfflCount: Integer);
    property Count;
    class function FromArray(UINs: TArray; UseDB: Boolean = True): TRnQCList;
    class function FromVariantArray(UINs: Variant; UseDB: Boolean = True): TRnQCList;
  end;

  PICQContact = ^TICQContact;
  TICQContact = class
  public
    UID: TUID;
//    ClientStr: AnsiString;
    ClientPic: TPicName;
    ClientDesc: String;
    Display,       // if user want to rename this contact
    Nick, TmpNick,
    First,
    Last,
    lclImportant: String;
    Antispam: record
      Tries: Byte;
      LastQuests: array of String;
    end;
    CntIsLocal,
    Authorized,
    Muted,
    SendTransl: Boolean;
    Typing: packed record
      TypingTime: TDateTime;
      bSupport,
      bIsTyping,
      bIAmTyping: Boolean;
    end;
    Group: Integer;
    Birth,
    BirthL,       // Local Birthdate
    LastBDInform,
    LastTimeSeenOnline: TDateTime;   // Local time
    Icon_Path: String;
    Icon: packed record
      Bmp: TRnQBitmap;
      Cache: TRnQBitmap;
      ToShow: Byte;
      Flags: byte;
      HL: byte;
      IsBmp: Boolean;
      WasDownloaded: Boolean;
      ID: Word;
    end;
    Data: Pointer;
    UININT: Integer;
    //Invisible: Boolean;
    NoClient: Boolean;
    ClientClosed: TDateTime;
    Status: TICQstatus;
    PrevStatus: TICQstatus;
    UserType: TICQContactType;
    Crypt: record
      SupportEcc: Boolean;
      SupportCryptMsg: Boolean;
      CryptPWD: AnsiString;
      EccPubKey: AnsiString;
      EccMsgKey: AnsiString;
    end;
    Gender: SmallInt;
    Age: Integer;
    MarStatus: Word;
    Email,
    City,
    Country,
    State,
    About,
    // work
    WorkPhone,
    Regular,
    Cellular,
    SMSMobile,
    OtherPhone,
//    lclImportant,
    ssImportant,
    ssCell1,
    ssCell2,
    ssCell3,
    ssCell4,
    ssNickname: String;
    OnlineTime: DWord;       // <20> <20><>!
    IdleTime: Word;          // <20> <20><>!
    Lang: TLanguages;
    MemberSince,          // UTC
    OnlineSince,          // Local time
    LastCapsUpdate,       // Local time
    LastInfoUpdate,       // Local time
    LastStatusUpdate,     // Local time
    LastStatusSubscribe,  // Local time
    InfoUpdatedTo: TDateTime; // Local time
    Official,
    Bot,
    Deleted,
    SMSable,
    NoDB,
    BirthFlag,
    isMobile,
    isAIM: Boolean;
    CapabilitiesBig: set of 1..45;
    CapabilitiesSm: set of 1..40;
    ExtraCapabilities: RawByteString;
    InfoToken: RawByteString;
    Cookie: RawByteString;

    LifeStatus: String;
    StatusStr: String;
    XStatus: String;
    XStatusIndex: Byte;
    IconID: String;
    IconColors: TColors;
//    Interests: TInterests; // By Shyr
    constructor Create(const uin_: TUID);
    destructor Destroy; override;
//     class operator Implicit(const a: AnsiString) : TContact; inline;// Implicit conversion of an Integer to type TMyClass
    function Equals(c: TICQContact): Boolean; reintroduce; overload;
    function Equals(const pUID: TUID): Boolean; reintroduce; overload;
    function Equals(pUIN: Integer): Boolean; reintroduce; overload;
    procedure Clear1;
    procedure Clear;
    procedure SetOffline;
    procedure OfflineClear;
    function IsInRoster: Boolean;
    function IsInList(List: TLIST_TYPES): Boolean;
    function IsOnline: Boolean;
    function IsOffline: Boolean;
    function IsRecent: Boolean;
    function IsMuted: Boolean;
    function CanEdit: Boolean;
    function GetBDay: TDateTime;
    function Days2Bd: SmallInt;
    function UINAsStr: String; inline;
    function UIN2Show: String;
    procedure SetGroupName(const Name: String);
    function GetStatusName: String; overload;
    function StatusImg: TPicName;
    function GetStatus: Byte;
    procedure SetDisplay(const s: String);
    function ParseDBrow(ItemType: Integer; const item: RawByteString): Boolean;
    procedure ViewInfo;
    class function TrimUID(const sUID: TUID): TUID;
//    procedure AddInterest(idx: Byte; code: Integer; str: String);
//    procedure ClearInterests;
    function Displayed: String;
  end; // TICQContact

//  Tcontact = TICQContact;
//  function  ICQCL_buinlist(cl : TRnQCList; Proto : IRnQProtocol):string;
  procedure ICQCL_setStatus(cl : TRnQCList; st: TICQStatus);

var
  OnContactCreation, OnContactDestroying: TContactProc;
  OnStatusDisable: array [0..15] of TOnStatusDisable;

implementation

uses
  System.AnsiStrings, System.Variants,
  GlobalLib, RQUtil, RnQLangs, RDUtils, RnQBinUtils, viewinfoDlg, utilLib, roasterLib, Protocol_ICQ;

{ TCListEnumerator }

constructor TCListEnumerator.Create(pCL: TRnQCList);
begin
  inherited Create;
  FIndex := -1;
  FCL := pCL;
end;

function TCListEnumerator.GetCurrent: TICQContact;
begin
  Result := FCL.getAt(FIndex);
end;

function TCListEnumerator.MoveNext: Boolean;
begin
  Result := FIndex < FCL.Count - 1;
  if Result then
    Inc(FIndex);
end;

/////////////// TRnQCList  ///////////////////////////////////////////////

function TRnQCList.getAt(const idx: Integer): TICQContact;
begin
  if (idx>=0) and (idx
    Result := TICQContact(List[Idx])
  else
    Result := nil
end; // getAt

function TRnQCList.idxOf(const uin: TUID): Integer;
var
  min, max: Integer;
  u: TUID;
  uid: TUID;
  c: TICQContact;
begin
  UID := AnsiLowerCase(TICQContact.TrimUID(uin));
  if TList(Self).count = 0 then
   begin
    result:=-1;
    exit;
   end;
  min:=0;
  max:= TList(Self).count - 1;
  repeat
    result:=(min+max) div 2;
    c := getAt(result);
    if Assigned(c) then
      u:=c.UID
     else
      u := '';
    if u = uid then
      exit
    else
      if u > uid then
        max:=result-1
      else
        min:=result+1;
  until min > max;
  result:=-1;
end; // idxOf

function TRnQCList._idxOf(const uid: TUID):integer;
var
  min, max: Integer;
  u: TUID;
  c: TICQContact;
begin
//  UID := AnsiLowerCase(iProto.getContactClass.trimUID(uin));
  if count = 0 then
   begin
    result:=-1;
    exit;
   end;
  min:=0;
  max:=count-1;
  repeat
    result:=(min+max) div 2;
    c := getAt(result);
    if Assigned(c) then
      u:=c.UID
     else
      u := '';
    if u = uid then
      exit
    else
      if u > uid then
        max:=result-1
      else
        min:=result+1;
  until min > max;
  result:=-1;
end; // idxOf

function TRnQCList.idxOf(uin: Integer):integer;
var
  min, max: Integer;
  uid: TUID;
  c: TICQContact;
begin
  uid := IntToStr(uin);
  min:=0;
  max:=count-1;
  if max > 0 then
  repeat
    result:=(min+max) div 2;
    c := getAt(result);
    if Assigned(c) then
     begin
      if c.UID = uid then
        exit
      else
        if c.UID > uid then
          max:=result-1
        else
          min:=result+1;
     end
    else
      min:=result+1;
  until min > max;
  result:=-1;
end; // idxOf

function TRnQCList.exists(c: TICQContact):boolean;
begin result:=(c<>NIL) and (_idxOf(c.UID)>=0) end;

function TRnQCList.exists(const uin: TUID):boolean;
begin result:=idxOf(uin)>=0 end;

function TRnQCList.add(p:pointer):boolean;
begin result:=Tobject(p) is TICQContact and add(TICQContact(p)) end;

function TRnQCList.add(c: TICQContact): Boolean;
var
  i: Integer;
  min, max: Integer;
  cnt: TICQContact;
begin
  Result := (c <> nil) and not exists(c);
  if Result then
  begin
//  i:=0;
//  while (i getAt(i).UID) do
//    inc(i);
    min:=0;
    max:=count-1;
    if max >= 0 then
    repeat
      i:=(min+max) div 2;
//      i:=(min+max) shr 1;
      cnt := getAt(i);
      if Assigned(cnt) then
       begin
//        if c.UID = getAt(i).UID then
//          exit
//        else
          if c.UID > cnt.UID then
            min := i+1
          else
            max := i-1;
       end
      else
        min:= i+1;
    until min > max;
    i := min;
  insert(i, c);
  end;
end; // add

function TRnQCList.putAt(const idx: Integer; c: TICQContact): Boolean;
begin
  Result := (c <> nil) and not exists(c);
  if Result then
    insert(idx, c);
end; // putAt

function TRnQCList.empty: Boolean;
begin
  Result := count = 0
end;

function TRnQCList.remove(c: TICQContact): Boolean;
begin
  Result := inherited remove(c) >= 0
end;

function TRnQCList.remove(p:pointer):boolean;
//begin result:= Tobject(p^) is TRnQContact and remove(PRnQContact(p)^) end;
begin result:= Tobject(p^) is TICQContact and remove(TICQContact(p)) end;

function TRnQCList.add(cl:TRnQCList):TRnQCList;
var
  i:integer;
begin
result:=self;
if cl=NIL then exit;
for i:=0 to cl.count-1 do
  add(cl.getAt(i));
end; // add

function TRnQCList.get(const uin: Integer): TICQContact;
var
  i: Integer;
begin
  i := idxOf(uin);
  if i >= 0 then
    Result := getAt(i)
  else
    Result := nil;
end; // getDB

function TRnQCList.add(const uid: TUID): TICQContact;
var
  i: Integer;
  u: TUID;
begin
  Result := nil;
  if (Length(UID) = 0) then
    Exit;
  u := AnsiLowerCase(TICQContact.TrimUID(uid));
  if Length(u) = 0 then
    Exit;
  i := _idxOf(u);
  if i >= 0 then
    result:= getAt(i)
  else
  begin
    Result:= TICQContact.Create(uid);
    add(Result);
  end;
end; // add

function TRnQCList.get(const uid: TUID): TICQContact;
var
  i:integer;
  u : TUID;
begin
  Result := NIL;
  if (Length(UID) = 0) then
    Exit;
  u := AnsiLowerCase(TICQContact.TrimUID(uid));
  if (Length(u)=0) then
    Exit;
  i:=_idxOf(u);
  if i >= 0 then
    result:= getAt(i)
   else
    begin
{     result:= cls.create(uid);
     add(result);}
     result:= NIL;
    end;
end; // getDB


function TRnQCList.remove(cl:TRnQCList):TRnQCList;
begin
result:=self;
if cl=NIL then exit;
inherited assign(cl, laSrcUnique);
end; // remove

function TRnQCList.intersect(cl:TRnQCList):TRnQCList;
begin
result:=self;
if cl=NIL then
  begin
  clear;
  exit;
  end;
inherited assign(cl, laAnd);
end; // intersect

function TRnQCList.Text: String;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to Count - 1 do
    Result := Result + TICQContact(List[I]).UID + #10;
  Result := Result.Trim([#10]);
end;

function TRnQCList.toString: RawByteString;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to count - 1 do
    Result := Result + UTF(TICQContact(List[I]).UID) + CRLF;
end;

function TRnQCList.fromString(const s: RawByteString; db:TRnQCList):boolean;
var
  i:integer;
  s1 : RawByteString;
  ofs : Integer;
  len : Integer;
begin
 result:=TRUE;
 clear;
 ofs := 1;
// i := 1;
 len := Length(s);
// while s>'' do
// while i>0 do
 while ofs
  begin
  //  i:=pos(#10,s);
    i := posEx(AnsiString(#10),s, ofs);
    if (i>1) and (s[i-1]=#13) then
      dec(i);
    if i=0 then
      i:= Len+1;
  //  s1 := copy(s,1,i-1);
    s1 := copy(s, ofs, i-ofs);
    try
//      add(db.get(cls, UnUTF(s1)))
      add(db.add(UnUTF(s1)))
     except
      result:=FALSE
    end;
    if s[i]=#13 then
      inc(i);
  //  system.delete(s,1,i);
    ofs := i+1;
  end;
end; // fromString

class function TRnQCList.FromArray(UINs: TArray; UseDB: Boolean = True): TRnQCList;
var
  I: Integer;
begin
  Result := TRnQCList.Create;
  for I := Low(UINs) to High(UINs) do
  if UseDB then
    Result.Add(Account.AccProto.GetContact(UINs[I]))
  else
    Result.Add(UINs[I]);
  Result.ResetEnumeration;
end;

class function TRnQCList.FromVariantArray(UINs: Variant; UseDB: Boolean = True): TRnQCList;
var
  I: Integer;
begin
  Result := TRnQCList.Create;
  for I := VarArrayLowBound(UINs, 1) to VarArrayHighBound(UINs, 1) do
  if UseDB then
    Result.Add(Account.AccProto.GetContact(TUID(UINs[I])))
  else
    Result.Add(TUID(UINs[I]));
  Result.ResetEnumeration;
end;

function TRnQCList.clone: TRnQCList;
var
  i: integer;
begin
  result := TRnQCList.create;
  for i := 0 to count - 1 do
    result.add(getAt(i))
end; // clone

procedure TRnQCList.ForEach(const AIteratorEvent: TProc);
var
  cnt: TICQContact;
begin
  if Self.Count > 0 then
    for cnt in Self do
      AIteratorEvent(cnt);
end;
{
procedure TRnQCList.ForEachAsync(const AIteratorEvent: TProc);
begin
  if Self.Count > 0 then
  TParallel.&For(0, Self.Count - 1, procedure(i: Integer)
  begin
    AIteratorEvent(Self.Items[i]);
  end);
end;
}
function TRnQCList.GetEnumerator: TCListEnumerator;
begin
  Result := TCListEnumerator.Create(Self);
end;

procedure TRnQCList.ResetEnumeration;
begin
  enumIdx := 0
end;

function TRnQCList.hasMore:boolean;
begin
  result := enumIdx < count
end;

function TRnQCList.getNext: TICQContact;
begin
  result := getAt(enumIdx);
  inc(enumIdx);
end; // getNext

procedure TRnQCList.assign(cl: TRnQCList);
begin
  if cl = nil then
    clear
  else
    inherited assign(cl, laCopy)
end;

procedure TRnQCList.apply(p:TcontactProc);
var
  i: Integer;
begin
  i := 0;
  while i < count do
  begin
    p(TICQContact(items[i]));
    Inc(i);
  end;
end;

function TRnQCList.toIntArray: TIntegerDynArray;
var
  i: Integer;
begin
  setlength(result,count);
  for i := 0 to count - 1 do
    Result[i] := StrToIntDef(TICQContact(items[i]).uid, 0);
end; // toIntArray

function TRnQCList.GetCount(Group: Integer; Divisor: Integer = -1; OnlyOnline: Boolean = False): Integer;
var
  I: Integer;
begin
  if Group = -1 then
  begin
    Result := inherited Count;
    Exit;
  end;
  Result := 0;
  for I := 0 to Count - 1 do
  if (TICQContact(List[I]).Group = Group) and ((not OnlyOnline) or TICQContact(List[I]).IsOnline) then
    if (Divisor = -1) or (Divisor = Integer(GetContactDiv(TICQContact(List[I])))) then
      Inc(Result);
end;

procedure TRnQCList.getOnlOfflCount(var pOnlCount, pOfflCount: Integer);
var
  i : Integer;
begin
  pOnlCount:=0;
  pOfflCount:=0;
  for i:=0 to TList(self).count-1 do
    with TICQContact(getAt(i)) do
      if IsOffline then
        Inc(pOfflCount)
      else
        Inc(pOnlCount);
end;

constructor TICQContact.Create(const uin_: TUID);
begin
  inherited Create;
  Clear1;
  UID := TrimUID(uin_);
  Icon.Bmp := nil;
  Clear;
  IsAIM := not IsOnlyDigits(UID);
  if IsAIM then
    uinINT := 0
  else
    uinINT := StrToIntDef(UID, 0);
  Icon.Bmp := nil;
  Icon.Cache := nil;
  if Assigned(OnContactCreation) then
    OnContactCreation(self);
end; // Create

destructor TICQContact.Destroy;
begin
  Clear;
  if Assigned(OnContactDestroying) then
    OnContactDestroying(self);
  SetLength(UID, 0);
  inherited Destroy;
end; // Destroy

function TICQContact.Equals(c: TICQContact): Boolean;
begin
  try
    if (not Assigned(Self)) or (not Assigned(c)) or (UID = '') or (c.UID = '') then
      Result := False
    else
      Result := c.UID = UID
  except
    Result := False;
  end;
end;

function TICQContact.Equals(pUIN: Integer): Boolean;
var
  vUID : TUID;
begin
  vUID := IntToStr(pUIN);
  if (not Assigned(Self)) or (Self.UID = '') or (vUID = '') then
    Result := False
  else
    Result := UID = vUID
end;

function TICQContact.Equals(const pUID: TUID): Boolean;
var
  vUID: TUID;
begin
  try
    vUID := AnsiLowerCase(TrimUID(pUID));
    if (not Assigned(Self)) or (Self.UID = '') or (vUID = '') then
      Result := False
    else
      Result := UID = vUID
  except
    Result := False;
  end;
end;

procedure TICQContact.Clear1;
begin
  UID := '';
  Display := '';
  Nick := '';
  First := '';
  Last := '';
//  status:=SC_UNK;
  Display := '';
  birthL := 0;
//  ClientStr := '';
  ClientPic := '';
  ClientDesc := '';
  lclImportant := '';
  CntIsLocal := True;
  Authorized := True;
  Muted := False;
  Antispam.Tries := 0;
  Icon.Bmp := nil;
  Icon.Cache := nil;
  LastStatusSubscribe := 0;
//  Antispam.LastQuests
end; // Clear1

procedure TICQContact.Clear;
begin
//uid:='';
//nick:='';
//first:='';
//last:='';
  if Assigned(icon.Bmp) then
  try
    icon.Bmp.Free;
  except
    msgDlg(getTranslation('Error on destroying avatar of contact: %s', [uid]), False, mtError);
  end;
  icon.Bmp := nil;
  icon.ToShow := 0;
  FreeAndNil(icon.cache);
  IconID := '';
  IconColors.AvatarBack := '';
  IconColors.AvatarText := '';
  IconColors.PhotoBack := '';
  IconColors.PhotoText := '';

  Status := ICQConsts.SC_UNK;
  LastStatusSubscribe := 0;
  UserType := CT_ICQ;
  gender := 0;
  age := 0;
  country := '';
  group := 0;
  birth := 0;
  birthFlag := False;
  infoUpdatedTo := 0;
  lastTimeSeenOnline := 0;
  Lang[1] := '';
  Lang[2] := '';
  Lang[3] := '';
  regular := '';
  cellular := '';
  SMSMobile := '';
  SMSable := False;
  Official := False;
  Bot := False;
  Deleted := False;
  MarStatus := 0;
  crypt.supportCryptMsg := False;
  nodb := False;
  isMobile := False;
  NoClient := False;
  capabilitiesBig := [];
  capabilitiesSm := [];
  extracapabilities := '';
//  SetLength(about, 0);
  SetLength(ssImportant, 0);
  SetLength(lclImportant, 0);
//  SetLength(email, 0);
  SetLength(ssCell1, 0);
  SetLength(ssCell2, 0);
  SetLength(ssCell3, 0);
  SetLength(ssCell4, 0);
  SetLength(ssNickname, 0);

  Display := '';
  email := '';
  city := '';
  state :=' ';
  about := '';
  // work
  workphone := '';
  regular := '';
  cellular := '';
  SMSMobile := '';
//  ClearInterests;
end; // clear

//procedure TICQContact.AddInterest(idx: Byte; code: Integer; str: String);
//begin
//  Interests.InterestBlock[idx].Code := code;
//  if (Interests.InterestBlock[idx].Names <> nil)
//     AND Assigned(Interests.InterestBlock[idx].Names) then
//     Interests.InterestBlock[idx].Names.Clear
//    else
//     Interests.InterestBlock[idx].Names := TStringList.Create;
//   while str<>'' do
//     Interests.InterestBlock[idx].Names.Add(chop(',', str));
////                 Interests.InterestBlock[i].Count:=int.Count+1;
//end;

//procedure TICQContact.ClearInterests;
//var
//  i : Integer;
//begin
//  for i := Low(interests.InterestBlock) to High(interests.InterestBlock) do
//   begin
//    interests.InterestBlock[i].Code := 0;
//    if Assigned(interests.InterestBlock[i].Names) then
//      FreeAndNil(interests.InterestBlock[i].Names);
//   end;
// interests.Count := 0;
//end;

procedure TICQContact.SetOffline;
begin
  OfflineClear;
  status := ICQConsts.SC_OFFLINE;
end;

procedure TICQContact.OfflineClear;
begin
  Typing.bIsTyping := False;
  Typing.bIAmTyping := False;
  Crypt.SupportCryptMsg := False;
  XStatusIndex := 0;
  BirthFlag := False;
  IdleTime := 0;
end;

function TICQContact.GetBDay: TDateTime;
begin
  if birthL > 0 then
    Result := birthL
  else if birth > 0 then
    Result := birth
  else
    Result := 0;
end;

function TICQContact.Days2Bd: SmallInt;
const
//  maxDate = EncodeDate(3000, 1, 1);
  maxYear = 3000;
  maxDate = maxYear * 365 + maxYear div 4 - maxYear div 100 + maxYear div 400 + 1 - DateDelta;
var
  bd: TDateTime;
  y, m, d: Word;
  y2, m2, d2: Word;
begin
  bd := GetBDay;
  if (bd = 0) or (bd > maxDate) then
    Result := 2000//-1
  else
  begin
    DecodeDate(date, y, m, d);
    DecodeDate(bd, y2, m2, d2);
    y2 := y + IfThen((m2 < m) or ((m2 = m) and (d2 < d)), 1);
    if not TryEncodeDate(y2, m2, d2, bd) then
    if not TryEncodeDate(y2, m2 + 1, 1, bd) then // if 29 February :)
    begin
      Result := 2000;
      Exit;
    end;
    Result := Trunc(bd - Date);
  end;
end;

function TICQContact.IsInRoster: Boolean;
begin
  Result := Account.AccProto.IsInList(LT_ROSTER, Self);
end;

function TICQContact.IsInList(List: TLIST_TYPES): Boolean;
begin
  Result := Account.AccProto.IsInList(List, Self);
end;

function TICQContact.IsOnline: Boolean;
begin
  Result := not (Status in [ICQConsts.SC_OFFLINE, ICQConsts.SC_UNK])
end;

function TICQContact.IsOffline: Boolean;
begin
  Result := Status = ICQConsts.SC_OFFLINE
end;

function TICQContact.IsRecent: Boolean;
begin
  Result := IsOffline and (Now - LastTimeSeenOnline < RecentlyOfflineDelay * 60 * DTseconds)
end;

function TICQContact.IsMuted: Boolean;
begin
  Result := Self.Muted;
end;

function TICQContact.CanEdit: Boolean;
begin
  Result := True;
end;

procedure TICQContact.SetDisplay(const s: String);
begin
  Display := s;
end;

procedure TICQContact.ViewInfo;
begin
  OpenViewInfo(Self);
end;

function TICQContact.UINAsStr: String;
begin
  Result := uid
end;

function TICQContact.UIN2Show: String;
var
  i, m, n, l : byte;
  s : String;
begin
 s := uinAsStr;
 if (not isAIM) and ShowUINDelimiter then
   begin
//     s := UnDelimiter(uid);
     l := length(s);
     if l > 3 then
      begin
       result := '';
       m := l div 3;
       n := l mod 3;
       if n > 0 then
        Result := Copy(s, 1, n) + '-';
       if m > 1 then
       for I := 0 to m-2 do
         Result := Result + Copy(s, 1 + n + i * 3, 3) + '-';
       result := Result + copy(s, l-2, 3);
      end
     else
      Result := s;
   end
  else
   result := s
end;

procedure TICQContact.SetGroupName(const Name: String);
var
  gID: Integer;
begin
  if groups.Exists(Name) then
    gID := groups.Name2ID(Name)
  else
    gID := IfThen(Name = '', 2000, groups.AddWithValues(0, Name));
  Self.Group := gID;
end;

function TICQContact.GetStatusName: String;
begin
  Result := GetTranslation(Status2ShowStr[Status]);
end;

function TICQContact.StatusImg: TPicName;
begin
  Result := Status2ImgName(Byte(Status), False);
end;

function TICQContact.GetStatus: Byte;
begin
  Result := Byte(Status);
end;

class function TICQContact.TrimUID(const sUID: TUID): TUID;
var
  i: Word;
  t: Word;
  ch: AnsiChar;
  s1, s2: TUID;
  isAIM: Boolean;
begin
  Result := '';
  s1 := Trim(sUID);
  if Length(s1) = 0 then
    Exit;

  isAIM := not (s1[1] in ['0'..'9']);
  s2 := dupString(s1);
  t := 0;

  if isAIM then
  begin
    for i := 1 to Length(sUID) do
    begin
      ch := s2[i];
      if not ((ch = ' ') or (ch = Char($A0))) then
      begin
        Inc(t);
        if i <> t then
          s2[t] := ch;
      end;
    end;
  end
    else
  begin
    for i := 1 to Length(sUID) do
    begin
      ch := s2[i];
      if ch in UID_CHARS then
      begin
        Inc(t);
        if i <> t then
          s2[t] := ch;
      end;
    end;
  end;
  SetLength(Result, t);
  if t <> Length(s1) then
    Result := Copy(s2, 1, t)
  else
    Result := s2
end;

function TICQContact.Displayed: String;
begin
  if Display > '' then
    Result := Display
  else if ssNickname > '' then
    Result := ssNickname
  else if (Nick > '') and not (Nick = UID) then
    Result := Nick
  else if (First > '') and (Last > '') then
    Result := First + ' ' + Last
  else if First > '' then
    Result := First
  else if Last > '' then
    Result := Last
  else
    Result := UID;
  if Length(Result) > MaxDispayedLen then
    SetLength(Result, MaxDispayedLen);
end;

function TICQContact.ParseDBrow(ItemType: Integer; const item: RawByteString): Boolean;
//  procedure str2interests(str: RawByteString; var int: Tinterests);  // By Shyr
//  var
//   s1 : RawByteString;
//   s2:string;
//  begin
//   int.Count:=0;
//   if str<>'' then
//    str:=str+'';
//   while (str<>'')and (int.Count < 4) do begin
//    s1:=chop(AnsiChar(#0), str);
//    if s1 > '' then
//     begin
//      int.InterestBlock[int.Count].Code := Byte(s1[1]);
//      s1:=Copy(s1,2,length(s1)-1);
//      int.interestblock[int.Count].Names:=TStringList.Create;
//      while s1<>'' do begin
//       s2:=UnUTF(chop(AnsiChar(','),s1));
//       int.interestblock[int.Count].Names.Add(s2);
//      end;
//      int.Count:=int.Count+1;
//     end;
//   end;
//  end;

begin
  Result := True;
  case ItemType of
    DBFK_EMAIL: self.email:= UnUTF(item);
    DBFK_CITY: self.city := UnUTF(item);
    DBFK_STATE: self.state:= UnUTF(item);
    DBFK_ABOUT: self.about:= UnUTF(item);
    DBFK_NODB: self.nodb:=boolean(item[1]);
    DBFK_COUNTRY: self.country := UnUTF(item);
    DBFK_LANG1: self.lang[1] := UnUTF(item);
    DBFK_LANG2: self.lang[2] := UnUTF(item);
    DBFK_LANG3: self.lang[3] := UnUTF(item);
    DBFK_CELLULAR: self.cellular := UnUTF(item);
    DBFK_SMSMOBILE: self.SMSMobile := UnUTF(item);
    DBFK_REGULAR: self.regular := UnUTF(item);
    DBFK_AGE: system.move(item[1], self.age, 4);
    DBFK_GENDER: system.move(item[1], self.gender, 4);
    DBFK_LASTUPDATE: system.move(item[1], self.infoUpdatedTo, 8);
    DBFK_LASTONLINE: system.move(item[1], self.lastTimeSeenOnline, 8);
    DBFK_LASTMSG: system.move(item[1], TCE(self.data^).lastMsgTime, 8);
    DBFK_ONLINESINCE: system.move(item[1], self.onlinesince, 8);
    DBFK_MEMBERSINCE: system.move(item[1], self.membersince, 8);
    DBFK_LASTINFOCHG: system.move(item[1], self.lastInfoUpdate, 8);
    DBFK_SMSABLE: self.SMSable := boolean(item[1]);
    DBFK_OFFICIAL: self.Official := boolean(item[1]);
    DBFK_BOT: self.Bot := boolean(item[1]);
    DBFK_DELETED: self.Deleted := boolean(item[1]);
    DBFK_WORKPHONE: self.workphone := UnUTF(item);

    DBFK_ssNoteStr: self.ssImportant := UnUTF(item);
    DBFK_ssNickname: self.ssNickname := UnUTF(item);
    DBFK_ssCell: self.ssCell1 := UnUTF(item);
    DBFK_ssCell2: self.ssCell2 := UnUTF(item);
    DBFK_ssCell3: self.ssCell3 := UnUTF(item);
    DBFK_ssCell4: self.ssCell4 := UnUTF(item);
    DBFK_ICONMD5: self.IconID := UnUTF(item);
    DBFK_ICONCOLOR_AB: self.IconColors.AvatarBack := UnUTF(item);
    DBFK_ICONCOLOR_AT: self.IconColors.AvatarText := UnUTF(item);
    DBFK_ICONCOLOR_PB: self.IconColors.PhotoBack := UnUTF(item);
    DBFK_ICONCOLOR_PT: self.IconColors.PhotoText := UnUTF(item);
    DBFK_MARSTATUS: self.MarStatus := str2int(item);
    DBFK_UTYPE: self.UserType := TICQContactType(str2int(item));

    DBFK_Authorized: Authorized := Boolean(item[1]);
    DBFK_DISPLAY: Display := UnUTF(item);
    DBFK_NICK: nick := UnUTF(item);
    DBFK_FIRST: first := UnUTF(item);
    DBFK_LAST: last := UnUTF(item);
    DBFK_NOTES: if Assigned(data) then TCE(data^).notes:= UnUTF(item);
    DBFK_DONTDELETE: if Assigned(data) then TCE(data^).dontdelete := boolean(item[1]);
    DBFK_SENDTRANSL: SendTransl := boolean(item[1]);
    DBFK_BIRTH: system.move(item[1], birth, 8);
    DBFK_BIRTHL: system.move(item[1], birthL, 8);
    DBFK_LASTBDINFORM: system.move(item[1], LastBDInform, 8);
    DBFK_lclNoteStr: lclImportant := UnUTF(item);
    DBFK_ICONSHOW: system.move(item[1], icon.ToShow, 1);
    DBFK_ISLOCAL: CntIsLocal := boolean(item[1]);
    DBFK_SSIID: CntIsLocal := str2int(item) = 0; // Compatibility
  else
    Result := False;
  end;
end;

{operator TICQContact.Implicit(a: AnsiString): TContact; // Implicit conversion of an Integer to type TMyClass
begin
  result := TICQContact.create(a);
end;
}
///////////////////////////////////////////////////////////////////

procedure ICQCL_SetStatus(cl: TRnQCList; st: TICQstatus);
var
  i: Integer;
  cnt: TICQContact;
begin
  for i := 0 to cl.count - 1 do
  begin
    cnt := cl.getAt(i);
    if cnt is TICQContact then
      TICQContact(cnt).Status := st;
   end;
end; // setStatus

end.