RnQ/RnQ/RnQdbDlg.pas

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

interface

uses
  Winapi.Windows, System.SysUtils, System.Classes, System.DateUtils, System.Generics.Collections,
  SciterJS, SciterJSAPI, SciterLib, ICQCommon;

{$I PubRTTI.inc}

type
  TContactData = record
    UID: TUID;
    inCL: Boolean;
    name, important: String;
    days2bday, messages: Integer;
    bday, lastseen: Variant;
  end;

  {$I NoRTTI.inc}

  TDBMethods = class(TNativeMethods)
    class procedure RegisterMethods(var ReturnValue: TSciterValue); override;
    class procedure GetContactsDB(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
    class procedure CleanContactsDB(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
    class procedure AddAllDB2CL(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
    class procedure DeleteContactFromDB(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
  end;

implementation

uses
  RnQLangs, RDGlobal, ICQSession, ICQContacts,
  globalLib, utilLib, SQLiteDB;

class procedure TDBMethods.RegisterMethods(var ReturnValue: TSciterValue);
begin
  AddMethod('GetContactsDB', GetContactsDB);
  AddMethod('CleanContactsDB', CleanContactsDB);
  AddMethod('AddAllDB2CL', AddAllDB2CL);
  AddMethod('DeleteContactFromDB', DeleteContactFromDB);
  inherited;
end;

class procedure TDBMethods.GetContactsDB(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  Contact: TICQContact;
  Contacts: array of TContactData;
  ContactsVar: TParams;
  Cnt: Integer;
  Counts: TDictionary;
begin
  Cnt := 0;
  Counts := SQLDB.GetEventCounts;
  SetLength(Contacts, TICQSession.ContactsDB.Count);
  SetLength(ContactsVar, TICQSession.ContactsDB.Count);
  for Contact in TICQSession.ContactsDB do
  begin
    Contacts[Cnt].UID := Contact.UID;
    Contacts[Cnt].inCL := Contact.IsInRoster;
    Contacts[Cnt].name := Contact.Displayed;
    Contacts[Cnt].important := Contact.lclImportant;
    Contacts[Cnt].days2bday := Contact.Days2Bd;
    Counts.TryGetValue(Contact.UID, Contacts[Cnt].messages);

    if Contact.GetBDay <= 0 then
      Contacts[Cnt].bday := False
    else
      Contacts[Cnt].bday := TTimeZone.Local.ToLocalTime(Contact.GetBDay);

    if Contact.LastTimeSeenOnline <= 0 then
      Contacts[Cnt].lastseen := False
    else
      Contacts[Cnt].lastseen := TTimeZone.Local.ToLocalTime(Contact.LastTimeSeenOnline);

    ContactsVar[Cnt] := UI.RecordToVar(Contacts[Cnt]);
    Inc(Cnt);
  end;
  Counts.Free;
  V2S(ContactsVar, retval);
end;

class procedure TDBMethods.CleanContactsDB(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  I: Integer;
  Counts: TDictionary;
  RemoveHistories, RemoveEmptyOnly: Boolean;
  Report: String;

  procedure PurgeHistories;
  var
    UIDs: TUIDS;
    UID: TUID;
  begin
    UIDs := SQLDB.GetExistingChats;
    for UID in UIDs do
    if unexistant(UID) then
    begin
      SQLDB.DeleteChat(UID);
      Report := Report + GetTranslation('history %s deleted', [UID]) + CRLF;
    end;
  end;

  procedure PurgeContacts;
  var
    I, Messages: Integer;
    Contact: TICQContact;
  begin
    for I := TList(TICQSession.ContactsDB).Count - 1 downto 0 do
    begin
      Contact := TICQSession.ContactsDB.getAt(I);
      if unexistant(Contact.UID) and not TCE(Contact.Data^).DontDelete then
      begin
        if RemoveEmptyOnly and Counts.TryGetValue(Contact.UID, Messages) and (Messages > 0) then
          Continue;
        TICQSession.ContactsDB.Delete(I);
        Report := Report + GetTranslation('contact %s deleted', [Contact.Displayed + ' (UIN ' + Contact.UID + ')']) + CRLF;
      end;
    end;
  end;

begin
  I := 0;
  API.ValueIntData(argv, I);
  RemoveHistories := I = 1;
  Inc(argv);
  I := 0;
  API.ValueIntData(argv, I);
  RemoveEmptyOnly := I = 1;

  Counts := SQLDB.GetEventCounts;
  Report := Report + '---' + GetTranslation('Start') + ' ' + DateTimeToStr(Now) + CRLF;
  PurgeContacts;
  if RemoveHistories and not RemoveEmptyOnly then
    PurgeHistories;
  Report := Report + '---' + GetTranslation('End') + ' ' + DateTimeToStr(Now) + CRLF;
  Counts.Free;

  V2S(Report, retval);
end;

class procedure TDBMethods.AddAllDB2CL(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  Contact: TICQContact;
begin
  for Contact in TICQSession.ContactsDB do
    AddToRoster(Contact);
end;

class procedure TDBMethods.DeleteContactFromDB(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  UID: TUID;
  Contact: TICQContact;
  Success: Boolean;
begin
  Success := False;
  UID := SciterVarToString(argv);
  Contact := Account.AccProto.GetContact(UID);
  if Assigned(Contact) then
    Success := TICQSession.ContactsDB.Remove(Contact);
  V2S(Success, retval);
end;

end.