RnQ/RnQ/ICQ/viewinfoDlg.pas

unit viewinfoDlg;
{$I RnQConfig.inc}

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Controls, Vcl.Forms, Vcl.Menus,
  RDGlobal, RDUtils, RQUtil, RQCodes, RnQ_Avatars, Generics.Defaults, Generics.Collections,
  RnQGlobal, RnQStrings, RnQDialogs, RnQPics, RnQLangs, RQThemes, RnQSysUtils, RnQGraphics32, RnQNet,
  ICQCommon, ICQContacts, ICQConsts, ICQSession, Protocol_ICQ, Protocols_all, globalLib, utilLib, langLib,
  menusUnit, DateUtils, Math, AnsiStrings, Variants,
  Sciter, SciterApi, DwmApi;

type
  TInfoDlg = class(TRnQViewInfoForm)
    Info: TSciter;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure InfoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure InfoDocumentComplete(ASender: TObject; const Args: TSciterOnDocumentCompleteEventArgs);
    procedure InfoScriptingCall(ASender: TObject; const Args: TElementOnScriptingCallArgs);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure InfoLoadData(ASender: TObject; const url: WideString; resType: SciterResourceType; requestId: Pointer;
      out discard, delay: Boolean);
  protected
    addmenu: TPopupMenu;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WndProc(var Message: TMessage); override;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCActivate(var Message: TWMNCActivate); message WM_NCACTIVATE;
  private
    procedure AddContactAction(Sender: TObject);
    procedure SaveLocalInfo;
  public
    contactAvt, contactPhoto: TMemoryStream;
    constructor DoAll(Owner: TComponent; c: TICQContact); override; final;
    function IsUpToDate: Boolean;
    procedure UpdateColoredCaption;
    procedure UpdateInfo(Async: Boolean = True); override; final;
    procedure UpdateClock; override; final;
    procedure UpdateCntAnP; override; final;
    procedure ClearAoP(pictype: Integer = 0); override; final;
  end;

type
  TParams = array of OleVariant;
  TCap = record
    HEX: String;
    Desc: String;
  end;
{
  tagCOLORIZATIONPARAMS = record
    clrColor        : COLORREF;
    clrAftGlow      : COLORREF;
    nIntensity      : UINT;
    clrAftGlowBal   : UINT;
    clrBlurBal      : UINT;
    clrGlassReflInt : UINT;
    fOpaque         : BOOL;
  end;

  COLORIZATIONPARAMS = tagCOLORIZATIONPARAMS;
  TColorizationParams = COLORIZATIONPARAMS;
  PColorizationParams = ^TColorizationParams;
}
var
  InfoDlg: TInfoDlg;
  InfoLoaded: Boolean;
  FWndFrameSize: Integer;
//  borderInactiveClr: String;

//  procedure DwmGetColorizationParameters(out parameters: TColorizationParams); stdcall; external 'dwmapi.dll' index 127;

implementation

{$R *.dfm}

uses roasterLib, SciterLib, chatDlg, mainDlg;
{
function DWM_ExtendFrameIntoClientArea(hwnd: HWND; ATopHeight, ALeftWidth, ABottomHeight, ARightWidth: Integer): HRESULT;
var
  lMargins: TMargins;
begin
  lMargins.cyTopHeight := ATopHeight;
  lMargins.cyBottomHeight := ABottomHeight;
  lMargins.cxLeftWidth := ALeftWidth;
  lMargins.cxRightWidth := ARightWidth;
  Result := DwmExtendFrameIntoClientArea(hwnd, lMargins);
end;

procedure DWM_GetBorderColor;
var
  Params: TColorizationParams;
begin
  ZeroMemory(@Params, SizeOf(Params));
  DwmGetColorizationParameters(Params);
  borderActiveClr := '#' + RGB(GetRValue(Params.clrColor), GetGValue(Params.clrColor), GetBValue(Params.clrColor)).ToHexString;
end;
}
function AvatarUsePalette10: Boolean;
begin
  Result := AvatarUsePalette and TOSVersion.Check(10);
end;

procedure GetContactInfo(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
//var
//  wpS: TwpSearch;
begin
  if tag = nil then
    Exit;

  with TInfoDlg(tag) do
  begin
    if OnlFeature(Account.AccProto) then
    begin
      Account.AccProto.GetProfile(contact.UID2cmp);
      // Partial data in one packet
//      TICQSession(contact.fProto).sendAdvQueryInfo(contact.uid2Cmp, TICQcontact(contact).InfoToken);
      // Produces a lot of incoming packets with data
//      TICQSession(contact.fProto).sendFullQueryInfo(contact.UID2cmp);
{
      wpS.uin := contact.UID2cmp;
      //TICQSession(contact.iProto.ProtoElem).sendQueryInfo(StrToIntDef(wpS.uin, 0));
      wpS.token := TICQcontact(contact).InfoToken;
      TICQSession(contact.fProto).sendWPsearch2(wpS, 0, False);
}
    end
  end;
end;

procedure DeleteContactFromList(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
  if tag = nil then
    Exit;

  with TInfoDlg(tag) do
  begin
    // if not roasterLib.exists(contact) then
    if not contact.IsInRoster then
      msgDlg('This contact is not in your list', True, mtWarning)
    else if messageDlg(GetTranslation('Are you sure you want to delete %s from your list?',
      [contact.displayed]), mtConfirmation, [mbYes, mbNo]) = mrYes then
      roasterLib.remove(contact);
  end;
end;

procedure SaveInfoOrAddContact(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  c: TICQContact;
  strData: PWideChar;
  strLen: UINT;
  pair: TSciterValue;
  i, cnt, sz: Cardinal;
  Birthday, BirthLChk: Boolean;
  tmpVal: TSciterValue;

  function GetString: PWideChar;
  begin
    Result := '';
    API.ValueStringData(@tmpVal, Result, strLen);
    OutputDebugString(PChar('String: ' + result));
  end;

  function GetInt: Integer;
  begin
    Result := 0;
    API.ValueIntData(@tmpVal, Result);
    OutputDebugString(PChar('Int: ' + inttostr(result)));
  end;

  function GetFloat: Double;
  begin
    Result := 0;
    API.ValueFloatData(@tmpVal, Result);
    OutputDebugString(PChar('Float: ' + floattostr(result)));
  end;

  function GetDate: TDateTime;
  var
    dRes: Double;
  begin
    Result := 0;
    API.ValueFloatData(@tmpVal, dRes);
    Result := Trunc(UnixToDateTime(Trunc(dRes), False));
    OutputDebugString(PChar('Date: ' + datetostr(Result)));
  end;

  function GetBool: LongBool;
  var
    tmpInt: Integer;
  begin
    Result := False;
    API.ValueIntData(@tmpVal, tmpInt);
    Result := tmpInt = 1;
    OutputDebugString(PChar('Boolean: ' + booltostr(Result, true)));
  end;

begin
  if (tag = nil) or (argc = 0) then
    Exit;

  with TInfoDlg(tag) do
  begin
    if Account.AccProto.IsMyAcc(contact) then
      SaveLocalInfo;

    if not Account.AccProto.IsMyAcc(contact) then
    begin
      if contact.IsInRoster then
      begin
        msgDlg('This contact is already in your list', True, mtWarning);
        Exit;
      end;
      addGroupsToMenu(TInfoDlg(tag), addmenu.Items, AddContactAction, True);
      applyCommonSettings(addmenu);
      addmenu.popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
    end else if OnlFeature(Account.AccProto) then
    begin
      c := TICQContact(Account.AccProto.GetMyInfo);
      c.uid := contact.uid;
      c.age := 0;
      c.birth := 0;
      birthlchk := False;
      birthday := False;
{
      for i := Low(c.interests.InterestBlock) to High(c.interests.InterestBlock) do
      if not Assigned(c.interests.InterestBlock[i].Names) then
        c.interests.InterestBlock[i].Names := TStringList.create
      else
        c.interests.InterestBlock[i].Names.Clear;
      c.interests.count := 0;
}
      API.ValueIsolate(argv);
      API.ValueElementsCount(argv, cnt);
      for i := 0 to cnt - 1 do
      begin
        API.ValueNthElementValue(argv, i, pair);
        API.ValueElementsCount(@pair, sz);
        if sz < 2 then Continue;
        strData := '';
        API.ValueNthElementValue(@pair, 0, tmpVal);
        API.ValueStringData(@tmpVal, strData, strLen);

        API.ValueNthElementValue(@pair, 1, tmpVal);
        if (strData = 'm_nick') then c.Nick := GetString;
        if (strData = 'm_firstname') then c.First := GetString;
        if (strData = 'm_lastname') then c.Last := GetString;
        if (strData = 'm_email') then c.Email := GetString;
        if (strData = 'm_gender') then c.Gender := GetInt;
        if (strData = 'm_marital') then c.MarStatus := GetInt;
        if (strData = 'm_lang1') then c.Lang[1] := GetString;
        if (strData = 'm_lang2') then c.Lang[2] := GetString;
        if (strData = 'm_lang3') then c.Lang[3] := GetString;
        if (strData = 'm_age') then Birthday := GetInt = 1;
        if (strData = 'm_birth') then if Birthday then c.Birth := GetDate else c.Birth := 0;
        if (strData = 'm_birthlchk') then BirthLChk := GetBool;
        if ((strData = 'm_birthl')) then
        if birthlchk and (c.BirthL > 0) then
          c.age := YearsBetween(Now, c.BirthL)
        else if birthday and (c.Birth > 0) then
          c.age := YearsBetween(Now, c.Birth);
        if (strData = 'm_gmt') then c.GMThalfs := GetInt;
        if (strData = 'm_about') then c.About := GetString;

//        if (strData = 'h_homepage') then c.homepage := GetString;
//        if (strData = 'h_address') then c.address := GetString;
        if (strData = 'h_city') then c.City := GetString;
        if (strData = 'h_state') then c.State := GetString;
        if (strData = 'h_country') then c.Country := GetString;
//        if (strData = 'h_zip') then c.zip := GetString;
        if (strData = 'h_cellular') then c.Cellular := GetString;
        if (strData = 'h_regular') then c.Regular := GetString;
        if (strData = 'h_sms') then c.SMSMobile := GetString;
//        if (strData = 'h_pob_city') then c.birthcity := GetString;
//        if (strData = 'h_pob_state') then c.birthstate := GetString;
//        if (strData = 'h_pob_country') then c.birthCountry := GetString;

//        if (strData = 'w_workpage') then c.workpage := GetString;
//        if (strData = 'w_position') then c.WorkPos := GetString;
//        if (strData = 'w_department') then c.WorkDep := GetString;
//        if (strData = 'w_company') then c.WorkCompany := GetString;
//        if (strData = 'w_address') then c.workaddress := GetString;
//        if (strData = 'w_city') then c.workcity := GetString;
//        if (strData = 'w_state') then c.workstate := GetString;
//        if (strData = 'w_country') then c.workCountry := GetInt;
//        if (strData = 'w_zip') then c.workzip := GetString;
        if (strData = 'w_regular') then c.WorkPhone := GetString;
        if (strData = 'w_lifestatus') then c.LifeStatus := GetString;

        if (strData = 'h_otherregular') then c.OtherPhone := GetString;
{
        if (strData = 'e_interest1') then c.interests.InterestBlock[0].Code := GetInt;
        if (strData = 'e_interest2') then c.interests.InterestBlock[1].Code := GetInt;
        if (strData = 'e_interest3') then c.interests.InterestBlock[2].Code := GetInt;
        if (strData = 'e_interest4') then c.interests.InterestBlock[3].Code := GetInt;

        if (strData = 'e_interest1s') and (c.interests.InterestBlock[0].Code > 0) then
        begin
          str2strings(',', GetString, c.interests.InterestBlock[0].Names);
          inc(c.interests.count);
        end;
        if (strData = 'e_interest2s') and (c.interests.InterestBlock[1].Code > 0) then
        begin
          str2strings(',', GetString, c.interests.InterestBlock[1].Names);
          inc(c.interests.count);
        end;
        if (strData = 'e_interest3s') and (c.interests.InterestBlock[2].Code > 0) then
        begin
          str2strings(',', GetString, c.interests.InterestBlock[2].Names);
          inc(c.interests.count);
        end;
        if (strData = 'e_interest4s') and (c.interests.InterestBlock[3].Code > 0) then
        begin
          str2strings(',', GetString, c.interests.InterestBlock[3].Names);
          inc(c.interests.count);
        end;
}
      end;

      Account.AccProto.SendSaveMyInfo(c);
    end;
  end;
end;

procedure UpdateBirthAge(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  birthCheck, birthLCheck: Boolean;
  birthVal, birthLVal: Double;
  birth, birthL: TDateTime;
  bindex, num, tmpInt: Integer;
  blchk: Boolean;
  valType: TSciterValueType;
  valUType: Cardinal;
  years: String;
begin
  if (tag = nil) or (argc < 4) then
    Exit;

  with TInfoDlg(tag) do
  begin
    birth := 0;
    birthL := 0;
    bindex := 0;
    birthVal := 0;
    birthLVal := 0;
    birthCheck := False;
    birthLCheck := False;
    blchk := False;

    API.ValueIntData(argv, bindex);
    Inc(argv);
    API.ValueIntData(argv, tmpInt);
    blchk := tmpInt = 1;

    Inc(argv);
    API.ValueType(argv, valType, valUType);
    if valType = T_FLOAT then
    begin
      API.ValueFloatData(argv, birthVal);
      try
        birth := Trunc(UnixToDateTime(Trunc(birthVal), False));
        birthCheck := True;
      except
        birth := 0;
        birthCheck := False;
      end;
    end;

    Inc(argv);
    API.ValueType(argv, valType, valUType);
    if valType = T_FLOAT then
    begin
      API.ValueFloatData(argv, birthLVal);
      try
        birthL := Trunc(UnixToDateTime(Trunc(birthLVal), False));
        birthLCheck := True;
      except
        birthL := 0;
        birthLCheck := False;
      end;
    end;

    if bindex = 0 then
      birth := 0;

    if blchk then
      contact.birthL := birthL
    else
      contact.birthL := 0;

    years := '';
    num := 0;

    if birthLCheck and blchk then
      num := YearsBetween(now, contact.birthL)
    else if birthCheck and (bindex = 1) then
      num := YearsBetween(now, birth);

    if not (num = 0) then
      years := intToStr(num) + getYearsWord(num);

    Info.FireRoot($103, years);
  end;
end;

procedure LoadAvatarAsync(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
  if tag = nil then
    Exit;

  reqAvatarsQ.add(TInfoDlg(tag).contact);
end;

procedure LoadThumb(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  s: String;
  f: TMemoryStream;
begin
  if tag = nil then
    Exit;

  with TInfoDlg(tag) do
  begin
    RemoveAllContactAorP(contact, 1);
    s := AccPath + avtPath + contact.UID2cmp + '.photo.jpeg';
    LoadFromURL(ICQ_THUMB_URL + contact.UID2cmp, s, 0, True);

    if FileExists(s) then
    begin
      f := TMemoryStream.Create;
      f.LoadFromFile(s);
      if not IsSupportedPicFile(ExtractFileName(s)) or (DetectFileFormatStream(f) = PA_FORMAT_UNK) then
      begin
        DeleteFile(s);
        ShowAvatarError(TICQContact(contact));
      end else
        FindAndSaveVibrantColors(1, f, TICQContact(contact));
      f.Free;
    end;

    UpdateAnP(contact);
    UpdateAnPFor(contact);
  end;
end;

procedure LoadPhoto(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  s: String;
  f: TMemoryStream;
begin
  if tag = nil then
    Exit;

  with TInfoDlg(tag) do
  begin
    RemoveAllContactAorP(contact, 1);
    s := AccPath + avtPath + contact.UID2cmp + '.photo.jpeg';
    LoadFromURL(Format(ICQ_PHOTO_AVATAR, [contact.UID2cmp, TICQcontact(contact).gender]), s, 0, True);

    if FileExists(s) then
    begin
      f := TMemoryStream.Create;
      f.LoadFromFile(s);
      if not IsSupportedPicFile(ExtractFileName(s)) or (DetectFileFormatStream(f) = PA_FORMAT_UNK) then
      begin
        DeleteFile(s);
        ShowAvatarError(TICQContact(contact));
      end else
        FindAndSaveVibrantColors(1, f, TICQContact(contact));
      f.Free;
    end;

    UpdateAnP(contact);
    UpdateAnPFor(contact);
  end;
end;

procedure ClearAvatarOrPhoto(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  pictype: Integer;
begin
  if tag = nil then
    Exit;

  pictype := 0;
  if argc > 0 then
    API.ValueIntData(argv, pictype);

  ClearAoP(TInfoDlg(tag).contact, pictype);
end;

procedure ChangeAvatar(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
  OpenICQURL('https://www.icq.com/people/' + Account.AccProto.MyAccNum + '/edit/');
end;

procedure SetIconShowType(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  showType: Integer;
begin
  if tag = nil then
    Exit;

  with TInfoDlg(tag) do
  begin
    showType := 0;
    if argc > 0 then
      API.ValueIntData(argv, showType);
    case showType of
      0: contact.icon.ToShow := IS_AVATAR;
      1: contact.icon.ToShow := IS_PHOTO;
      2: contact.icon.ToShow := IS_NONE;
    end;
    UpdateAnP(contact);
    UpdateAnPFor(contact);
  end;
end;

procedure FormMinimizeCustom(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
  if not (tag = nil) then
    TInfoDlg(tag).WindowState := wsMinimized;
end;

procedure FormCloseCustom(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
  if not (tag = nil) then
    TInfoDlg(tag).Close;
end;

procedure SetNoDBDelete(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  val: Integer;
begin
  if not (tag = nil) and (argc > 0) then
  begin
    val := 0;
    API.ValueIntData(argv, val);
    TCE(TInfoDlg(tag).contact.data^).dontdelete := val = 1;
  end;
end;

procedure SetDiscloseMail(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  val: Integer;
begin
  if not (tag = nil) and (argc > 0) then
  begin
    val := 0;
    API.ValueIntData(argv, val);
    Account.AccProto.pPublicEmail := val = 1;
  end;
end;

procedure SetTranslit(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  val: Integer;
begin
  if not (tag = nil) and (argc > 0) then
  begin
    val := 0;
    API.ValueIntData(argv, val);
    TInfoDlg(tag).contact.SendTransl := val = 1;
  end;
end;

procedure GetStatus(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
  if not (tag = nil) then
    with TInfoDlg(tag) do
      Account.AccProto.GetProfile(contact.UID2cmp);
end;

procedure ApplyInfoStatus(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  str: PWideChar;
  strLen: UINT;
begin
  if (tag = nil) or (argc = 0) then
    Exit;

  API.ValueStringData(argv, str, strLen);
  with TInfoDlg(tag) do
    if OnlFeature(Account.AccProto) then
      // TODO: Send life status to server
      //Account.AccProto.SendInfoStatus(str);
end;

procedure ApplyNotes(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  str: PWideChar;
  strLen: UINT;
begin
  if (tag = nil) or (argc < 5) then
    Exit;

  with TInfoDlg(tag) do
  begin
    if not contact.CntIsLocal then
      if not OnlFeature(Account.AccProto) then
        Exit;

    with contact do
    begin
      str := '';
      API.ValueStringData(argv, str, strLen);
      ssImportant := str;
      Inc(argv);
      API.ValueStringData(argv, str, strLen);
      ssNickname := str;
      Inc(argv);
      API.ValueStringData(argv, str, strLen);
      ssCell := str;
      Inc(argv);
      API.ValueStringData(argv, str, strLen);
      ssCell2 := str;
      Inc(argv);
      API.ValueStringData(argv, str, strLen);
      ssCell3 := str;
      Inc(argv);
      API.ValueStringData(argv, str, strLen);
      ssCell4 := str;
    end;

    if not contact.CntIsLocal then
      Account.AccProto.SendContactAttrs(TICQContact(contact));
  end;
end;

procedure VerifyPhone(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
  OpenICQURL('https://icq.com/attach-phone/');
end;

procedure TInfoDlg.UpdateColoredCaption;
begin
  if AvatarUsePalette10 then
  try
    Info.Call('initCaption', [Self.Caption,
                              TICQContact(contact).IconColors.AvatarBack, TICQContact(contact).IconColors.AvatarText,
                              TICQContact(contact).IconColors.PhotoBack, TICQContact(contact).IconColors.PhotoText
                             ])
  except
    on e: ESciterCallException do
      msgDlg('Error in initCaption: ' + e.Message, false, mtError);
  end;
end;

procedure TInfoDlg.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  Params.ExStyle := Params.ExStyle or WS_EX_STATICEDGE;
  Params.Style := Params.Style or WS_SIZEBOX;
end;

procedure TInfoDlg.WndProc(var Message: TMessage);
begin
  if AvatarUsePalette10 and GlassFrame.Enabled and HandleAllocated and
    DwmDefWindowProc(Handle, Message.Msg, Message.WParam, Message.LParam, Message.Result) then
      Exit;
  inherited;
end;

procedure TInfoDlg.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  if AvatarUsePalette10 and GlassFrame.Enabled then
  begin
    with Message.CalcSize_Params^.rgrc[0] do
    begin
      Dec(Bottom, FWndFrameSize);
      Inc(Left, FWndFrameSize);
      Dec(Right, FWndFrameSize);
    end;
    Message.Result := WVR_VALIDRECTS;
  end else
    inherited;
end;

procedure TInfoDlg.WMNCActivate(var Message: TWMNCActivate);
begin
  Inherited;
  if InfoLoaded and AvatarUsePalette10 then
    Info.Call('setWindowActive', [Message.Active])
end;

constructor TInfoDlg.DoAll(Owner: TComponent; c: TICQContact);
var
  i: Integer;
  cntry: TPair;
  //comp: TComponent;
  itsme, avatarsEnabled: Boolean;
  gender, lang, gmt, marital, birthday, country, {interest,} btns: TParams;
begin
  if c = nil then
    Exit;

  inherited Create(Owner);
  contact := c;
  itsme := Account.AccProto.IsMyAcc(c);
  readOnlyContact := not itsme;

  with Info do
  begin
    LoadTemplate('template', 'viewinfo.htm');

    avatarsEnabled := Account.AccProto.AvatarsSupport;
    Info.Call('initSettings', [avatarUsePalette, avatarsEnabled]);

    try
      Call('initStaticIcons', [itsme]);
    except
      on e: ESciterCallException do
        msgDlg('Error in initStaticIcons: ' + e.Message, false, mtError);
    end;

    SetLength(gender, Length(Genders) + 1);
    gender[0] := VarArrayCreate([0, 1], varVariant);
    gender[0][0] := 0;
    gender[0][1] := GetTranslation('Not selected');
    for i := Low(Genders) to High(Genders) do
    begin
      gender[i + 1] := VarArrayCreate([0, 1], varVariant);
      gender[i + 1][0] := Genders[i].ID;
      gender[i + 1][1] := GetTranslation(Genders[i].Value);
    end;

    SetLength(marital, Length(MarSts));
    for i := Low(MarSts) to High(MarSts) do
    begin
      marital[i] := VarArrayCreate([0, 1], varVariant);
      marital[i][0] := MarSts[i].ID;
      marital[i][1] := GetTranslation(MarSts[i].Value);
    end;

    SetLength(birthday, 2);
    birthday[0] := VarArrayCreate([0, 1], varVariant);
    birthday[0][0] := 0;
    birthday[0][1] := GetTranslation('Not specified');
    birthday[1] := VarArrayCreate([0, 1], varVariant);
    birthday[1][0] := 1;
    birthday[1][1] := GetTranslation('Birthday');

    SetLength(lang, Length(Languages) + 1);
    lang[0] := VarArrayCreate([0, 1], varVariant);
    lang[0][0] := '';
    lang[0][1] := GetTranslation('Not selected');
    for i := Low(Languages) to High(Languages) do
    begin
      lang[i + 1] := VarArrayCreate([0, 1], varVariant);
      lang[i + 1][0] := Languages[i].ID;
      lang[i + 1][1] := GetTranslation(Languages[i].Value);
    end;

    SetLength(gmt, Length(GMTs));
    for i := Low(GMTs) to High(GMTs) do
    begin
      gmt[i] := VarArrayCreate([0, 1], varVariant);
      gmt[i][0] := GMTs[i].ID;
      gmt[i][1] := GetTranslation(GMTs[i].Value);
    end;

    SetLength(country, ISOCountries.Count + 1);
    country[0] := VarArrayCreate([0, 1], varVariant);
    country[0][0] := '';
    country[0][1] := '';

    i := 1;
    for cntry in ISOCountries do
    begin
//      if Countries[i].ID = 9999 then
//      begin
//        country[1] := VarArrayCreate([0, 1], varVariant);
//        country[1][0] := Countries[i].ID;
//        country[1][1] := GetTranslation(Countries[i].Value);
//      end
//        else
//      begin
        country[i] := VarArrayCreate([0, 1], varVariant);
        country[i][0] := cntry.Key;
        country[i][1] := GetTranslation(cntry.Value);
        Inc(i);
//      end;
    end;
{
    SetLength(interest, Length(arrInterests) + 1);
    interest[0] := VarArrayCreate([0, 1], varVariant);
    interest[0][0] := 0;
    interest[0][1] := '';
    for i := Low(arrInterests) to High(arrInterests) do
    begin
      interest[i + 1] := VarArrayCreate([0, 1], varVariant);
      interest[i + 1][0] := arrInterests[i].ID;
      interest[i + 1][1] := GetTranslation(arrInterests[i].Value);
    end;
}
    SetLength(btns, 1);
    if itsme then
      btns[0] := GetTranslation('Save my info')
    else
      btns[0] := GetTranslation('Add to list');

    try
      Call('initTexts', [itsme, gender, marital, birthday, lang, gmt, country, {interest,} btns]);
    except
      on e: ESciterCallException do
        msgDlg('Error in initTexts: ' + e.Message, false, mtError);
    end;
  end;

  if contact.InfoUpdatedTo = 0 then
    Account.AccProto.GetProfile(contact.UID2cmp);

  UpdateInfo(False);
  TranslateWindow(Self);
  ChildWindows.add(Self);
  if not FormVisible(Self) then
  begin
    showForm(Self);
    ForceForegroundWindow(Self.Handle);
  end;
end; // DoAll

procedure TInfoDlg.SaveLocalInfo;
var
  m_displayed,
  nl_important,
  nl_notes: String;
begin
  m_displayed := Info.Call('getLocalValue', ['m_displayed']);
  nl_important := Info.Call('getLocalValue', ['nl_important']);
  nl_notes := Info.Call('getLocalValue', ['nl_notes']);

  if not (m_displayed = contact.displayed) then
  begin
    contact.SetDisplay(m_displayed);
    if Assigned(chatFrm) then
      chatFrm.UserChanged(contact);
    RnQmain.CLBox.UpdateContact(contact);
  end;

  contact.lclImportant := nl_important;
  TCE(contact.data^).notes := nl_notes;
end;

procedure TInfoDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  childWindows.remove(Self);
  Visible := False;
  SaveLocalInfo;
  Action := caFree;
end;

procedure TInfoDlg.FormCreate(Sender: TObject);
var
  R: TRect;
begin
  InfoLoaded := False;
  theme.pic2ico(RQteFormIcon, PIC_INFO, Icon);

  if AvatarUsePalette10 and DwmCompositionEnabled then
  begin
    SetRectEmpty(R);
    AdjustWindowRectEx(R, GetWindowLong(Handle, GWL_STYLE), False, GetWindowLong(Handle, GWL_EXSTYLE));
    FWndFrameSize := R.Right;
    GlassFrame.Top := -R.Top;
    GlassFrame.Enabled := True;
    SetWindowPos(Handle, 0, Left, Top, Width, Height, SWP_FRAMECHANGED);
  end;

  addmenu := TPopupMenu.create(Self);
//  lookup.proxySettings(MainProxy);
  contactPhoto := TMemoryStream.Create;
  contactAvt := TMemoryStream.Create;
end;

procedure TInfoDlg.FormDestroy(Sender: TObject);
begin
  FreeAndNil(contactAvt);
  FreeAndNil(contactPhoto);
  addmenu.Free;
end;

procedure TInfoDlg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_ESCAPE) or ((ssCtrl in Shift) and (key = VK_W))then
    Close
end;

procedure TInfoDlg.FormShow(Sender: TObject);
begin
  applyTaskButton(Self);
end;

procedure TInfoDlg.ClearAoP(pictype: Integer = 0);
begin
  if (pictype = 0) and Assigned(contactAvt) then
    contactAvt.Clear;
  if (pictype = 1) and Assigned(contactPhoto) then
    contactPhoto.Clear;
end;

procedure TInfoDlg.UpdateClock;
begin
  if contact is TICQcontact then
    if TICQcontact(contact).GMTavailable then
      Info.FireRoot($102, FormatDateTime(timeformat.clock, now - GMToffset0 + TICQcontact(contact).getGMT));
end;

procedure TInfoDlg.UpdateCntAnP;
begin
  UpdateColoredCaption;
  Info.FireRoot($104);
  Info.FireRoot($105);
end;

function TInfoDlg.IsUpToDate: Boolean;

  function newer(d: Tdatetime): Boolean;
  begin
    result := (d > 10000) and (d < now) and (d > TICQcontact(contact).infoUpdatedTo)
  end;

begin
  with TICQcontact(contact) do
    result := not (newer(LastCapsUpdate) or newer(LastInfoUpdate) or newer(LastStatusUpdate))
end;

procedure TInfoDlg.UpdateInfo(Async: Boolean = True);

  function datetime2str(dt: Tdatetime): string; overload;
  begin
    Result := DateTimeToStrMinMax(dt, { 1980 } 80 * 365, now)
  end;

  procedure StreamToVariant(Stream: TMemoryStream; var v: OleVariant);
  var
    p : pointer;
  begin
    v := VarArrayCreate([0, Stream.Size - 1], varByte);
    p := VarArrayLock(v);
    Stream.Position := 0;
    Stream.Read(p^, Stream.Size);
    VarArrayUnlock(v);
  end;

var
  values: TParams;
  uinlist, tmpCaps, tmpHEXCaps: TStringList;
  pubKey: String;
  caps: array of TCap;
  cap: RawByteString;
  i: Integer;
begin
  with TICQcontact(contact) do
  begin
    caption := GetTranslation('%s', [displayed]);
    if nodb then
      caption := caption + ' ' + GetTranslation('- user not found on server')
    else if infoUpdatedTo = 0 then
      caption := caption + ' ' + GetTranslation('- no info')
    else if not isUpToDate then
      caption := caption + ' ' + GetTranslation('- newer info available on server');

    try
      Info.Call('initDynIcons', [statusImg]);
    except
      on e: ESciterCallException do
        msgDlg('Error in initDynIcons: ' + e.Message, false, mtError);
    end;

    SetLength(values, 76);
    values[0] := Displayed;
    values[1] := Nick;
    values[2] := First;
    values[3] := Last;
    values[4] := Email;
    values[5] := UID;
    values[6] := '';//ip2str(connection.ip);

    if values[6] = '' then
    begin
      values[6] := GetTranslation(Str_unk);
      values[7] := False;
    end else
      values[7] := True;

    values[8] := Gender;
    values[9] := MarStatus;

    if birth > 0 then
    try
      values[10] := TTimeZone.Local.ToLocalTime(birth);
      values[11] := 1;
    except
      values[10] := Now;
      values[11] := 1;
    end else
    begin
      values[10] := False;
      values[11] := 0;
    end;

    if birthL <= 0 then
      values[12] := False
    else
      values[12] := TTimeZone.Local.ToLocalTime(birthL);

    values[13] := Lang[1];
    values[14] := Lang[2];
    values[15] := Lang[3];

    if not (xStatusStr = '') then
      values[16] := xStatusStr
    else
      values[16] := StatusNameExt2(Byte(status), xStatus);

    //values[17] := reserved;
    //values[18] := reserved;

    values[19] := SMSable;
    values[20] := About;
    values[21] := GMThalfs;

//    values[22] := homepage;
//    values[23] := address;
    values[24] := City;
    values[25] := State;
    values[26] := Country;
//    values[27] := zip;
    values[28] := Cellular;
    values[29] := Regular;
    values[30] := OtherPhone;
    values[31] := SMSMobile;

//    values[30] := birthcity;
//    values[31] := birthstate;
//    values[32] := birthCountry;

//    values[33] := workpage;
//    values[34] := workPos;
//    values[35] := workDep;
//    values[36] := workCompany;
//    values[37] := workaddress;
//    values[38] := workcity;
//    values[39] := workstate;
//    values[40] := workCountry;
//    values[41] := workzip;
    values[42] := WorkPhone;

    values[43] := LifeStatus;
    values[44] := contact.icon.ToShow;
{
    if interests.Count > 0 then
    begin
      values[45] := VarArrayCreate([0, 1], varVariant);
      values[45][0] := interests.InterestBlock[0].Code;
      values[45][1] := strings2str(', ', interests.InterestBlock[0].Names);
    end;

    if interests.Count > 1 then
    begin
      values[46] := VarArrayCreate([0, 1], varVariant);
      values[46][0] := interests.InterestBlock[1].Code;
      values[46][1] := strings2str(', ', interests.InterestBlock[1].Names);
    end;

    if interests.Count > 2 then
    begin
      values[47] := VarArrayCreate([0, 1], varVariant);
      values[47][0] := interests.InterestBlock[2].Code;
      values[47][1] := strings2str(', ', interests.InterestBlock[2].Names);
    end;

    if interests.Count > 3 then
    begin
      values[48] := VarArrayCreate([0, 1], varVariant);
      values[48][0] := interests.InterestBlock[3].Code;
      values[48][1] := strings2str(', ', interests.InterestBlock[3].Names);
    end;
}
    values[49] := datetime2str(TCE(data^).LastMsgTime);
    values[50] := datetime2str(LastTimeSeenOnline);
    values[51] := datetime2str(OnlineSince);
    values[52] := datetime2str(MemberSince);
    values[53] := datetime2str(LastInfoUpdate);
    values[54] := datetime2str(InfoUpdatedTo);
    if contact.group = 0 then
      values[55] := '(' + GetTranslation('None') + ')'
    else
      values[55] := groups.id2name(contact.group);
    uinlist := TStringList.Create;
    uinlists.resetEnumeration;
    while uinlists.hasMore do
      with uinlists.getNext^ do
        if cl.exists(contact) then
          uinlist.add(name);
    values[56] := uinlist.Text;
    uinlist.Free;

    values[57] := TCE(data^).dontdelete;
    values[58] := Account.AccProto.pPublicEmail;
    // values[59] := reserved

    if Account.AccProto.IsMyAcc(contact) then
      values[60] := AttachedLoginPhone
    else
      values[60] := '';

    values[61] := contact.ClientDesc;
    if values[61] = '' then
      values[61] := GetTranslation(Str_unk);

    values[62] := SendTransl;
    //values[63] := reserved
    //values[64] := reserved

    tmpCaps := TStringList.Create;
    tmpHEXCaps := TStringList.Create;

    for i in capabilitiesSm do
      tmpCaps.Append(GetTranslation(CapsSmall[i].s));
    for i in capabilitiesBig do
      tmpCaps.Append(GetTranslation(BigCapability[i].s));
    if length(extracapabilities) > 15 then
    for i := 0 to length(extracapabilities) div 16 - 1 do
    begin
      cap := copy(extracapabilities, i * 16 + 1, 16);
      if AnsiStartsStr(CapsCustomBuild, cap) then
        tmpCaps.Append(GetTranslation('R&Q build by Mikanoshi'))
      else
        tmpCaps.Append(str2HexU(cap) + ' - ' + BetterStr(cap));
    end;

    for i in capabilitiesSm do
      tmpHEXCaps.Append(str2hex(CapsSmall[i].v));
    for i in capabilitiesBig do
      tmpHEXCaps.Append(str2hex(BigCapability[i].v));
    if length(extracapabilities) > 15 then
      for i := 0 to length(extracapabilities) div 16 - 1 do
        tmpHEXCaps.Append(str2Hex(copy(extracapabilities, i * 16 + 1, 16)));

    try
      SetLength(caps, tmpCaps.Count);
      pubKey := '';
      for i := 0 to tmpCaps.Count - 1 do
      begin
        if (Copy(tmpHEXCaps.Strings[i], 1, 10) = '5244454330') or
           (Copy(tmpHEXCaps.Strings[i], 1, 10) = '5244454331') or
           (Copy(tmpHEXCaps.Strings[i], 1, 10) = '5244454332') then
        begin
          pubKey := pubKey + Copy(tmpHEXCaps.Strings[i], 11, Length(tmpHEXCaps.Strings[i]));
        end
          else
        begin
          caps[i].HEX := tmpHEXCaps.Strings[i];
          caps[i].Desc := tmpCaps.Strings[i];
        end;
      end;

      if not (pubKey = '') then
      begin
        SetLength(caps, Length(caps) + 1);
        caps[Length(caps) - 1].HEX := '--------------------------------';
        caps[Length(caps) - 1].Desc := GetTranslation('Public encryption key') + ' [' + pubKey + ']';
      end;

      TArray.Sort(caps , TDelegatedComparer.Construct(
      function(const Left, Right: TCap): Integer
      begin
        Result := TComparer.Default.Compare(Left.Desc, Right.Desc);
      end));

      values[65] := '';
      values[66] := '';
      for i := 0 to length(caps) - 1 do
      if not (caps[i].Desc = '') then
      begin
        values[65] := values[65] + caps[i].Desc + CRLF;
        values[66] := values[66] + caps[i].HEX + CRLF;
      end;
    finally
      tmpCaps.Free;
      tmpHEXCaps.Free;
    end;

    values[67] := values[6];
    values[68] := ssImportant;
    values[69] := ssNickname;
    values[70] := ssCell;
    values[71] := ssCell2;
    values[72] := ssCell3;
    values[73] := ssCell4;
    values[74] := lclImportant;
    values[75] := TCE(data^).notes;

    if Async then
      Info.FireRoot($101, values)
    else
      Info.Call('updateValues', [values]);

    UpdateColoredCaption;
  end;
end;

procedure TInfoDlg.InfoDocumentComplete(ASender: TObject; const Args: TSciterOnDocumentCompleteEventArgs);
begin
  InfoLoaded := True;
end;

procedure TInfoDlg.InfoLoadData(ASender: TObject; const url: WideString; resType: SciterResourceType; requestId: Pointer; out discard, delay: Boolean);
var
  FDataStream: TMemoryStream;
  Own: Boolean;
  fn: String;
  ignore, hasAoP: Boolean;
begin
  delay := False;
  ignore := False;
  Own := False;
  FDataStream := TMemoryStream.Create;

  if StartsText('mailto:', url) then
  begin
    TInfoDlg(TSciter(ASender).Owner).contact.sendEmailTo;
    ignore := True;
    Own := True;
  end else if StartsText('avatar:', url) then
  begin
    if not LoadAoPStreamByUIN(TICQcontact(contact).UID2cmp, contactAvt, hasAoP, fn, 0) then
      if Assigned(contactAvt) then
        contactAvt.Clear;

    if Assigned(contactAvt) and (contactAvt.Size > 0) then
    begin
      contactAvt.Seek(0, soBeginning);
      FDataStream.LoadFromStream(contactAvt);
    end else
      ignore := true;
    Own := True;
  end else if StartsText('photo:', url) then
  begin
    if not LoadAoPStreamByUIN(TICQcontact(contact).UID2cmp, contactPhoto, hasAoP, fn, 1) then
      if Assigned(contactPhoto) then
        contactPhoto.Clear;

    if Assigned(contactPhoto) and (contactPhoto.Size > 0) then
    begin
      contactPhoto.Seek(0, soBeginning);
      FDataStream.LoadFromStream(contactPhoto);
    end else
      ignore := true;
//  end else if StartsText('open:', url) then
//  begin
//    realurl := copy(url, 6, length(url));
//    if (realurl = 'search') and Assigned(chatFrm) then
//      chatFrm.findBtn.Click;
//    ignore := True;
    Own := True;
  end else
  begin
    FreeAndNil(FDataStream);
    discard := False;
  end;

  if Own then
  begin
    if not ignore then
    begin
      FDataStream.Seek(0, soFromBeginning);
      TSciter(ASender).DataReady(url, FDataStream.Memory, FDataStream.Size);
      discard := False;
    end else
      discard := True;
    FreeAndNil(FDataStream);
  end else Info.InitRequest(ASender, url, resType, requestId, discard, delay);
end;

procedure TInfoDlg.InfoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if AvatarUsePalette10 and (Button = mbLeft) and (X < Width - 106) and (Y < 32) then
  begin
    ReleaseCapture;
    Perform(WM_SYSCOMMAND, $F012, 0);
  end;
end;

procedure TInfoDlg.InfoScriptingCall(ASender: TObject; const Args: TElementOnScriptingCallArgs);
begin
  if Args.Method = 'getNativeApi' then
  with TSciter do
  begin
    RegisterNativeFunctor(Args.ReturnSciterValue, 'GetContactInfo', @GetContactInfo, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'DeleteContactFromList', @DeleteContactFromList, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'SaveInfoOrAddContact', @SaveInfoOrAddContact, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'UpdateBirthAge', @UpdateBirthAge, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'SetIconShowType', @SetIconShowType, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'FormMinimize', @FormMinimizeCustom, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'FormClose', @FormCloseCustom, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'SetNoDBDelete', @SetNoDBDelete, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'SetDiscloseMail', @SetDiscloseMail, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'SetTranslit', @SetTranslit, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'GetStatus', @GetStatus, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'ApplyInfoStatus', @ApplyInfoStatus, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'ApplyNotes', @ApplyNotes, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'VerifyPhone', @VerifyPhone);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'LoadAvatarAsync', @LoadAvatarAsync, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'LoadThumb', @LoadThumb, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'LoadPhoto', @LoadPhoto, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'ClearAvatarOrPhoto', @ClearAvatarOrPhoto, Self);
    RegisterNativeFunctor(Args.ReturnSciterValue, 'ChangeAvatar', @ChangeAvatar);

    Args.Handled := True;
  end;
end;

procedure TInfoDlg.AddContactAction(Sender: TObject);
begin
  AddToRoster(contact, (Sender as Tmenuitem).tag)
end;

end.