RnQ/RnQ/HistAllSearch.pas

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

interface

uses
  Winapi.Windows, System.SysUtils, System.Classes, System.Math, System.Variants, System.DateUtils, Generics.Collections,
  ICQCommon, ICQContacts, ICQConsts, ICQSession, ChatBox, history, events,
  SciterJS, SciterJSAPI;

{$I PubRTTI.inc}

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

  THistoryEntry = record
    Index, 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}

  TSearchMethods = class(TNativeMethods)
    class procedure RegisterMethods(var ReturnValue: TSciterValue); override;
    class procedure CreatePreviewChat(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
    class procedure FreePreviewChat(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
    class procedure OpenPreview(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
    class procedure SearchHistory(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
    class procedure GetHistory(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
    class procedure GetHistoryEntry(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
    class procedure GetHistoryEntries(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
    //class procedure GetHistoryChunk(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
    class procedure GetHistoryLength(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
    class procedure CopyHistoryText(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
    class procedure SaveHistoryToFile(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
    class procedure MatchHistoryEntry(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
    class procedure KeyToIndex(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
  end;

var
  PreviewChat: TChatBox = nil;
  ContactOpened: TUID;
  ContactHist: TArray;
  HistWidth: Integer;
  DC: HDC;

implementation

uses
  System.StrUtils, Vcl.Clipbrd,
  SciterLib, globalLib, utilLib,
  RDFileUtil, RQUtil, RDGlobal, RnQLangs, 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;

class procedure TSearchMethods.RegisterMethods(var ReturnValue: TSciterValue);
begin
  AddMethod('CreatePreviewChat', CreatePreviewChat);
  AddMethod('FreePreviewChat', FreePreviewChat);
  AddMethod('OpenPreview', OpenPreview);
  AddMethod('SearchHistory', SearchHistory);
  AddMethod('GetHistory', GetHistory);
  AddMethod('GetHistoryEntry', GetHistoryEntry);
  AddMethod('GetHistoryEntries', GetHistoryEntries);
  //AddMethod('GetHistoryChunk', GetHistoryChunk);
  AddMethod('GetHistoryLength', GetHistoryLength);
  AddMethod('CopyHistoryText', CopyHistoryText);
  AddMethod('SaveHistoryToFile', SaveHistoryToFile);
  AddMethod('MatchHistoryEntry', MatchHistoryEntry);
  AddMethod('KeyToIndex', KeyToIndex);
  inherited;
end;

class procedure TSearchMethods.CreatePreviewChat(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
  PreviewChat := TChatBox.Create(True);
  API.SciterElementUnwrap(argv, PreviewChat.Root);
  API.SciterGetElementHwnd(PreviewChat.Root, PreviewChat.Window, True);
  if PreviewChat.Window = 0 then
    raise ESciterException.Create('Cannot get preview chat window handle');
  PreviewChat.InitSettings;
  PreviewChat.InitMsgPreview;
end;

class procedure TSearchMethods.FreePreviewChat(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
  SetLength(ContactHist, 0);
  if Assigned(PreviewChat) then
  begin
    PreviewChat.ClosePage;
    FreeAndNil(PreviewChat);
  end;
end;

class procedure TSearchMethods.OpenPreview(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  Index: Integer;
  History: THistory;
  HEvent: THEvent;
begin
  PreviewChat.ClearEvents;
  Index := -1;
  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(const 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;

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

  ElementHandle := nil;
  API.SciterElementUnwrap(argv, ElementHandle);
  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;

class procedure TSearchMethods.GetHistory(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  UID: TUID;
  RowID, I: Integer;
  BodyText: String;
  ElementHandle: HELEMENT;
  Events: Thevents;
begin
  ElementHandle := nil;
  API.SciterElementUnwrap(argv, ElementHandle);
  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);

  TThread.CreateAnonymousThread(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].Index := I;
      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') + Format(', %s', [HumanReadableSize(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;

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

  if (Index >= Low(ContactHist)) and (Index <= High(ContactHist)) then
  V2S(UI.RecordToVar(ContactHist[Index]), retval);
end;

class procedure TSearchMethods.GetHistoryEntries(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  Index, N, I, Cnt, DataLength: Integer;
  ContactHistItems: TParams;
begin
  Index := 0;
  API.ValueIntData(argv, Index);

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

  DataLength := Length(ContactHist);
  if DataLength = 0 then
    Exit;
//OutputDebugString(PChar('GetHistoryEntries1: ' + IntToStr(Index) + ', ' + IntToStr(N)));
  Cnt := 0;
  SetLength(ContactHistItems, 0);
  for I := Index to Index + N - 1 do
  if (I >= Low(ContactHist)) and (I <= High(ContactHist)) then
  begin
    SetLength(ContactHistItems, Cnt + 1);
    ContactHistItems[Cnt] := UI.RecordToVar(ContactHist[I]);
    Inc(Cnt);
  end;

  V2S(ContactHistItems, retval);

  SetLength(ContactHistItems, 0);
end;

//class procedure TSearchMethods.GetHistoryChunk(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;

class procedure TSearchMethods.GetHistoryLength(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
begin
  V2S(Length(ContactHist), retval);
end;

class procedure TSearchMethods.CopyHistoryText(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;

class procedure TSearchMethods.SaveHistoryToFile(argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
  Indexes: Variant;
  I: Integer;
  Filename, Title, Ext: String;
  AsHTML: Boolean;
  UID: TUID;
begin
  UID := SciterVarToString(argv);
  if UID = '' then
    Exit;

  Inc(argv);
  S2V(argv, Indexes);

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

  if AsHTML then
  begin
    Title := 'Save as HTML';
    Ext := 'html';
  end
    else
  begin
    Title := 'Save as text';
    Ext := 'txt';
  end;

  Filename := OpenSaveDlg(nil, GetTranslation(Title), False, Ext);
  SaveTextFile(Filename, UI.Chat.GetSelectedHistoryEventsAsText(UID, Indexes, AsHTML));
end;

class procedure TSearchMethods.MatchHistoryEntry(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;

class procedure TSearchMethods.KeyToIndex(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.