You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
536 lines
14 KiB
Plaintext
536 lines
14 KiB
Plaintext
{
|
|
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, RnQButtons, 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;
|
|
|
|
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
|
|
ContactHist: TArray |
|
Task: ITask;
|
|
HistWidth: Integer;
|
|
DC: HDC;
|
|
|
|
implementation
|
|
|
|
uses
|
|
StrUtils, Clipbrd, RDFileUtil, RQUtil, RDGlobal, RnQLangs, RQThemes,
|
|
RnQSysUtils, RnQPics, RnQDialogs, globalLib, themesLib, utilLib, SciterLib, 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 TAllHistSrchForm.UpdateChatSettings;
|
|
//begin
|
|
// ChatBox.InitSettings;
|
|
//end;
|
|
//
|
|
//procedure TAllHistSrchForm.UpdateChatSmiles;
|
|
//begin
|
|
// ChatBox.UpdateSmiles;
|
|
//end;
|
|
|
|
// ChatBox.OpenPage(contact, True, True);
|
|
// if Key = ^C then
|
|
// ChatBox.copySel2Clpb;
|
|
// ChatBox.ClosePage;
|
|
// ChatBox.ClearEvents;
|
|
// if HistPosTree.SelectedCount = 0 then
|
|
// ChatBox.ShowSearchHere;
|
|
|
|
function GetExcerpt(Text, Query: String; CaseSensitive: Boolean): String;
|
|
var
|
|
I, J: Integer;
|
|
Words: TArray |
|
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) + '...'
|
|
else if EndPos < Length(Text) - 1 then
|
|
Result := Result + '...';
|
|
|
|
if StartPos > 0 then
|
|
Result := '...' + 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;
|
|
Evt: Thevent;
|
|
Events: Thevents;
|
|
begin
|
|
ElementHandle := nil;
|
|
API.ValueBinaryData(argv, ElementHandle, ByteSize);
|
|
if ElementHandle = nil then
|
|
Exit;
|
|
|
|
Inc(argv);
|
|
UID := SciterVarToString(argv);
|
|
if UID = '' then
|
|
Exit;
|
|
|
|
Inc(argv);
|
|
RowID := -1;
|
|
API.ValueIntData(argv, RowID);
|
|
|
|
Events := SQLDB.GetAll(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);
|
|
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 |
|
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.
|