RnQ/RnQ/HistAllSearch.pas

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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Types, System.Math, System.Variants, Generics.Collections,
  Vcl.AppEvnts, Vcl.Menus, StdCtrls, ExtCtrls, RnQGlobal, DateUtils, Threading,
  Sciter, SciterAPI, GR32, ICQCommon, ICQContacts, ICQConsts, ICQSession, ChatBox, history, events;

{$I PubRTTI.inc}

type
  TSearchResults = record
    Name, Desc: String;
    Key, UID, Display: String;
    RowID: Integer;
    Expanded: Boolean;
    Outgoing: Boolean;
    Messages: TArray;
  end;

  THistoryEntry = record
    RowID: Integer;
    Name, Body: String;
    Header: THeader;
    When: TDateTime;
    Binary: Boolean;
    Outgoing: Boolean;
  end;

  THistoryDataEntry = record
    key: String;
    index: Integer;
    content: THistoryEntry;
  end;

  {$I NoRTTI.inc}

  procedure CreatePreviewChat(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
  procedure FreePreviewChat(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
  procedure OpenPreview(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
  procedure SearchHistory(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
  procedure GetHistory(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
  procedure GetHistoryEntry(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
  procedure GetHistoryChunk(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
  procedure GetHistoryLength(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
  procedure CopyHistoryText(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
  procedure MatchHistoryEntry(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
  procedure KeyToIndex(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;

var
  PreviewChat: TChatBox;
  ContactOpened: TUID;
  ContactHist: TArray;
  Task: ITask;
  HistWidth: Integer;
  DC: HDC;

implementation

uses
  StrUtils, Clipbrd,
  SciterLib, globalLib, themesLib, utilLib,
  RDFileUtil, RQUtil, RDGlobal, RnQLangs, RQThemes, RnQSysUtils, RnQPics, RnQDialogs, SQLiteDB;

type
  PHSItem = ^THSItem;
  THSItem = record
    NodeType: (NT_MY, NT_HIS, NT_UID, NT_POSITION);
    rowId: Integer;
    displayed: String;
    sUID: TUID;
    pos: Integer;
    header: THeader;
    time: TDateTime;
    body: String;
    measured: Boolean;
    binary: Boolean;
  end;

procedure CreatePreviewChat(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  B: PByte;
  Pb: Cardinal;
begin
  PreviewChat := TChatBox.Create(True);
  B := nil;
  API.ValueBinaryData(argv, B, Pb);
  PreviewChat.Root := B;
  API.SciterGetElementHwnd(PreviewChat.Root, PreviewChat.Window, True);
  PreviewChat.InitSettings;
  PreviewChat.InitMsgPreview;
end;

procedure FreePreviewChat(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
  PreviewChat.ClosePage;
  FreeAndNil(PreviewChat);
end;

procedure OpenPreview(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  Index: Integer;
  History: THistory;
  HEvent: THEvent;
begin
  PreviewChat.ClearEvents;
  API.ValueIntData(argv, Index);
  if (Index < Low(ContactHist)) or (Index > High(ContactHist)) then
    Exit;
  History := PreviewChat.GetHistory(ContactOpened);
  if Assigned(History) then
  begin
    HEvent := History.GetByRowID(ContactHist[Index].RowID);
    PreviewChat.AddEvent(ContactOpened, HEvent);
    HEvent.Free;
  end;
end;

function GetExcerpt(Text, Query: String; CaseSensitive: Boolean): String;
var
  StartPos, EndPos, IndexPos: Integer;
  
  function FindLastWhiteSpace(FirstPos, LastPos: Integer): Boolean;
  var
    Pos: Integer;
  begin
    Pos := Text.Substring(FirstPos, LastPos - FirstPos).LastIndexOfAny([#13, #10, ' ']);
    StartPos := IfThen(Pos >= 0, Pos, 0);
    Result := Pos >= 0;
  end;

  function FindFirstWhiteSpace(FirstPos, LastPos: Integer): Boolean;
  var
    Pos: Integer;
  begin
    Pos := Text.IndexOfAny([#13, #10, ' '], FirstPos);
    EndPos := IfThen(Pos >= 0, Pos, LastPos);
    Result := Pos >= 0;
  end;

begin
  Result := '';

  if CaseSensitive then
    IndexPos := Text.IndexOf(Query)
  else
    IndexPos := Text.ToLower.IndexOf(Query.ToLower);

  StartPos := IndexPos;
  if StartPos > 0 then
    if FindLastWhiteSpace(0, StartPos - 1) then
      if FindLastWhiteSpace(0, StartPos - 1) then
        FindLastWhiteSpace(0, StartPos - 1);         

  EndPos := IndexPos + Length(Query) - 1;
  if EndPos < Length(Text) - 1 then
    if FindFirstWhiteSpace(EndPos + 1, Length(Text)) then
      if FindFirstWhiteSpace(EndPos + 1, Length(Text)) then
        FindFirstWhiteSpace(EndPos + 1, Length(Text));  

  Result := Text.Substring(StartPos, EndPos - StartPos + 1).Trim;

  if Length(Result) > 64 then
    Result := Result.Substring(0, 64) + '<27>'
  else if EndPos < Length(Text) - 1 then
    Result := Result + '<27>';

  if StartPos > 0 then
    Result := '<27>' + Result;
end;

procedure SearchHistory(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  Query: WideString;
  StrLen: Cardinal;
  I, J, Total, MsgType, Period, DaysAgo: Integer;
  InCL, CaseSensitive, Interrupted: Boolean;
  ElementHandle: PByte;
  ByteSize: Cardinal;
  UID: TUID;
  UIDs: TUIDS;
  Evt: Thevent;
  Events: Thevents;
  Results: TArray;
  ResultsVar: TParams;
  TimeNow: TDateTime;
begin
  Interrupted := False;

  ElementHandle := nil;
  API.ValueBinaryData(argv, ElementHandle, ByteSize);
  if ElementHandle = nil then
    Exit;

  Inc(argv);
  Query := SciterVarToString(argv);
  if Query = '' then
    Exit;

  Inc(argv);
  API.ValueIntData(argv, I);
  InCL := I = 1;

  Inc(argv);
  API.ValueIntData(argv, I);
  CaseSensitive := I = 1;

  Inc(argv);
  API.ValueIntData(argv, MsgType);

  Inc(argv);
  API.ValueIntData(argv, Period);

  Inc(argv);
  API.ValueIntData(argv, DaysAgo);

  API.Sciter_UseElement(ElementHandle);

  Total := 0;
  UIDs := Thistory.GetExistingChats;
  for UID in UIDs do
  if not InCL or (InCL and Account.AccProto.ReadList(LT_ROSTER).Exists(UID)) then
  begin
    if not Running then
      Exit;

    Events := SQLDB.DataSearch(UID, Query, CaseSensitive);

    if Length(Events) = 0 then
      Continue;

    SetLength(Results, Length(Results) + 1);
    I := Length(Results) - 1;

    TimeNow := Now;
    for Evt in Events do
    if Assigned(Evt) then
    begin
      if ((MsgType = 1) and Evt.outgoing) or
         ((MsgType = 2) and not Evt.outgoing) then
      begin
        Evt.Free;
        Continue;
      end;

      if ((Period = 1) and not (YearOf(TimeNow) = YearOf(Evt.when)) or
         ((Period = 2) and not (Evt.when >= StartOfTheMonth(TimeNow))) or
         ((Period = 3) and not (Evt.when >= StartOfTheWeek(TimeNow))) or
         ((Period = 4) and not IsSameDay(Evt.when, Yesterday)) or
         ((Period = 5) and not IsToday(Evt.when)) or
         ((Period = 6) and (DaysBetween(TimeNow, Evt.when) > DaysAgo))) then
      begin
        Evt.Free;
        Continue;
      end;

      SetLength(Results[I].Messages, Length(Results[I].Messages) + 1);
      J := Length(Results[I].Messages) - 1;
      Results[I].Messages[J].Name := DateTimeToStr(Evt.when);
      Results[I].Messages[J].Key := UID + '_' + IntToStr(J);
      Results[I].Messages[J].UID := UID;
      Results[I].Messages[J].RowID := Evt.RowID;
      Results[I].Messages[J].Display := Evt.chat.Displayed;
      Results[I].Messages[J].Expanded := True;
      Results[I].Messages[J].Outgoing := Evt.outgoing;
      Results[I].Messages[J].Desc := GetExcerpt(Evt.textData, Query, CaseSensitive);
      Evt.Free;
      Inc(Total);
      if Total >= 1000 then
      begin
        Interrupted := True;
        Break;
      end;
    end;

    if (Length(Results[I].Messages) = 0) then
      SetLength(Results, Length(Results) - 1)
    else
    begin
      Results[I].Key := UID;
      Results[I].Expanded := False;
      Results[I].Name := Account.AccProto.GetContact(UID).Displayed;
      Results[I].Desc := UID;
    end;

    if Assigned(Events) then
      SetLength(Events, 0);

    if Total >= 1000 then
    begin
      Interrupted := True;
      Break;
    end;
  end;

  SetLength(ResultsVar, Length(Results));
  for I := 0 to Length(Results) - 1 do
    ResultsVar[I] := UI.RecordToVar(Results[I]);

  CallScriptFunction(ElementHandle, 'displaySearchResults', [ResultsVar, Interrupted]);
  API.Sciter_UnUseElement(ElementHandle);

  SetLength(Results, 0);
  SetLength(ResultsVar, 0);
end;

procedure GetHistory(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  UID: TUID;
  RowID, I: Integer;
  BodyText: String;
  ElementHandle: PByte;
  ByteSize: Cardinal;
  Events: Thevents;
begin
  ElementHandle := nil;
  API.ValueBinaryData(argv, ElementHandle, ByteSize);
  if ElementHandle = nil then
    Exit;

  Inc(argv);
  UID := SciterVarToString(argv);
  if UID = '' then
    Exit;

  ContactOpened := UID;
  PreviewChat.ClosePage;
  PreviewChat.OpenPage(Account.AccProto.GetContact(UID), True);

  Inc(argv);
  RowID := -1;
  API.ValueIntData(argv, RowID);

  Events := SQLDB.GetAllEvents(UID);
//  if Length(Events) = 0 then
//    Exit;

  SetLength(ContactHist, 0);
  API.Sciter_UseElement(ElementHandle);

  TTask.Create(procedure
  var
    Evt: Thevent;
  begin
    for Evt in Events do
    if Assigned(Evt) then
    begin
      if not Running then
        Exit;

      SetLength(ContactHist, Length(ContactHist) + 1);
      I := Length(ContactHist) - 1;

      ContactHist[I].RowID := Evt.rowID;
      ContactHist[I].Name := Evt.Who.Displayed;
      ContactHist[I].Header := Evt.GetHeaderTexts;
      ContactHist[I].When := Evt.When;
      ContactHist[I].Outgoing := Evt.Outgoing;
      ContactHist[I].Binary := False;

      BodyText := Evt.GetBodyText;
      if not (BodyText = '') then
        ContactHist[I].Body := Trim(BodyText)
      else if (Length(Evt.GetBodyBin) > 0) and (Evt.Kind = EK_msg) then
      begin
        ContactHist[I].Body := '[' + GetTranslation('Binary data, %u B', [Length(Evt.GetBodyBin)]) + ']';
        ContactHist[I].Binary := True;
      end else
        ContactHist[I].Body := '';
      Evt.Free;
    end;

    if Assigned(Events) then
      SetLength(Events, 0);

    TThread.Synchronize(nil, procedure
    begin
     if not Running then
        Exit;

      CallScriptFunction(ElementHandle, 'displayHistory', [UID, RowID]);
      API.Sciter_UnUseElement(ElementHandle);

      if Length(ContactHist) = 0 then
        PreviewChat.ShowSearchHere;
    end);
  end).Start;
end;

procedure GetHistoryEntry(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  Index: Integer;
begin
  Index := 0;
  API.ValueIntData(argv, Index);

  V2S(UI.RecordToVar(ContactHist[Index]), retval);
end;

procedure GetHistoryChunk(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;

  procedure InsertAt(var Arr: TArray; const Index: Cardinal);
  var
    ArrLength: Cardinal;
    TailElements: Cardinal;
  begin
    ArrLength := Length(Arr);
    Assert(Index <= ArrLength);
    SetLength(Arr, ArrLength + 1);
    Finalize(Arr[ArrLength]);
    TailElements := ArrLength - Index;
    if TailElements > 0 then
    begin
      Move(Arr[Index], Arr[Index + 1], SizeOf(THistoryDataEntry) * TailElements);
      Initialize(Arr[Index]);
    end;
  end;

var
  Key: Variant;
  KeyType: TVarType;
  DataLength, ChunkLength, I, N, Idx, First, Last: Integer;
  ContactHistChunk: TArray;
  ContactHistChunkVar: TParams;
begin
  S2V(argv, Key);
  KeyType := VarType(Key);

  Inc(argv);
  ChunkLength := 0;
  API.ValueIntData(argv, ChunkLength);

  DataLength := Length(ContactHist);

  if (ChunkLength > 0) then
  begin
    if VarIsNull(Key) then
    begin
      Key := 0;
      KeyType := varInteger;
    end;
	  Idx := IfThen(KeyType = varInteger, Integer(Key), StrToInt(String(Key)) + 1);
		Last := Min(Idx + ChunkLength, DataLength);
		for N := Idx to Last - 1 do
    begin
      SetLength(ContactHistChunk, Length(ContactHistChunk) + 1);
      I := High(ContactHistChunk);
      ContactHistChunk[I].key := IntToStr(N);
      ContactHistChunk[I].index := N;
      ContactHistChunk[I].content := ContactHist[N mod DataLength];
    end;
  end
    else
  begin
    if VarIsNull(Key) then
    begin
      Key := DataLength - 1;
      KeyType := varInteger;
    end;
    Idx := IfThen(KeyType = varInteger, Integer(Key), StrToInt(String(Key)) - 1);
		First := Max(0, Idx + ChunkLength + 1);
		for N := Idx downto First do
    begin
      InsertAt(ContactHistChunk, 0);
      ContactHistChunk[0].key := IntToStr(N);
      ContactHistChunk[0].index := N;
      ContactHistChunk[0].content := ContactHist[N mod DataLength];
    end;
  end;

  SetLength(ContactHistChunkVar, Length(ContactHistChunk));
  for I := Low(ContactHistChunk) to High(ContactHistChunk) do
    ContactHistChunkVar[I] := UI.RecordToVar(ContactHistChunk[I]);

  V2S(ContactHistChunkVar, retval);

  SetLength(ContactHistChunk, 0);
  SetLength(ContactHistChunkVar, 0);
end;

procedure GetHistoryLength(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
  V2S(Length(ContactHist), retval);
end;

procedure CopyHistoryText(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  Indexes: Variant;
  I, LowBound, HighBound: Integer;
  WithHeaders: Boolean;
  Text: String;
begin
  S2V(argv, Indexes);

  Inc(argv);
  I := 1;
  API.ValueIntData(argv, I);
  WithHeaders := I = 1;

  LowBound := VarArrayLowBound(Indexes, 1);
  HighBound := VarArrayHighBound(Indexes, 1);

  Text := '';
  for I := LowBound to HighBound do
  Text := Text + IfThen(WithHeaders, ContactHist[Integer(Indexes[I])].Header.Date + ', ' + ContactHist[Integer(Indexes[I])].Header.What +
          IfThen(Length(ContactHist[Integer(Indexes[I])].Header.Prefix) > 0, ' (' + ContactHist[Integer(Indexes[I])].Header.Prefix + ')', '') + CRLF, '') +
          ContactHist[Integer(Indexes[I])].Body + CRLF;

  Clipboard.AsText := Text.TrimRight;
end;

procedure MatchHistoryEntry(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  I, Index, MsgType: Integer;
  Text: String;
  CaseSensitive: Boolean;
begin
  Index := 0;
  API.ValueIntData(argv, Index);

  Inc(argv);
  Text := SciterVarToString(argv);
  if Text = '' then
    Exit;

  Inc(argv);
  API.ValueIntData(argv, I);
  CaseSensitive := I = 1;

  Inc(argv);
  MsgType := 0;
  API.ValueIntData(argv, MsgType);

  if ContactHist[Index].Binary then
    Exit;

  if (CaseSensitive and not ContactHist[Index].Body.Contains(Text)) or
     (not CaseSensitive and not ContactHist[Index].Body.ToLower.Contains(Text.ToLower)) or
     ((MsgType = 1) and ContactHist[Index].Outgoing) or
     ((MsgType = 2) and not ContactHist[Index].Outgoing) then
  Exit;

  V2S(True, retval);
end;

procedure KeyToIndex(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  I, RowID: Integer;
begin
  RowID := -1;
  API.ValueIntData(argv, RowID);

  for I := Low(ContactHist) to High(ContactHist) do
  if ContactHist[I].RowID = RowID then
  begin
    V2S(I, retval);
    Exit;
  end;
end;

end.