path: root/plugins/HistoryPlusPlus/hpp_eventfilters.pas

(*
    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
*)

unit hpp_eventfilters;

interface

uses Types, SysUtils, Classes, m_api, hpp_global;

const
  // filter modes
  FM_INCLUDE = 0; // show all events from filEvents (default)
  FM_EXCLUDE = 1; // show all events except from filEvents

const
  MAX_FILTER_NAME_LENGTH = 33; // make it uneven, so our db record would align in 4 bytes

type
  ThppEventFilter = record
    Name     : String;
    Events   : TMessageTypes; // resulting events mask generated from filMode and filEvents, filled in runtime
    filMode  : Byte;          // FM_* consts
    filEvents: TMessageTypes; // filter events which are combined with filMode
    filCustom: Word;          // filter events which are combined with filMode
  end;

  ThppEventFilterArray = array of ThppEventFilter;

var
  hppEventFilters: ThppEventFilterArray;
  hppDefEventFilters: ThppEventFilterArray;

  procedure InitEventFilters;
  procedure ReadEventFilters;
  procedure WriteEventFilters;
  procedure ResetEventFiltersToDefault;
  procedure CopyEventFilters(var Src,Dest: ThppEventFilterArray);
  function GetShowAllEventsIndex(Arr: ThppEventFilterArray = nil): Integer;

  function MessageTypesToDWord(mt: TMessageTypes): DWord;

  // compile filMode & filEvents into Events:
  function GenerateEvents(filMode: Byte; filEvents: TMessageTypes): TMessageTypes;
  // compile filMode & filEvents into Events for all filters
  procedure GenerateEventFilters(var Filters: array of ThppEventFilter);

const
  EventsInclude:   TMessageTypes = [];
  EventsDirection: TMessageTypes = [mtIncoming,mtOutgoing];
  EventsExclude:   TMessageTypes = [mtUnknown,mtCustom];
  EventsCustom:    TMessageTypes = [mtCustom];

implementation

uses
  hpp_database, hpp_forms;

var
  filterAll: TMessageTypes;

const
  hppIntDefEventFilters: array[0..12] of ThppEventFilter = (
    (Name: 'Show all events'; Events: []; filMode: FM_EXCLUDE; filEvents: []),
    (Name: 'Messages'; Events: []; filMode: FM_INCLUDE; filEvents: [mtMessage,mtIncoming,mtOutgoing]),
    (Name: 'Link URLs'; Events: []; filMode: FM_INCLUDE; filEvents: [mtUrl,mtIncoming,mtOutgoing]),
    (Name: 'Files'; Events: []; filMode: FM_INCLUDE; filEvents: [mtFile,mtIncoming,mtOutgoing]),
    (Name: 'Contacts'; Events: []; filMode: FM_INCLUDE; filEvents: [mtContacts,mtIncoming,mtOutgoing]),
    (Name: 'Status changes'; Events: [];  filMode: FM_INCLUDE; filEvents: [mtStatus,mtIncoming,mtOutgoing]),
    (Name: 'Status message changes'; Events: [];  filMode: FM_INCLUDE; filEvents: [mtStatusMessage,mtIncoming,mtOutgoing]),
    (Name: 'Nick changes'; Events: [];  filMode: FM_INCLUDE; filEvents: [mtNickChange,mtIncoming,mtOutgoing]),
    (Name: 'Avatar changes'; Events: [];  filMode: FM_INCLUDE; filEvents: [mtAvatarChange,mtIncoming,mtOutgoing]),
    (Name: 'WATrack notify'; Events: [];  filMode: FM_INCLUDE; filEvents: [mtWATrack,mtIncoming,mtOutgoing]),
    (Name: 'Voice calls'; Events: [];  filMode: FM_INCLUDE; filEvents: [mtVoiceCall,mtIncoming,mtOutgoing]),
    (Name: 'All except changes'; Events: []; filMode: FM_EXCLUDE; filEvents: [mtStatus,mtStatusMessage,mtNickChange,mtAvatarChange]),
    (Name: 'All except system'; Events: []; filMode: FM_EXCLUDE; filEvents: [mtSystem])
  );

function IsSameAsDefault: Boolean;
var
  i: Integer;
begin
  Result := False;
  if Length(hppDefEventFilters) <> Length(hppEventFilters) then
    exit;
  for i := 0 to Length(hppEventFilters) - 1 do
  begin
    if hppEventFilters[i].Name <> hppDefEventFilters[i].Name then
      exit;
    if hppEventFilters[i].Events <> hppDefEventFilters[i].Events then
      exit;
  end;
  Result := True;
end;

function DWordToMessageTypes(dwmt: DWord): TMessageTypes;
begin
  Result := [];
  Move(dwmt,Result,SizeOf(Result));
end;

function MessageTypesToDWord(mt: TMessageTypes): DWord;
begin
  Result := 0;
  Move(mt,Result,SizeOf(mt));
end;

procedure UpdateEventFiltersOnForms;
begin
  NotifyAllForms(HM_NOTF_FILTERSCHANGED,0,0);
end;

function GenerateEvents(filMode: Byte; filEvents: TMessageTypes): TMessageTypes;
begin
  if filMode = FM_INCLUDE then
    Result := filEvents
  else
    Result := filterAll - filEvents;
  Result := Result - EventsExclude + EventsInclude;
end;

procedure GenerateEventFilters(var Filters: array of ThppEventFilter);
var
  i: Integer;
begin
  for i := 0 to Length(Filters) - 1 do
  begin
    Filters[i].Events := GenerateEvents(Filters[i].filMode, Filters[i].filEvents);
  end;
end;

procedure CopyEventFilters(var Src,Dest: ThppEventFilterArray);
var
  i: Integer;
begin
  SetLength(Dest,Length(Src));
  for i := 0 to Length(Src) - 1 do
  begin
    Dest[i].Name      := Src[i].Name;
    Dest[i].Events    := Src[i].Events;
    Dest[i].filMode   := Src[i].filMode;
    Dest[i].filEvents := Src[i].filEvents;
    Dest[i].filCustom := Src[i].filCustom;
  end;
end;

function GetShowAllEventsIndex(Arr: ThppEventFilterArray = nil): Integer;
var
  i: Integer;
begin
  if Arr = nil then
    Arr := hppEventFilters;
  Result := 0;
  for i := 0 to Length(Arr) - 1 do
    if (Arr[i].filMode = FM_EXCLUDE) and (Arr[i].filEvents = []) then
    begin
      Result := i;
      break;
    end;
end;

procedure DeleteEventFilterSettings;
var
  i: Integer;
begin
  i := 1;
  while True do
  begin
    if not DBDelete(hppDBName, AnsiString('EventFilter' + IntToStr(i))) then
      break;
    Inc(i);
  end;
end;

procedure ResetEventFiltersToDefault;
begin
  CopyEventFilters(hppDefEventFilters,hppEventFilters);
  DeleteEventFilterSettings;
  UpdateEventFiltersOnForms;
end;

//----- Stealed fro Tnt -----
function ExtractStringFromStringArray(var P: PChar; Separator: Char = #0): String;
var
  Start: PChar;
begin
  Start := P;
  P := StrScan(Start, Separator);
  if P = nil then
  begin
    Result := Start;
    P := StrEnd(Start);
  end
  else
  begin
    SetString(Result, Start, P - Start);
    Inc(P);
  end;
end;

function ExtractStringsFromStringArray(P: PChar; Separator: Char = #0): TWideStringDynArray;
const
  GROW_COUNT = 256;
var
  Count: Integer;
  Item: WideString;
begin
  Count := 0;
  SetLength(Result, GROW_COUNT);
  Item := ExtractStringFromStringArray(P, Separator);
  While Item <> '' do
  begin
    if Count > High(Result) then
      SetLength(Result, Length(Result) + GROW_COUNT);
    Result[Count] := Item;
    Inc(Count);
    Item := ExtractStringFromStringArray(P, Separator);
  end;
  SetLength(Result, Count);
end;
//----- end of Tnt -----
procedure ReadEventFilters;
var
  i: Integer;
  FilterStr: String;
  hexs: TWideStringDynArray;
  filEvents: DWord;
  filMode: Byte;
  filCustom: Word;
begin
  SetLength(hppEventFilters, 0);
  try
    i := 1;
    while True do
    begin
      if not DBExists(hppDBName, AnsiString('EventFilter' + IntToStr(i))) then
      begin
        if Length(hppEventFilters) = 0 then
          raise EAbort.Create('No filters');
        break;
      end;
      FilterStr := GetDBWideStr(hppDBName, AnsiString('EventFilter' + IntToStr(i)), '');
      if FilterStr = '' then
        break;
      SetLength(hppEventFilters, Length(hppEventFilters) + 1);
      // parse String
      hexs := ExtractStringsFromStringArray(PWideChar(FilterStr),',');
      if Length(hexs) < 4 then
        raise EAbort.Create('Wrong filter (' + IntToStr(i) + ') format');
      filMode := 0;
      filEvents := 0;
      filCustom := 0;
      hppEventFilters[i - 1].Name := hexs[0];
      // read filMode
      HexToBin(PWideChar(hexs[1]), @filMode, SizeOf(filMode));
      hppEventFilters[i - 1].filMode := filMode;
      // read filEvents
      HexToBin(PWideChar(hexs[2]), @filEvents, SizeOf(filEvents));
      hppEventFilters[i - 1].filEvents := DWordToMessageTypes(filEvents);
      // read filCustom
      HexToBin(PWideChar(hexs[3]), @filEvents, SizeOf(filCustom));
      hppEventFilters[i - 1].filCustom := filCustom;
      Inc(i);
    end;
    GenerateEventFilters(hppEventFilters);
  except
    ResetEventFiltersToDefault;
  end;
end;

procedure WriteEventFilters;
var
  i: Integer;
  FilterStr: String;
  hex: String;
begin
  if Length(hppEventFilters) = 0 then
  begin
    ResetEventFiltersToDefault;
    exit;
  end;
  if IsSameAsDefault then
  begin
    // revert to default state
    DeleteEventFilterSettings;
    UpdateEventFiltersOnForms;
    exit;
  end;

  for i := 0 to Length(hppEventFilters) - 1 do
  begin
    FilterStr := Copy(hppEventFilters[i].Name, 1, MAX_FILTER_NAME_LENGTH);
    // add filMode
    SetLength(hex, SizeOf(hppEventFilters[i].filMode) * 2);
    BinToHex(@hppEventFilters[i].filMode, PChar(hex),SizeOf(hppEventFilters[i].filMode));
    FilterStr := FilterStr + ',' + hex;
    // add filEvents
    SetLength(hex, SizeOf(hppEventFilters[i].filEvents) * 2);
    BinToHex(@hppEventFilters[i].filEvents, PChar(hex),SizeOf(hppEventFilters[i].filEvents));
    FilterStr := FilterStr + ',' + hex;
    // add filCustom
    SetLength(hex, SizeOf(hppEventFilters[i].filCustom) * 2);
    BinToHex(@hppEventFilters[i].filCustom, PChar(hex),SizeOf(hppEventFilters[i].filCustom));
    FilterStr := FilterStr + ',' + hex;

    WriteDBWideStr(hppDBName, AnsiString('EventFilter' + IntToStr(i + 1)), FilterStr);
  end;
  // delete left filters if we have more than Length(hppEventFilters)
  i := Length(hppEventFilters) + 1;
  while True do
  begin
    if not DBDelete(hppDBName, AnsiString('EventFilter' + IntToStr(i))) then
      break;
    Inc(i);
  end;
  UpdateEventFiltersOnForms;
end;

procedure InitEventFilters;
var
  i: Integer;
  mt: TMessageType;
begin
  // translate and copy internal default static array to dynamic array
  SetLength(hppDefEventFilters, Length(hppIntDefEventFilters));
  for i := 0 to High(hppIntDefEventFilters) do
  begin
    hppDefEventFilters[i].Name := Copy(TranslateUnicodeString(hppIntDefEventFilters[i].Name), 1,
      MAX_FILTER_NAME_LENGTH { TRANSLATE-IGNORE } );
    hppDefEventFilters[i].filMode := hppIntDefEventFilters[i].filMode;
    hppDefEventFilters[i].filEvents := hppIntDefEventFilters[i].filEvents;
    hppDefEventFilters[i].filCustom := hppIntDefEventFilters[i].filCustom;
  end;

  filterAll := [];
  for mt := Low(TMessageType) to High(TMessageType) do
    Include(filterAll, mt);

  GenerateEventFilters(hppDefEventFilters);
end;

end.