History++ sources upload (all files, no project)

git-svn-id: http://svn.miranda-ng.org/main/trunk@756 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c

1 files changed, 560 insertions, 0 deletions

diff --git a/plugins/HistoryPlusPlus/hpp_searchthread.pas b/plugins/HistoryPlusPlus/hpp_searchthread.pas
new file mode 100644
index 0000000000..6406f67bcd
--- /dev/null
+++ b/plugins/HistoryPlusPlus/hpp_searchthread.pas
@@ -0,0 +1,560 @@
+(*

+  History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*

+

+  Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.

+  History+ parts (C) 2001 Christian Kastner

+

+  This program is free software; you can redistribute it and/or modify

+  it under the terms of the GNU General Public License as published by

+  the Free Software Foundation; either version 2 of the License, or

+  (at your option) any later version.

+

+  This program is distributed in the hope that it will be useful,

+  but WITHOUT ANY WARRANTY; without even the implied warranty of

+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

+  GNU General Public License for more details.

+

+  You should have received a copy of the GNU General Public License

+  along with this program; if not, write to the Free Software

+  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

+*)

+

+{ -----------------------------------------------------------------------------

+  hpp_searchthread (historypp project)

+

+  Version:   1.0

+  Created:   05.08.2004

+  Author:    Oxygen

+

+  [ Description ]

+

+  Global searching in History++ is performed in background so

+  we have separate thread for doing it. Here it is, all bright

+  and shiny. In this module the thread is declared, also you

+  can find all text searching routines used and all search

+  logic. See TSearchThread and independent SearchText* funcs

+

+  The results are sent in batches of 500, for every contact.

+  First batch is no more than 50 for fast display.

+

+  Yeah, all search is CASE-INSENSITIVE (at the time of writing :)

+

+  [ History ]

+

+  1.5 (05.08.2004)

+  First version

+

+  [ Modifications ]

+  none

+

+  [ Known Issues ]

+  none

+

+  Contributors: theMIROn, Art Fedorov

+  ----------------------------------------------------------------------------- }

+

+unit hpp_searchthread;

+

+interface

+

+uses

+  Windows, SysUtils, Controls, Messages, HistoryGrid, Classes,

+  m_api,

+  hpp_global, hpp_events, hpp_forms, hpp_bookmarks, hpp_eventfilters;

+

+const

+  ST_FIRST_BATCH = 50;

+  ST_BATCH = 500;

+

+type

+  PDBArray = ^TDBArray;

+  TDBArray = array [0 .. ST_BATCH - 1] of THandle;

+

+  TSearchMethod = set of (smExact, smAnyWord, smAllWords, smBookmarks, smRange, smEvents);

+

+  TContactRec = record

+    hContact: THandle;

+    Timestamp: DWord;

+  end;

+

+  TSearchThread = class(TThread)

+  private

+    Buffer: TDBArray;

+    BufCount: Integer;

+    FirstBatch: Boolean;

+    Contacts: array of TContactRec;

+    CurContact: THandle;

+    CurContactCP: Cardinal;

+    CurProgress: Integer;

+    MaxProgress: Integer;

+    FParentHandle: Hwnd;

+    FSearchStart: Cardinal;

+    SearchWords: array of String;

+    FSearchText: String;

+    FSearchMethod: TSearchMethod;

+    FSearchProtected: Boolean;

+    FSearchRangeTo: TDateTime;

+    FSearchRangeFrom: TDateTime;

+    FSearchEvents: TMessageTypes;

+

+    procedure GenerateSearchWords;

+    procedure SetSearchRangeFrom(const Value: TDateTime);

+    procedure SetSearchRangeTo(const Value: TDateTime);

+    procedure SetSearchEvents(const Value: TMessageTypes);

+

+    function SearchEvent(DBEvent: THandle): Boolean;

+    procedure SearchContact(Contact: THandle);

+    procedure SearchBookmarks(Contact: THandle);

+

+    function DoMessage(Message: DWord; wParam: wParam; lParam: lParam): Boolean;

+    function SendItem(hDBEvent: THandle): Boolean;

+    function SendBatch: Boolean;

+

+    function GetContactsCount: Integer;

+    function GetItemsCount(hContact: THandle): Integer;

+    procedure BuildContactsList;

+    procedure CalcMaxProgress;

+    procedure IncProgress;

+    procedure SetProgress(Progress: Integer);

+

+  protected

+    procedure Execute; override;

+

+  public

+    AllContacts, AllEvents: Integer;

+

+    constructor Create(CreateSuspended: Boolean);

+    destructor Destroy; override;

+

+    property SearchProtectedContacts: Boolean read FSearchProtected write FSearchProtected;

+    property SearchText: String read FSearchText write FSearchText;

+    property SearchMethod: TSearchMethod read FSearchMethod write FSearchMethod;

+    property SearchRangeFrom: TDateTime read FSearchRangeFrom write SetSearchRangeFrom;

+    property SearchRangeTo: TDateTime read FSearchRangeTo write SetSearchRangeTo;

+    property SearchEvents: TMessageTypes read FSearchEvents write SetSearchEvents;

+    property SearchStart: Cardinal read FSearchStart;

+    property ParentHandle: Hwnd read FParentHandle write FParentHandle;

+

+    property Terminated;

+    procedure Terminate(NewPriority: TThreadPriority = tpIdle); reintroduce;

+  end;

+

+const

+  HM_STRD_PREPARE     = HM_STRD_BASE + 1; // the search is prepared (0,0)

+  HM_STRD_PROGRESS    = HM_STRD_BASE + 2; // report the progress (progress, max)

+  HM_STRD_ITEMFOUND   = HM_STRD_BASE + 3; // (OBSOLETE) item is found (hDBEvent,0)

+  HM_STRD_NEXTCONTACT = HM_STRD_BASE + 4;

+  // the next contact is searched (hContact, ContactCount)

+  HM_STRD_FINISHED    = HM_STRD_BASE + 5; // search finished (0,0)

+  HM_STRD_ITEMSFOUND  = HM_STRD_BASE + 6;

+  // (NEW) items are found (array of hDBEvent, array size)

+

+  // helper functions

+function SearchTextExact   (MessageText: String; SearchText: String): Boolean;

+function SearchTextAnyWord (MessageText: String; SearchWords: array of String): Boolean;

+function SearchTextAllWords(MessageText: String; SearchWords: array of String): Boolean;

+

+{$DEFINE SMARTSEARCH}

+

+implementation

+

+uses hpp_contacts, PassForm;

+

+function SearchTextExact(MessageText: String; SearchText: String): Boolean;

+begin

+  Result := Pos(SearchText, MessageText) <> 0;

+end;

+

+function SearchTextAnyWord(MessageText: String; SearchWords: array of String): Boolean;

+var

+  i: Integer;

+begin

+  Result := False;

+  for i := 0 to Length(SearchWords) - 1 do

+  begin

+    Result := SearchTextExact(MessageText, SearchWords[i]);

+    if Result then

+      exit;

+  end;

+end;

+

+function SearchTextAllWords(MessageText: String; SearchWords: array of String): Boolean;

+var

+  i: Integer;

+begin

+  Result := False;

+  for i := 0 to Length(SearchWords) - 1 do

+  begin

+    Result := SearchTextExact(MessageText, SearchWords[i]);

+    if not Result then

+      exit;

+  end;

+end;

+

+{ TSearchThread }

+

+procedure TSearchThread.BuildContactsList;

+

+  procedure AddContact(Cont: THandle);

+  var

+    hDB: THandle;

+  begin

+    SetLength(Contacts, Length(Contacts) + 1);

+    Contacts[High(Contacts)].hContact := Cont;

+    Contacts[High(Contacts)].Timestamp := 0;

+    hDB := CallService(MS_DB_EVENT_FINDLAST, Cont, 0);

+    if hDB <> 0 then

+    begin

+      Contacts[High(Contacts)].Timestamp := GetEventTimestamp(hDB);

+    end;

+  end;

+// OXY:

+// Modified version, original taken from JclAlgorithms.pas (QuickSort routine)

+// See JclAlgorithms.pas for copyright and license information

+// JclAlgorithms.pas is part of Project JEDI Code Library (JCL)

+// [http://www.delphi-jedi.org], [http://jcl.sourceforge.net]

+  procedure QuickSort(L, R: Integer);

+  var

+    i, J, P: Integer;

+    Rec: TContactRec;

+  begin

+    repeat

+      i := L;

+      J := R;

+      P := (L + R) shr 1;

+      repeat

+        while (integer(Contacts[i].Timestamp) - integer(Contacts[P].Timestamp)) < 0 do

+          Inc(i);

+        while (Contacts[J].Timestamp - Contacts[P].Timestamp) > 0 do

+          Dec(J);

+        if i <= J then

+        begin

+          Rec := Contacts[i];

+          Contacts[i] := Contacts[J];

+          Contacts[J] := Rec;

+          if P = i then

+            P := J

+          else if P = J then

+            P := i;

+          Inc(i);

+          Dec(J);

+        end;

+      until i > J;

+      if L < J then

+        QuickSort(L, J);

+      L := i;

+    until i >= R;

+  end;

+

+var

+  hCont: THandle;

+begin

+  hCont := CallService(MS_DB_CONTACT_FINDFIRST, 0, 0);

+

+  while hCont <> 0 do

+  begin

+    Inc(AllContacts);

+    // I hope I haven't messed this up by

+    // if yes, also fix the same in CalcMaxProgress

+    if SearchProtectedContacts or (not SearchProtectedContacts and (not IsUserProtected(hCont)))

+    then

+      AddContact(hCont);

+    hCont := CallService(MS_DB_CONTACT_FINDNEXT, hCont, 0);

+  end;

+

+  AddContact(hCont);

+

+  QuickSort(1, Length(Contacts) - 1);

+end;

+

+procedure TSearchThread.CalcMaxProgress;

+var

+  hCont: THandle;

+begin

+  MaxProgress := 0;

+  hCont := CallService(MS_DB_CONTACT_FINDFIRST, 0, 0);

+  while hCont <> 0 do

+  begin

+    // I hope I haven't messed this up by

+    // if yes, also fix the same in Execute

+    if SearchProtectedContacts or (not SearchProtectedContacts and (not IsUserProtected(hCont)))

+    then

+      MaxProgress := MaxProgress + GetItemsCount(hCont);

+    hCont := CallService(MS_DB_CONTACT_FINDNEXT, hCont, 0);

+  end;

+  // add sysem history

+  MaxProgress := MaxProgress + GetItemsCount(hCont);

+end;

+

+constructor TSearchThread.Create(CreateSuspended: Boolean);

+begin

+  inherited Create(CreateSuspended);

+  AllContacts := 0;

+  AllEvents := 0;

+  SearchMethod := [smExact];

+  SearchProtectedContacts := True;

+end;

+

+destructor TSearchThread.Destroy;

+begin

+  SetLength(SearchWords, 0);

+  SetLength(Contacts, 0);

+  inherited;

+end;

+

+function TSearchThread.DoMessage(Message: DWord; wParam: WPARAM; lParam: LPARAM): Boolean;

+begin

+  Result := PassMessage(ParentHandle, Message, wParam, lParam, smSend);

+end;

+

+procedure TSearchThread.Execute;

+var

+{$IFNDEF SMARTSEARCH}

+  hCont: THandle;

+{$ELSE}

+  i: Integer;

+{$ENDIF}

+  BookmarksMode: Boolean;

+begin

+  BufCount := 0;

+  FirstBatch := True;

+  try

+    FSearchStart := GetTickCount;

+    DoMessage(HM_STRD_PREPARE, 0, 0);

+    CalcMaxProgress;

+    SetProgress(0);

+

+    BookmarksMode := (smBookmarks in SearchMethod);

+

+    // search within contacts

+    if not BookmarksMode then

+    begin

+      // make it case-insensitive

+      SearchText := WideUpperCase(SearchText);

+      if SearchMethod * [smAnyWord, smAllWords] <> [] then

+        GenerateSearchWords;

+    end;

+

+{$IFNDEF SMARTSEARCH}

+    hCont := CallService(MS_DB_CONTACT_FINDFIRST, 0, 0);

+    while (hCont <> 0) and not Terminated do

+    begin

+      Inc(AllContacts);

+      // I hope I haven't messed this up by

+      // if yes, also fix the same in CalcMaxProgress

+      if SearchProtectedContacts or

+        (not SearchProtectedContacts and (not IsUserProtected(hCont))) then

+      begin

+        if BookmarksMode then

+          SearchBookmarks(hCont)

+        else

+          SearchContact(hCont);

+      end;

+      hCont := CallService(MS_DB_CONTACT_FINDNEXT, hCont, 0);

+    end;

+    if BookmarksMode then

+      SearchBookmarks(hCont)

+    else

+      SearchContact(hCont);

+{$ELSE}

+    BuildContactsList;

+    for i := Length(Contacts) - 1 downto 0 do

+    begin

+      if BookmarksMode then

+        SearchBookmarks(Contacts[i].hContact)

+      else

+        SearchContact(Contacts[i].hContact);

+    end;

+{$ENDIF}

+  finally

+    // only Post..., not Send... because we wait for this thread

+    // to die in this message

+    DoMessage(HM_STRD_FINISHED, 0, 0);

+  end;

+end;

+

+procedure TSearchThread.Terminate(NewPriority: TThreadPriority = tpIdle);

+begin

+  if (NewPriority <> tpIdle) and (NewPriority <> Priority) then

+    Priority := NewPriority;

+  inherited Terminate;

+end;

+

+procedure TSearchThread.GenerateSearchWords;

+var

+  n: Integer;

+  st: String;

+begin

+  SetLength(SearchWords, 0);

+  st := SearchText;

+  n := Pos(' ', st);

+  while n > 0 do

+  begin

+    if n > 1 then

+    begin

+      SetLength(SearchWords, Length(SearchWords) + 1);

+      SearchWords[High(SearchWords)] := Copy(st, 1, n - 1);

+    end;

+    Delete(st, 1, n);

+    n := Pos(' ', st);

+  end;

+

+  if st <> '' then

+  begin

+    SetLength(SearchWords, Length(SearchWords) + 1);

+    SearchWords[High(SearchWords)] := st;

+  end;

+end;

+

+function TSearchThread.GetContactsCount: Integer;

+begin

+  Result := CallService(MS_DB_CONTACT_GETCOUNT, 0, 0);

+end;

+

+function TSearchThread.GetItemsCount(hContact: THandle): Integer;

+begin

+  Result := CallService(MS_DB_EVENT_GETCOUNT, hContact, 0);

+end;

+

+procedure TSearchThread.IncProgress;

+begin

+  SetProgress(CurProgress + 1);

+end;

+

+procedure TSearchThread.SearchContact(Contact: THandle);

+var

+  hDBEvent: THandle;

+begin

+  if Terminated then

+    exit;

+  CurContactCP := GetContactCodePage(Contact);

+  CurContact := Contact;

+  DoMessage(HM_STRD_NEXTCONTACT, wParam(Contact), lParam(GetContactsCount));

+  hDBEvent := CallService(MS_DB_EVENT_FINDLAST, Contact, 0);

+  while (hDBEvent <> 0) and (not Terminated) do

+  begin

+    if SearchEvent(hDBEvent) then

+      SendItem(hDBEvent);

+    hDBEvent := CallService(MS_DB_EVENT_FINDPREV, hDBEvent, 0);

+  end;

+  SendBatch;

+end;

+

+procedure TSearchThread.SearchBookmarks(Contact: THandle);

+var

+  i: Integer;

+begin

+  if Terminated then

+    exit;

+  DoMessage(HM_STRD_NEXTCONTACT, wParam(Contact), lParam(GetContactsCount));

+  for i := 0 to BookmarkServer[Contact].Count - 1 do

+  begin

+    if Terminated then

+      exit;

+    Inc(AllEvents);

+    SendItem(BookmarkServer[Contact].Items[i]);

+    IncProgress;

+  end;

+  SendBatch;

+end;

+

+function TSearchThread.SearchEvent(DBEvent: THandle): Boolean;

+var

+  hi: THistoryItem;

+  Passed: Boolean;

+  EventDate: TDateTime;

+begin

+  Result := False;

+  if Terminated then

+    exit;

+  Passed := True;

+  if smRange in SearchMethod then

+  begin

+    EventDate := Trunc(GetEventDateTime(DBEvent));

+    Passed := ((SearchRangeFrom <= EventDate) and (SearchRangeTo >= EventDate));

+  end;

+  if Passed then

+  begin

+    if SearchMethod * [smExact, smAnyWord, smAllWords, smEvents] <> [] then

+    begin

+      hi := ReadEvent(DBEvent, CurContactCP);

+      if smEvents in SearchMethod then

+        Passed := ((MessageTypesToDWord(FSearchEvents) and MessageTypesToDWord(hi.MessageType))

+          >= MessageTypesToDWord(hi.MessageType));

+      if Passed then

+      begin

+        if      smExact    in SearchMethod then Passed := SearchTextExact(WideUpperCase(hi.Text), SearchText)

+        else if smAnyWord  in SearchMethod then Passed := SearchTextAnyWord(WideUpperCase(hi.Text), SearchWords)

+        else if smAllWords in SearchMethod then Passed := SearchTextAllWords(WideUpperCase(hi.Text), SearchWords);

+      end;

+    end;

+  end;

+  Inc(AllEvents);

+  IncProgress;

+  Result := Passed;

+end;

+

+function TSearchThread.SendItem(hDBEvent: THandle): Boolean;

+var

+  CurBuf: Integer;

+begin

+  Result := True;

+  if Terminated then

+    exit;

+  Inc(BufCount);

+  if FirstBatch then

+    CurBuf := ST_FIRST_BATCH

+  else

+    CurBuf := ST_BATCH;

+  Buffer[BufCount - 1] := hDBEvent;

+  if BufCount = CurBuf then

+    Result := SendBatch;

+end;

+

+function TSearchThread.SendBatch;

+var

+  Batch: PDBArray;

+begin

+  Result := True;

+  if Terminated then

+    exit;

+  if BufCount > 0 then

+  begin

+    GetMem(Batch, SizeOf(Batch^));

+    CopyMemory(Batch, @Buffer, SizeOf(Buffer));

+    Result := DoMessage(HM_STRD_ITEMSFOUND, wParam(Batch), lParam(BufCount));

+    if not Result then

+    begin

+      FreeMem(Batch, SizeOf(Batch^));

+      Terminate(tpHigher);

+    end;

+    BufCount := 0;

+    FirstBatch := False;

+  end;

+end;

+

+procedure TSearchThread.SetProgress(Progress: Integer);

+begin

+  CurProgress := Progress;

+  if CurProgress > MaxProgress then

+    MaxProgress := CurProgress;

+  if (CurProgress mod 1000 = 0) or (CurProgress = MaxProgress) then

+    DoMessage(HM_STRD_PROGRESS, wParam(CurProgress), lParam(MaxProgress));

+end;

+

+procedure TSearchThread.SetSearchRangeFrom(const Value: TDateTime);

+begin

+  FSearchRangeFrom := Trunc(Value);

+end;

+

+procedure TSearchThread.SetSearchRangeTo(const Value: TDateTime);

+begin

+  FSearchRangeTo := Trunc(Value);

+end;

+

+procedure TSearchThread.SetSearchEvents(const Value: TMessageTypes);

+begin

+  FSearchEvents := Value;

+end;

+

+end.