ADR

unit ForumPoster;

interface

uses
  Classes, SysUtils, FPExceptions, FPResourceString, AdrStringUtils, OleCtrls,
  SHDocVw, Forms, ActiveX, Generics.Collections, Generics.Defaults, windows,
  Dialogs, Diagnostics, Controls, IniFiles;

type
  TTegsList = Class
  private
    FTegsList: TStringList;
    function GetTegs: string;
    procedure SetTegs(const Value: string);
    function GetCount: integer;
  public
    constructor Create(Sorted:boolean=true);
    destructor Destroy; override;
    procedure Add(const Teg: string); overload;
    procedure Add(const Tegs: TTegsList); overload; //AddRange
    procedure DeleteTegs(const Tegs: TTegsList);  overload;
    procedure DeleteTegs(const Tegs:String);  overload;
    procedure Clear;

    function TegInList(const Tegs: string): boolean;
    function TegsInList(Tegs: TTegsList): boolean;
    function NotTegsinList(Tegs: TTegsList): boolean;

    property Count: integer read GetCount;
    property TegsStr: string read GetTegs write SetTegs;
    property TegsList: TStringList read FTegsList;
  end;

  // ------------------------------------------------------------------------------
const
  arIdentExists = -1;         //код помилки функи Add()
  arSubIdentExists = -2;
type

  TCustomConfList<T> = class (TList<T>)
  private
    FModified: boolean;
  public
    function Add(const Value: T): Integer; virtual;
    procedure AddRange(const Values: array of T;
      out Logs:TArray<Integer>); overload;
    procedure AddRange(const Values: array of T);  overload;
    function IndexOf(const Value: T): Integer;
    procedure Delete(Index: Integer);
    procedure Clear;

    property Modified:boolean read FModified write FModified;
  end;

  TEngineConf = record
    Name: string;
    Coment: string;
    Tegs: TTegsList;
    LogUser: string;
    LogPass: string;
    MsgTitle: string;
    MsgMess: string;
    TopicTitle: string;
    TopicMsg: string;
  end;
  TEngineConfArray = array of TEngineConf;
  TEngineConfList = class;


  TBookmarkConf = record
    Name: string;
    URI: string;
    Tegs: TTegsList;
    isMsg: boolean;
  end;
  TBookmarkConfArray = array of TBookmarkConf;
  TBookmarkConfList = class;

  TForumConf = record
    Name: string;
    Coment: string;
    Tegs: TTegsList;
    LogName: string; // log
    LogPass: string; // pass
    LogURI: string;
    LogBtn: string;
    MsgBtn: string;
    TopicBtn: string;
    EngineName: string;
  end;
  TForumConfArray = array of TForumConf;
  TForumConfList = class;

  TEngineConfList = class (TCustomConfList<TEngineConf>)
  private
    FTegsList: TTegsList;
    function Comparison(const Left, Right: TEngineConf): Integer;
    function GetItems(Name: string): TEngineConf;
    procedure SetItems(Name: string; const Value: TEngineConf);
  public
    constructor Create;

    function Add(const Value: TEngineConf): Integer;  override;
    procedure Delete(const Name: string); overload;
    function Contains(const Name: string): Boolean; overload;
    function IndexOf(const Name: string): integer;

    function ListOfNames: string;
    function GetTegsList: TTegsList;

    property ItemsFromName[Name: string]:TEngineConf read GetItems write SetItems;
  end;

  TForumConfList = class (TCustomConfList<TForumConf>)
  private type
    TDomainRec = TPair<string,Integer>;
    TDomainRecArray = array of TDomainRec;
  private
    FTegsList: TTegsList;
    FDomainArray: TDomainRecArray;
    FDomainComparer: IComparer<TDomainRec>;
    function Comparison(const Left, Right: TForumConf): Integer;
    function ComparisonDomain(const Left,Right:TDomainRec):integer;
    function GetItems(Name: string): TForumConf;
    procedure SetItems(Name: string; const Value: TForumConf);
    procedure MakeDomainArray;
    function GetURIItems(URI: string): TForumConf;
    procedure SetURIItems(URI: string; const Value: TForumConf);
  public
    constructor Create;

    function Add(const Value: TForumConf): Integer; override;
    procedure Delete(const Name: string); overload;
    function Contains(const Name: string): Boolean; overload;
    function IndexOf(const Name: string): integer;
    function ContainsFromURI(const URI:string): boolean;
    function IndexOfFromURI(const URI: string): integer;

    function ListOfNames: string;
    function ListOfURI: string;
    function GetTegsList:  TTegsList;

    property ItemsFromURI[URI: string]:TForumConf read GetURIItems write SetURIItems;
    property ItemsFromName[Name: string]:TForumConf read GetItems write SetItems;
  end;

  TBookmarkConfList = class (TCustomConfList<TBookmarkConf>)
  private
    FTegsList: TTegsList;
    function Comparison(const Left, Right: TBookmarkConf): Integer;
    function GetItems(URI: string): TBookmarkConf;
    procedure SetItems(URI: string; const Value: TBookmarkConf);
  public
    constructor Create;

    function Add(const Value: TBookmarkConf): Integer; override;
    procedure Delete(const URI: string); overload;
    function Contains(const URI: string): Boolean; overload;
    function IndexOf(const URI: string ): integer;

    function ListOfURI: string;
    function GetTegsList:  TTegsList;

    property ItemsFromURI[URI: string]:TBookmarkConf read GetItems write SetItems;
  end;


  // ========{Request}=============================================================

  TRqtPrmItem = record
    URI: string;
    Prm: array [0..1,0..1] of string;
    Btn: string;
    ErrIf: string; //умова при якій вважають що запит був невдалий
    Captcha: string
  end;
  TRqtParam = array [0..1] of TRqtPrmItem;
  TRqtParamList = TList<TRqtParam>;

  // ==============================================================================

  TTegsArray = array [0..2,0..1] of TTegsList;

  TFPConfDB = class
  type
    TConfType = (ctUnknown, ctEngine, ctForum, ctBookmark);
  private
    FForumList: TForumConfList;
    FEngineList: TEngineConfList;
    FBookmarkList: TBookmarkConfList;
    FForumPath: string;
    FEnginePath: string;
    FBookPath: string;

    FEngineTegs: TTegsList;
    FForumTegs: TTegsList;
    FBookTegs: TTegsList;
    FStrings: TStrings;

    const EngineTypeIdent  = 'EngineConf';
    const ForumTypeIdent   = 'ForumConf';
    const BookmarkTypeIdent= 'BookmarkConf';

    const MetadataSection = 'Metadata';
    const ItemTypeIdent   = 'ItemType';
    const ItemsCount      = 'ItemsCount';
    const VersionIdent    = 'Version';
  public
    constructor Create;
    destructor Destroy; override;

    const EngineVersion   :Double= 0.1;
    const ForumVersion    :Double= 0.1;
    const BookmarkVersion :Double= 0.1;

    property Forums: TForumConfList read FForumList write FForumList;
    property Engines: TEngineConfList read FEngineList write FEngineList;
    property Bookmarks: TBookmarkConfList read FBookmarkList write FBookmarkList;

    procedure LoadFromFile;
    procedure SaveToFile;

    class function CheckConfType(const FileName: string): TConfType;
    class function CheckConfVersion(const FileName: string): Double;
    class function LoadEngine(const FileName: string): TEngineConfArray;
    class function LoadForum(const FileName: string): TForumConfArray;
    class function LoadBookmark(const FileName: string): TBookmarkConfArray;
    class procedure SaveEngine(const FileName: string; const AEngineList: TEngineConfList);
    class procedure SaveForum(const FileName: string; const AForumList: TForumConfList);
    class procedure SaveBook(const FileName: string; const ABookmarkList: TBookmarkConfList);

    function BookToRqtPrm(const Book:TBookmarkConf; out Conf:TRqtParam;
      const Title,Msg:string):string;  //err msg
    procedure ClearAll;
    function  TegsFilter(const Tegs:TTegsArray):TStrings;

    property ForumsSavePath: string read FForumPath write FForumPath;
    property EngineSavePath: string read FEnginePath write FEnginePath;
    property BooksSavePath: string read FBookPath write FBookPath;
  end;

  // =================={ Request }==============================================

  TRqtStatusConteyner = record
    Error:      integer;
    Warring:    integer;
    Done:       integer;
    Terminated: integer;
    fElse:      integer; //не використовується
    Summ:       integer;
  end;
  TRqtWorkBeginEvent = procedure (Sender:TObject; Max:integer) of object;
  TRqtWorkEvent = procedure (Sender:TObject;
                          const Status:TRqtStatusConteyner) of object;
  TRqtWorkEndEvent = TNotifyEvent;

  TRqtThreadLogItemType = (itError, itWarning, itTerminated, itDone,
                                                              itEvent, itNone);
  TRqtThreadLogConteyner = record
    Item: string;
    ItemType: TRqtThreadLogItemType;
    Time: TDate;
    ThreadId: integer;
  end;
  TRqtThreadLogManager = TList<TRqtThreadLogConteyner>;


  TFPRequest = class
  private type

    TFPRqtThread = class (TThread)
    private type
      TStatus = (stWait, stCompited, stError);
    private
      FParams: TRqtParam;
      FStatus:  TStatus;
      FManager: TFPRequest;
        FThreadId: integer;
        FHighLogType: TRqtThreadLogItemType;
      procedure DocumentComplete(ASender: TObject;  const pDisp: IDispatch;
        const URL: OleVariant);
      procedure NavigateError(ASender: TObject; const pDisp: IDispatch;
                                                         const URL: OleVariant;
                                                         const Frame: OleVariant;
                                                         const StatusCode: OleVariant;
                                                         var Cancel: WordBool);
      procedure AddToLog(const Item:string; ItemType:TRqtThreadLogItemType);
        procedure SetHighLogType(const Value: TRqtThreadLogItemType);
    protected
      procedure Execute; override;
    public
      constructor Create(const Param: TRqtParam; Manager: TFPRequest);
      destructor Destroy; override;
      property ThreadId:integer read FThreadId write FThreadId;
      property HighLogType:TRqtThreadLogItemType read FHighLogType write SetHighLogType;
    end;

    TThreadNotifiEvent =  procedure(Sender: TObject; const Item: TRqtThreadLogConteyner;
    Action: TCollectionNotification) of object;
  private
    fThreadsMax:  integer;
    fThreads:     integer;
    FCompitStatus:TRqtStatusConteyner;
    fTerminated:   boolean;
    FLookNewRequest: boolean; //вказує чи була завершенна попередня спороба постінгу
    fRqtList:     TRqtParamList;
    FOnWorkBegin: TRqtWorkBeginEvent;
    FOnWork:      TRqtWorkEvent;
    FOnWorkEnd:   TRqtWorkEndEvent;
    FNextThreadId:  integer;
    FLogList: TRqtThreadLogManager;

    procedure DoRequest(Params: TRqtParamList);
    procedure ThreadDone(Sender: TObject);
    procedure CheckWorkEnd;
    function GetThreadLogAdd: TThreadNotifiEvent;
    procedure SetThreadLogAdd(
      const Value: TThreadNotifiEvent);
  public
    constructor Create;
    destructor Destroy;  override;
    procedure Posting;
    procedure Terminate;

    procedure AddToList(const NewConf:TRqtParam);
    function  ListCount:integer;
    procedure ClearList;

    class procedure SetNullStatus(var Status:TRqtStatusConteyner);

    property Terminated:boolean read fTerminated write fTerminated;
    property ThreadMax: integer read fThreadsMax write fThreadsMax default 20;
    property OnWorkBegin: TRqtWorkBeginEvent read FOnWorkBegin write FOnWorkBegin;
    property OnWork: TRqtWorkEvent read FOnWork write FOnWork;
    property OnWorkEnd: TRqtWorkEndEvent read FOnWorkEnd write FOnWorkEnd;
    property OnThreadEvent: TThreadNotifiEvent
        read GetThreadLogAdd write SetThreadLogAdd;
    property LogList:TRqtThreadLogManager read FLogList write FLogList;
  end;

  TFPAllInOne = class
  private
    FRequest: TFPRequest;
    FDBList: TFPConfDB;
  public
    constructor Create;
    destructor Destroy; override;

    property Request: TFPRequest read FRequest write FRequest;
    property DBList: TFPConfDB read FDBList write FDBList;
  end;

  TForumsPoster = TFPAllInOne;

function enArray(const Ar: String): ShortString;
function deArray(const s: ShortString): String;

implementation

resourcestring
  RSBadIdent = '"%s" - не є правльним іднетифікатором!';

function enArray(const Ar: string): ShortString;
begin
  SetLength(result, 255);
  result := AnsiString(Ar)+ShortString(StringOfChar(#0, 255-Length(Ar)));
end;

function deArray(const s: ShortString): string;
var
  P, Stop: PAnsiChar;
begin
  P := (@s[1]);
  Stop := P;
  while Stop^ <> #0 do
    inc(Stop);
  result := String(Copy(s, 1, Stop - P));
end;

{ TFPConfList }

function TFPConfDB.BookToRqtPrm(const Book:TBookmarkConf; out Conf:TRqtParam;
  const Title,Msg:string):string;
var
  I: Integer;
  ForumConf:TForumConf;
  EngineConf:TEngineConf;
begin
  i:= FForumList.IndexOfFromURI(Book.URI);
  if i<0 then
  begin
    Result:=Format(SErrMsgPrefix+SErrForumFromURINotExists,[book.URI]);
    exit;
  end;
  ForumConf:=FForumList.Items[i];

  i:= FEngineList.IndexOf(ForumConf.EngineName);
  if i<-1 then
  begin
    Result:=Format(SErrMsgPrefix+SErrEngineFromForumNotExists,
        [ForumConf.EngineName, ForumConf.Name]);
    exit;
  end;
  EngineConf:=FEngineList.Items[i];

  with  conf[0] do
  begin
    URI:=     ForumConf.LogURI;
    Prm[0,0]:=EngineConf.LogUser;
    Prm[1,0]:=EngineConf.LogPass;
    Prm[0,1]:=ForumConf.LogName;
    Prm[1,1]:=ForumConf.LogPass;
    ErrIf:='';
    Captcha:='';
  end;

  with Conf[1] do
  begin
    URI:=Book.URI;

    if Book.isMsg then
    begin
      Prm[0,0]:=EngineConf.MsgTitle;
      Prm[1,0]:=EngineConf.MsgMess;
      Btn :=    ForumConf.MsgBtn;
    end
    else
    begin
      Prm[0,0]:=EngineConf.TopicTitle;
      Prm[1,0]:=EngineConf.TopicMsg;
      Btn :=    ForumConf.TopicBtn;
    end;

    Prm[0,1]:=Title;
    Prm[1,1]:=Msg;
    ErrIf:='';
    Captcha:='';
  end;

end;

procedure TFPConfDB.ClearAll;
begin
  FEngineList.Clear;
  FForumList.Clear;
  FBookmarkList.Clear;
end;

constructor TFPConfDB.Create;
begin
  inherited;
  FForumList:=TForumConfList.Create;
  FEngineList:=TEngineConfList.Create;
  FBookmarkList:=TBookmarkConfList.Create;
end;

destructor TFPConfDB.Destroy;
begin
  ClearAll;
  FEngineTegs.Free;
  FForumTegs.Free;
  FBookTegs.Free;
  inherited;
end;

class function TFPConfDB.CheckConfType(const FileName: string): TConfType;
var
  Ini: TIniFile;
  buff: string;
begin
  Ini := TIniFile.Create(FileName);
  try
    buff := Ini.ReadString(MetadataSection,ItemTypeIdent,'');
    if buff = EngineTypeIdent then
      Result  :=  ctEngine
    else if buff = ForumTypeIdent then
      Result  :=  ctForum
    else if buff = BookmarkTypeIdent then
      Result  :=  ctBookmark
    else
      Result  :=  ctUnknown;
  finally
    Ini.Free;
  end;
end;

class function TFPConfDB.CheckConfVersion(const FileName: string): Double;
var
  Ini: TIniFile;
begin
  Ini := TIniFile.Create(FileName);
  try
    Result := Ini.ReadFloat(MetadataSection, VersionIdent, 0.00);
  finally
    Ini.Free;
  end;
end;

class function TFPConfDB.LoadBookmark(const FileName: string): TBookmarkConfArray;
var
  Ini:TMemIniFile;
  I: Integer;
  NumStr:string;
  FileVersion:Double;
begin
  SetLength(Result,0);
  if not FileExists(FileName) then
    Exit;

  Ini := TMemIniFile.Create(FileName);
  try
    with ini do
    begin
      {Провірки...}
      if ReadString(MetadataSection, ItemTypeIdent, '') <> BookmarkTypeIdent then
        raise EFPException.CreateFmt(SErrFileTypeNotValited,
          [ExtractFileName(FileName),SToBookmark]);

      FileVersion:= ReadFloat(MetadataSection, VersionIdent, 0.0);
      if FileVersion <> BookmarkVersion then
        if Abs(FileVersion-BookmarkVersion)<1 then  //різниця в мінорні версії
          if MessageDlg(Format(SWrgDBVersionMinorDelta,
                          [SToBookmark, FileVersion, BookmarkVersion]),
                        mtWarning, mbAbortIgnore,-1)=mrAbort
          then
            Exit
        else
          MessageBox(0, PChar(Format(SErrDBVersionMajorDelta,
                        [SToBookmark, FileVersion, BookmarkVersion])),
                PChar(SErrLoadFileTitle), MB_OK or MB_ICONSTOP or MB_TASKMODAL);
      {/Провірки}

      SetLength(Result,ReadInteger(MetadataSection, ItemsCount, 0));
      for I := 0 to High(Result) do
        with  Result[i] do
        begin
          NumStr:=IntToStr(i);
          Tegs  :=  TTegsList.Create();
          Name  :=        ReadString(NumStr, 'Name',    '');
          URI   :=        ReadString(NumStr, 'URI',     '');
          Tegs.TegsStr := ReadString(NumStr, 'Tegs',    '');
          isMsg :=        ReadBool(NumStr, 'LogUser', False);
        end;

    end;
  finally
    Ini.Free;
  end;
end;

class function TFPConfDB.LoadEngine(const FileName: string): TEngineConfArray;
var
  Ini:TMemIniFile;
  I: Integer;
  NumStr:string;
//  FileVersion:Double;
begin
  SetLength(Result,0);
  if not FileExists(FileName) then
    Exit;

  Ini := TMemIniFile.Create(FileName);
  try
    with ini do
    begin
      {Провірки...}
      if ReadString(MetadataSection, ItemTypeIdent, '') <> EngineTypeIdent then
        raise EFPException.CreateFmt(SErrFileTypeNotValited,
          [ExtractFileName(FileName),SToEngine]);

      {FileVersion:= ReadFloat(MetadataSection, VersionIdent, 0.0);
      if FileVersion <> EngineVersion then
        if Abs(FileVersion-EngineVersion)<1 then  //різниця в мінорні версії
          if MessageDlg(Format(SWrgDBVersionMinorDelta,
                          [SToEngine, FileVersion, EngineVersion]),
                        mtWarning, mbAbortIgnore,-1)=mrAbort
          then
            Exit
        else
          MessageBox(0, PChar(Format(SErrDBVersionMajorDelta,
                        [SToEngine, FileVersion, EngineVersion])),
                PChar(SErrLoadFileTitle), MB_OK or MB_ICONSTOP or MB_TASKMODAL);}
      {/Провірки}

      SetLength(Result,ReadInteger(MetadataSection, ItemsCount, 0));
      for I := 0 to High(Result) do
        with  Result[i] do
        begin
          NumStr    :=    IntToStr(i);
          Tegs      :=    TTegsList.Create();
          Name      :=    ReadString(NumStr, 'Name',    '');
          Coment    :=    ReadString(NumStr, 'Coment',  '');
          Tegs.TegsStr:=  ReadString(NumStr, 'Tegs',    '');
          LogUser   :=    ReadString(NumStr, 'LogUser', '');
          LogPass   :=    ReadString(NumStr, 'LogPass', '');
          MsgTitle  :=    ReadString(NumStr, 'MsgTitle','');
          MsgMess   :=    ReadString(NumStr, 'MsgMess', '');
          TopicTitle:=    ReadString(NumStr, 'TopicTitle','');
          TopicMsg  :=    ReadString(NumStr, 'TopicMsg','');
        end;

    end;
  finally
    Ini.Free;
  end;
end;

class function TFPConfDB.LoadForum(const FileName: string): TForumConfArray;
var
  Ini:TMemIniFile;
  I: Integer;
  NumStr:string;
  FileVersion:Double;
begin
  SetLength(Result,0);
  if not FileExists(FileName) then
    Exit;

  Ini := TMemIniFile.Create(FileName);
  try
    with ini do
    begin
      {Провірки...}
      if ReadString(MetadataSection, ItemTypeIdent, '') <> ForumTypeIdent then
        raise EFPException.CreateFmt(SErrFileTypeNotValited,
          [ExtractFileName(FileName),SToForum]);

      FileVersion:= ReadFloat(MetadataSection, VersionIdent, 0.0);
      if FileVersion <> ForumVersion then
        if Abs(FileVersion-ForumVersion)<1 then  //різниця в мінорні версії
          if MessageDlg(Format(SWrgDBVersionMinorDelta,
                          [SToForum, FileVersion, ForumVersion]),
                        mtWarning, mbAbortIgnore,-1)=mrAbort
          then
            Exit
        else
          MessageBox(0, PChar(Format(SErrDBVersionMajorDelta,
                        [SToForum, FileVersion, ForumVersion])),
                PChar(SErrLoadFileTitle), MB_OK or MB_ICONSTOP or MB_TASKMODAL);
      {/Провірки}

      SetLength(Result,ReadInteger(MetadataSection, ItemsCount, 0));
      for I := 0 to High(Result) do
        with  Result[i] do
        begin
          NumStr:=IntToStr(i);
          Tegs  :=  TTegsList.Create();
          Name  :=        ReadString(NumStr, 'Name',    '');
          Coment  :=      ReadString(NumStr, 'Coment',  '');
          Tegs.TegsStr := ReadString(NumStr, 'Tegs',    '');
          LogName   :=    ReadString(NumStr, 'LogName', '');
          LogPass   :=    ReadString(NumStr, 'LogPass', '');
          LogURI    :=    ReadString(NumStr, 'LogURI',  '');
          LogBtn    :=    ReadString(NumStr, 'LogBtn',  '');
          MsgBtn    :=    ReadString(NumStr, 'MsgBtn',  '');
          TopicBtn  :=    ReadString(NumStr, 'TopicBtn','');
          EngineName:=    ReadString(NumStr, 'EngineName','')
        end;
    end;
  finally
    Ini.Free;
  end;
end;

procedure TFPConfDB.LoadFromFile;
var
  AEngine:TEngineConfArray;
  AForum:TForumConfArray;
  ABookmark:TBookmarkConfArray;
begin
  ClearAll;

  try
    AEngine:= LoadEngine(FEnginePath);
    FEngineList.AddRange(AEngine);
    SetLength(AEngine,0);
  except
    on E: EFOpenError do
      if not(E is EFOpenError) then
        raise;
  end;

  try
    AForum  :=  LoadForum(FForumPath);
    FForumList.AddRange(AForum);
    SetLength(AForum,0);
  except
    on E: EFOpenError do
      if not(E is EFOpenError) then
        raise;
  end;

  try
    ABookmark :=  LoadBookmark(FBookPath);
    FBookmarkList.AddRange(ABookmark);
    SetLength(ABookmark,0);
  except
    on E: EFOpenError do
      if not(E is EFOpenError) then
        raise;
  end;
end;

class procedure TFPConfDB.SaveBook(const FileName: string;
  const ABookmarkList: TBookmarkConfList);
var
  Ini:TMemIniFile;
  I: Integer;
  NumStr:string;
begin
  Ini := TMemIniFile.Create(FileName);
  try
    with ini do
    begin
      WriteString(MetadataSection, ItemTypeIdent, BookmarkTypeIdent);
      WriteFloat(MetadataSection, VersionIdent, BookmarkVersion);
      WriteInteger(MetadataSection, ItemsCount, ABookmarkList.Count);

      for I := 0 to ABookmarkList.Count-1 do
        with  ABookmarkList.Items[i] do
        begin
          NumStr:=IntToStr(i);
          WriteString(NumStr, 'Name',       Name);
          WriteString(NumStr, 'URI',        URI);
          WriteString(NumStr, 'Tegs',       Tegs.TegsStr);
          WriteBool(NumStr,   'isMsg',      isMsg);
        end;
    end;
    Ini.UpdateFile;
  finally
    Ini.Free;
  end;
end;


class procedure TFPConfDB.SaveEngine(const FileName: string;
  const AEngineList: TEngineConfList);
var
  Ini:TMemIniFile;
  I: Integer;
  NumStr:string;
begin
  Ini := TMemIniFile.Create(FileName);
  try
    with ini do
    begin
      WriteString(MetadataSection, ItemTypeIdent, EngineTypeIdent);
      WriteFloat(MetadataSection, VersionIdent, EngineVersion);
      WriteInteger(MetadataSection, ItemsCount, AEngineList.Count);

      for I := 0 to AEngineList.Count-1 do
        with  AEngineList.Items[i] do
        begin
          NumStr:=IntToStr(i);
          WriteString(NumStr, 'Name',       Name);
          WriteString(NumStr, 'Coment',     Coment);
          WriteString(NumStr, 'Tegs',       Tegs.TegsStr);
          WriteString(NumStr, 'LogUser',    LogUser);
          WriteString(NumStr, 'LogPass',    LogPass);
          WriteString(NumStr, 'MsgTitle',   MsgTitle);
          WriteString(NumStr, 'MsgMess',    MsgMess);
          WriteString(NumStr, 'TopicTitle', TopicTitle);
          WriteString(NumStr, 'TopicMsg',   TopicMsg);
        end;

    end;
    Ini.UpdateFile;
  finally
    Ini.Free;
  end;
end;

class procedure TFPConfDB.SaveForum(const FileName: string;
  const AForumList: TForumConfList);
var
  Ini:TMemIniFile;
  I: Integer;
  NumStr:string;
begin
  Ini := TMemIniFile.Create(FileName);
  try
    with ini do
    begin
      WriteString(MetadataSection, ItemTypeIdent, ForumTypeIdent);
      WriteFloat(MetadataSection, VersionIdent, ForumVersion);
      WriteInteger(MetadataSection, ItemsCount, AForumList.Count);

      for I := 0 to AForumList.Count-1 do
        with  AForumList.Items[i] do
        begin
          NumStr:=IntToStr(i);
          WriteString(NumStr, 'Name',       Name);
          WriteString(NumStr, 'Coment',     Coment);
          WriteString(NumStr, 'Tegs',       Tegs.TegsStr);
          WriteString(NumStr, 'LogName',    LogName);
          WriteString(NumStr, 'LogPass',    LogPass);
          WriteString(NumStr, 'LogURI',     LogURI);
          WriteString(NumStr, 'LogBtn',     LogBtn);
          WriteString(NumStr, 'MsgBtn',     MsgBtn);
          WriteString(NumStr, 'TopicBtn',   TopicBtn);
          WriteString(NumStr, 'EngineName', EngineName);
        end;

    end;
    Ini.UpdateFile;
  finally
    Ini.Free;
  end;
end;

procedure TFPConfDB.SaveToFile;
begin
  SaveEngine(FEnginePath, FEngineList);
  SaveForum(FForumPath, FForumList);
  SaveBook(FBookPath, FBookmarkList);
end;

//==============================================================================

function TFPConfDB.TegsFilter(const Tegs:TTegsArray): TStrings;
var
  ar:array [0..1] of array of SmallInt;

//------------------------------------------------------------------------------

  function NormEngine(index:integer):smallInt;
  begin
    if Index<0 then
    begin
      Result:=-1;
      exit;
    end;
    if ar[0,index]=-1 then
      if  FEngineList[index].Tegs.TegsInList(tegs[2,0])
      and FEngineList[index].Tegs.NotTegsinList(tegs[2,1])
      then
        ar[0,index]:=1
      else
        ar[0,index]:=0;
    result:=ar[0,index];
  end;

//------------------------------------------------------------------------------

  function NormForum(index:integer):SmallInt;
  begin
    if Index<0 then
    begin
      Result:=-1;
      exit;
    end;

    if ar[1,index]=-1 then
      if  (NormEngine(FEngineList.IndexOf(FForumList[index].EngineName))=1)
      and FForumList[index].Tegs.TegsInList(tegs[1,0])
      and FForumList[index].Tegs.NotTegsinList(tegs[1,1])
      then
        ar[1,index]:=1
      else
        ar[1,index]:=0;
    result:=ar[1,index];
  end;

//------------------------------------------------------------------------------

  function NormBook(index:integer):boolean;
  begin
    result:= (NormForum(FForumList.IndexOfFromURI(FBookmarkList[index].URI))=1)
      and FBookmarkList[index].Tegs.TegsInList(tegs[0,0])
      and FBookmarkList[index].Tegs.NotTegsinList(Tegs[0,1]);
  end;

//------------------------------------------------------------------------------

var
  I: Integer;
begin
  SetLength(ar[0],FEngineList.Count);
  SetLength(ar[1],FForumList.Count);
  for I := 0 to FEngineList.Count -1 do
    ar[0,i]:=-1;
  for I := 0 to FForumList.Count -1 do
    ar[1,i]:=-1;

  if Assigned(FStrings) then
    FStrings.Clear
  else
    FStrings:=TStringList.Create;
  Result:=FStrings;

  for I := 0 to FBookmarkList.Count -1 do
    if NormBook(i) then
      Result.Add(FBookmarkList[i].URI);

end;

{ TFPRequest }

procedure TFPRequest.AddToList(const NewConf: TRqtParam);
begin
  fRqtList.Add(NewConf);
end;

procedure TFPRequest.CheckWorkEnd;
begin
  if (FThreads=0) and (not FLookNewRequest) and Assigned(OnWorkEnd) then
    OnWorkEnd(self);
end;

procedure TFPRequest.ClearList;
begin
  fRqtList.Clear;
end;

constructor TFPRequest.Create;
begin
  inherited;
  fTerminated:= True;
  fThreadsMax:=  20;
  FLogList:=TRqtThreadLogManager.Create;
  fRqtList:=TRqtParamList.Create;
end;

destructor TFPRequest.Destroy;
begin
  FLogList.Free;
  fRqtList.Free;
  inherited;
end;

procedure TFPRequest.DoRequest(Params: TRqtParamList);
var
  i: integer;
begin
  if Assigned(OnWorkBegin) then
    OnWorkBegin(Self,Params.Count);

  if fThreads<>0 then
    raise EFPThreadRuning.CreateFmt(SRqsErrThreadRuning,[fThreads]);

  fTerminated:=false;
  SetNullStatus(FCompitStatus);
  FNextThreadId:=0;
  FLogList.Clear;

  FLookNewRequest:=true;
  try
    if Params.Count = 0 then
      exit;

    for i := 0 to Params.Count-1 do
    begin
      with TFPRqtThread.Create(Params.Items[i],Self) do
      begin
        OnTerminate := ThreadDone;
        ThreadId:=FNextThreadId;
        Start;
      end;
      inc(fThreads);
      inc(FNextThreadId);

      while fThreads >= fThreadsMax do
      begin
        Application.ProcessMessages;
        if fTerminated then
          Exit;
      end;
      Application.ProcessMessages;
      if fTerminated then
        Exit;
    end;
  finally
    FLookNewRequest:=false;
    CheckWorkEnd;
  end;
end;

function TFPRequest.GetThreadLogAdd: TThreadNotifiEvent;
begin
  Result:= FLogList.OnNotify;
end;

function TFPRequest.ListCount: integer;
begin
  Result:=fRqtList.Count;
end;

class procedure TFPRequest.SetNullStatus(var Status: TRqtStatusConteyner);
begin
  with Status do
  begin
    Error:=0;
    Done:=0;
    Terminated:=0;
    fElse:=0;
    Summ:=0;
  end;
end;

procedure TFPRequest.SetThreadLogAdd(
  const Value: TThreadNotifiEvent);
begin
  FLogList.OnNotify:=Value;
end;

procedure TFPRequest.ThreadDone(Sender: TObject);
begin
  case TFPRqtThread(Sender).HighLogType of
    itError:      Inc(FCompitStatus.Error);
    itWarning:    Inc(FCompitStatus.Warring);
    itTerminated: Inc(FCompitStatus.Terminated);
    itDone:       Inc(FCompitStatus.Done);
    else          Inc(FCompitStatus.fElse);
  end;
  inc(FCompitStatus.Summ);
  Dec(FThreads);
  if Assigned(OnWork) then
    OnWork(Self,FCompitStatus);
  CheckWorkEnd;
end;

procedure TFPRequest.Posting;
begin
  DoRequest(fRqtList);
end;

procedure TFPRequest.Terminate;
begin
  fTerminated := True;
end;

{ TFPAllInOne }

constructor TFPAllInOne.Create;
begin
  inherited;
  FRequest := TFPRequest.Create;
  FDBList := TFPConfDB.Create;
end;

destructor TFPAllInOne.Destroy;
begin
  FRequest.Free;
  FDBList.Free;
  inherited;
end;

{ TTegsList }

procedure TTegsList.Add(const Teg: string);
begin
  if (Teg<>'') and (not TegInList(Teg)) then
    FTegsList.Add(Trim(Teg));
end;

procedure TTegsList.Add(const Tegs: TTegsList);
var
  i: integer;
begin
  for i := 0 to Tegs.Count - 1 do
    Add(Tegs.TegsList.Strings[i]);
end;

procedure TTegsList.Clear;
begin
  FTegsList.Clear;
end;

constructor TTegsList.Create(Sorted:boolean=true);
begin
  inherited Create;
  FTegsList := TStringList.Create;
  FTegsList.Duplicates:=dupIgnore;
  FTegsList.CaseSensitive:=False;
  FTegsList.Sorted:=true;
end;

procedure TTegsList.DeleteTegs(const Tegs: TTegsList);
var
  i: Integer;
begin
  for i := 0 to Tegs.Count-1 do
    if FTegsList.IndexOf(Tegs.TegsList.Strings[i])<>-1 then
      FTegsList.Delete(FTegsList.IndexOf(Tegs.TegsList.Strings[i]));
end;

procedure TTegsList.DeleteTegs(const Tegs: String);
var
  fTegs:TTegsList;
begin
  fTegs:=TTegsList.Create;
  try
    fTegs.TegsStr:=Tegs;
    DeleteTegs(fTegs);
  finally
    fTegs.Free;
  end;
end;

destructor TTegsList.Destroy;
begin
  FTegsList.Free;
  inherited;
end;

function TTegsList.GetCount: integer;
begin
  Result:=FTegsList.Count;
end;

function TTegsList.GetTegs: string;
var
  i: integer;
begin
  result := '';
  for i := 0 to FTegsList.Count - 1 do
    result := result + FTegsList.Strings[i] + ', ';
  if Length(result)>2 then
    Delete(result, Length(result) - 1, 2);
end;

function TTegsList.NotTegsinList(Tegs: TTegsList): boolean;
var
  i: integer;
begin
  for i := 0 to FTegsList.Count - 1 do
    if (FTegsList.Strings[i]<>'')
      and Tegs.TegInList(FTegsList.Strings[i])
    then
    begin
      result := False;
      Exit;
    end;
  result := True;
end;

procedure TTegsList.SetTegs(const Value: string);
var
  Start, P: PChar;
  s: String;
begin
  FTegsList.Clear;
  P := Pointer(Value);
  if P <> nil then
    while P^ <> #0 do
    begin
      Start := P;
      while not CharInSet(P^, [#0, #44]) do
        inc(P);
      SetString(s, Start, P - Start);
      Add(s);
      if P^ = #44 then
        inc(P);
      if P^ = #32 then
        inc(P);
    end;
end;

function TTegsList.TegInList(const Tegs: string): boolean;
begin
  result := FTegsList.IndexOf(Trim(Tegs)) > -1;
end;

function TTegsList.TegsInList(Tegs: TTegsList): boolean;
var
  i: integer;
begin
  for i := 0 to Tegs.TegsList.Count - 1 do
    if (Tegs.TegsList.Strings[i]<>'')
      and (not TegInList(Tegs.TegsList.Strings[i]))
    then
    begin
      result := False;
      Exit;
    end;
  result := True;
end;

{ TFPRequest.TFPRqtThread }

procedure TFPRequest.TFPRqtThread.AddToLog(const Item: string;
  ItemType: TRqtThreadLogItemType);
var
  buff:TRqtThreadLogConteyner;
begin
  buff.Item:=Item;
  buff.ItemType:=ItemType;
  buff.Time:=Time;
  buff.ThreadId:=FThreadId;
  Synchronize(procedure
  begin
    FManager.LogList.Add(buff)
  end);

  if ItemType<FHighLogType then
    FHighLogType:=ItemType;
end;

constructor TFPRequest.TFPRqtThread.Create(const Param: TRqtParam; Manager: TFPRequest);
begin
  inherited Create(true);
  FParams:=Param;
  FManager:=Manager;
  FHighLogType:=itNone;
end;

destructor TFPRequest.TFPRqtThread.Destroy;
begin
  inherited;
end;

procedure TFPRequest.TFPRqtThread.DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; const URL: OleVariant);
begin
  FStatus:=stCompited;
end;

procedure TFPRequest.TFPRqtThread.Execute;

  function SetValForm(WebBrowser: TWebBrowser; FieldName: string;
    Value: string): boolean;
  var
    i, j: integer;
    FormItem: Variant;
  begin
    result := False;
    // Формы нет
    if WebBrowser.OleObject.Document.all.tags('FORM').Length = 0 then
    begin
      Exit;
    end;
    // Форм в документе
    for i := 0 to WebBrowser.OleObject.Document.Forms.Length - 1 do
    begin
      FormItem := WebBrowser.OleObject.Document.Forms.Item(i);
      for j := 0 to FormItem.Length - 1 do
      begin
        try
          // если найденно изменить.
          if FormItem.Item(j).Name = FieldName then
          begin
            FormItem.Item(j).Value := Value;
            result := True;
          end;
        except
          Exit;
        end;
      end;
    end;
  end;

  // Узнаем значение
  function GetValForm(WebBrowser: TWebBrowser; FieldName: string): String;
  var
    i, j: integer;
    FormItem: Variant;
  begin
    if WebBrowser.OleObject.Document.all.tags('FORM').Length = 0 then
    begin
      Exit;
    end;
    for i := 0 to WebBrowser.OleObject.Document.Forms.Length - 1 do
    begin
      FormItem := WebBrowser.OleObject.Document.Forms.Item(i);
      for j := 0 to FormItem.Length - 1 do
      begin
        try
          if FormItem.Item(j).Name = FieldName then
          begin
            FormItem.Item(j).Click;
            result := FormItem.Item(j).Value;
          end;
        except
          Exit;
        end;
      end;
    end;
  end;

  // Нажатие
  function ClickForm(WebBrowser: TWebBrowser; FieldName: string): boolean;
  var
    i, j: integer;
    FormItem: Variant;
  begin
    result := False;
    // Нет формы в документе
    if WebBrowser.OleObject.Document.all.tags('FORM').Length = 0 then
    begin
      Exit;
    end;
    // Найдена форма в документе
    for i := 0 to WebBrowser.OleObject.Document.Forms.Length - 1 do
    begin
      FormItem := WebBrowser.OleObject.Document.Forms.Item(i);
      for j := 0 to FormItem.Length - 1 do
      begin
        try
          // when the fieldname is found, try to fill out
          if FormItem.Item(j).Value = FieldName then //
          begin
            FormItem.Item(j).Click;
            result := True;
          end;
        except
          Exit;
        end;
      end;
    end;
  end;



var
  Browser:TWebBrowser;
  I: Integer;
  J: Integer;
begin
  inherited;
  CoInitialize(nil);
  Browser:=TWebBrowser.Create(nil);
  try
    Browser.OnDocumentComplete:=DocumentComplete;
    Browser.OnNavigateError:=NavigateError;

    AddToLog(Format(SRqsMsgThreadStart,[FParams[1].URI]),itEvent);

    for I := Low(FParams) to High(FParams) do
      with FParams[i] do
      begin
        FStatus:=stWait;
        Browser.Navigate(URI);
        while FStatus=stWait do
        begin
          Application.ProcessMessages;
          sleep(100);
          if (Terminated or FManager.fTerminated) then
          begin
            AddToLog(Format(SRqsErrThreadTerminated, [URI]),itTerminated);
            exit;
          end;
        end;

        if FStatus=stError then
          Exit;

        for J := Low(Prm) to High(Prm) do
          if not SetValForm(Browser,Prm[j,0],Prm[j,1]) then
          begin
            AddToLog(Format(SRqsErrSetVal,[Prm[j,0],URI]), itError);
            Exit;
          end;
      end;
  finally
    Browser.Free;
    AddToLog(Format(SRqsMsgThreadComplited,[FParams[1].URI]),itDone);
  end;
end;

procedure TFPRequest.TFPRqtThread.NavigateError(ASender: TObject; const pDisp: IDispatch;
  const URL: OleVariant; const Frame: OleVariant; const StatusCode: OleVariant;
  var Cancel: WordBool);
begin
  AddToLog(Format(SRqsErrNavigateError,[URL,integer(StatusCode)]),itError);
  FStatus:=stError;
end;

procedure TFPRequest.TFPRqtThread.SetHighLogType(
  const Value: TRqtThreadLogItemType);
begin
  FHighLogType := Value;
end;

{ TConfList<T> }

function TCustomConfList<T>.Add(const Value: T): Integer;
begin
  if not BinarySearch(Value,Result) then
    Insert(Result,Value)
  else
    Exit(arIdentExists);
  Modified:=true;
end;

procedure TCustomConfList<T>.AddRange(const Values: array of T);
var
  I: Integer;
begin
  for I := 0 to High(Values) do
    Add(Values[i]);
end;

procedure TCustomConfList<T>.AddRange(const Values: array of T;
  out Logs: TArray<Integer>);
var
  I, tmp: Integer;
begin
  SetLength(Logs, Length(Values));
  for I := 0 to High(Values) do
    Logs[i]:= Add(Values[i]);
end;

procedure TCustomConfList<T>.Clear;
begin
  inherited;
  Modified:=true;
end;

procedure TCustomConfList<T>.Delete(Index: Integer);
begin
  inherited;
  Modified:=true;
end;

function TCustomConfList<T>.IndexOf(const Value: T): Integer;
begin
  if not BinarySearch(Value,Result) then
    Result:=-1
end;

{ TEngineConfList }

function TEngineConfList.Add(const Value: TEngineConf): Integer;
var
  AValue:TEngineConf;
begin
  if Value.Name='' then
    raise EFPException.CreateFmt(RSBadIdent,[Value.Name]);
  if not Assigned(Value.Tegs) then
  begin
    AValue:=Value;
    AValue.Tegs := TTegsList.Create;
    Result:= inherited Add(AValue);
  end
  else
    Result:= inherited;
end;

function TEngineConfList.Comparison(const Left, Right: TEngineConf): Integer;
begin
  if Left.Name > Right.Name then
    Result:=1
  else
    if Left.Name < Right.Name then
      Result:=-1
    else
      Result:=0;
end;

function TEngineConfList.Contains(const Name: string): Boolean;
begin
  Result:=IndexOf(Name) >= 0;
end;

constructor TEngineConfList.Create;
begin
  inherited Create(TComparer<TEngineConf>.Construct(Comparison));
end;

procedure TEngineConfList.Delete(const Name: string);
begin
  Delete(IndexOf(Name));
end;

function TEngineConfList.GetItems(Name: string): TEngineConf;
var
  i:integer;
begin
  i:=IndexOf(Name);
  if i=-1 then
    EFPExcpValue.Create(SErrAdd);
  Result:=Items[i];
end;

function TEngineConfList.IndexOf(const Name: string): integer;
var
  tmp:TEngineConf;
begin
  tmp.Name:=Name;
  if not BinarySearch(tmp,Result) then
    Result:=-1;
end;

function TEngineConfList.ListOfNames: string;
var
  I:integer;
begin
  Result:='';
  for i := 0 to Count-1 do
    Result:=Result + Items[i].Name + #10;
end;

procedure TEngineConfList.SetItems(Name: string; const Value: TEngineConf);
begin
  Delete(Name);
  Add(Value);
end;

function TEngineConfList.GetTegsList: TTegsList;
var
  I: Integer;
begin
  if Assigned(FTegsList) then
    FTegsList.Clear
  else
    FTegsList:=TTegsList.Create;

  for I := 0 to Count-1 do
    FTegsList.Add(Items[i].Tegs);
  Result:=FTegsList;
end;

{ TForumConfList }

function TForumConfList.Add(const Value: TForumConf): Integer;
var
  AValue:TForumConf;
begin
  if Value.Name='' then
    raise EFPException.CreateFmt(RSBadIdent,[Value.Name]);
  if ContainsFromURI(Value.LogURI) then
    Exit(arSubIdentExists);

  if not Assigned(Value.Tegs) then
  begin
    AValue:=Value;
    AValue.Tegs := TTegsList.Create;
    Result:= Inherited Add(AValue);
  end
  else
    Result:= inherited;
end;

function TForumConfList.Comparison(const Left, Right: TForumConf): Integer;
begin
  if Left.Name > Right.Name then
    Result:=1
  else
    if Left.Name < Right.Name then
      Result:=-1
    else
      Result:=0;
end;

function TForumConfList.ComparisonDomain(const Left,
  Right: TDomainRec): integer;
begin
  if Left.Key > Right.Key then
    Result:=1
  else
    if Left.Key < Right.Key then
      Result:=-1
    else
      Result:=0;
end;

function TForumConfList.Contains(const Name: string): Boolean;
begin
  Result:=IndexOf(Name) >= 0;
end;

function TForumConfList.ContainsFromURI(const URI: string): boolean;
begin
  Result:=IndexOfFromURI(URI) >= 0;
end;

constructor TForumConfList.Create;
begin
  inherited Create(TComparer<TForumConf>.Construct(Comparison));
  FDomainComparer:=TComparer<TDomainRec>.Construct(ComparisonDomain);
end;

procedure TForumConfList.Delete(const Name: string);
begin
  Delete(IndexOf(Name));
end;

function TForumConfList.GetItems(Name: string): TForumConf;
var
  i:integer;
begin
  i:=IndexOf(Name);
  if i=-1 then
    EFPExcpValue.Create(SErrAdd);
  Result:=Items[i];
end;

function TForumConfList.GetTegsList: TTegsList;
var
  I: Integer;
begin
  if Assigned(FTegsList) then
    FTegsList.Clear
  else
    FTegsList:=TTegsList.Create;

  for I := 0 to Count-1 do
    FTegsList.Add(Items[i].Tegs);
  Result:=FTegsList;
end;

function TForumConfList.GetURIItems(URI: string): TForumConf;
begin
  Result:=Items[IndexOfFromURI(URI)];
end;

function TForumConfList.IndexOf(const Name: string): integer;
var
  tmp:TForumConf;
begin
  tmp.Name:=Name;
  if not BinarySearch(tmp,Result) then
    Result:=-1;
end;

function TForumConfList.IndexOfFromURI(const URI: string): integer;
begin
  MakeDomainArray;
  if not TArray.BinarySearch<TDomainRec>(FDomainArray,
        TDomainRec.Create(GetDomain(URI),-1),
        Result, FDomainComparer)
  then
    Result:=-1
  else
    Result:=FDomainArray[Result].Value;
end;

function TForumConfList.ListOfNames: string;
var
  I:integer;
begin
  Result:='';
  for i := 0 to Count-1 do
    Result:=Result + Items[i].Name + #10;
end;


function TForumConfList.ListOfURI: string;
var
  I: Integer;
begin
  Result:='';
  for I := 0 to Count-1 do
    Result:=Result+Items[i].LogURI+#10;
end;

procedure TForumConfList.MakeDomainArray;
var
  I: Integer;
begin
  if FModified then
  begin
    FModified:=false;
    SetLength(FDomainArray,Count);
    for I := 0 to Count-1 do
    begin
      FDomainArray[i].Key:=GetDomain(Items[i].LogURI);
      FDomainArray[i].Value:=i;
    end;
    TArray.Sort<TDomainRec>(FDomainArray,FDomainComparer);
  end;
end;

procedure TForumConfList.SetItems(Name: string; const Value: TForumConf);
begin
  Delete(Name);
  Add(Value);
end;

procedure TForumConfList.SetURIItems(URI: string; const Value: TForumConf);
begin
  Items[IndexOfFromURI(URI)]:=Value;
end;

{ TBookConfList }

function TBookmarkConfList.Add(const Value: TBookmarkConf): Integer;
var
  AValue:TBookmarkConf;
begin
//  if Value.URI='' then
//    raise EFPException.CreateFmt(RSBadIdent,[Value.URI]);
  if not Assigned(Value.Tegs) then
  begin
    AValue:=Value;
    AValue.Tegs := TTegsList.Create;
    Result:= inherited Add(AValue);
  end
  else
    Result:= inherited;
end;

function TBookmarkConfList.Comparison(const Left, Right: TBookmarkConf): Integer;
begin
  if Left.URI > Right.URI then
    Result:=1
  else
    if Left.URI < Right.URI then
      Result:=-1
    else
      Result:=0;
end;

function TBookmarkConfList.Contains(const URI: string): Boolean;
begin
  Result:= IndexOf(URI) >= 0;
end;

constructor TBookmarkConfList.Create;
begin
  inherited Create(TComparer<TBookmarkConf>.Construct(Comparison));
end;

procedure TBookmarkConfList.Delete(const URI: string);
begin
  Delete(IndexOf(URI));
end;

function TBookmarkConfList.GetItems(URI: string): TBookmarkConf;
var
  i:integer;
begin
  i:=IndexOf(URI);
  if i=-1 then
    EFPExcpValue.Create(SErrAdd);
  Result:=Items[i];
end;

function TBookmarkConfList.IndexOf(const URI: string): integer;
var
  tmp:TBookmarkConf;
begin
  tmp.URI:=URI;
  if not BinarySearch(tmp,Result) then
    Result:=-1;
end;

function TBookmarkConfList.ListOfURI: string;
var
  I:integer;
begin
  Result:='';
  for i := 0 to Count-1 do
    Result:=Result + Items[i].URI + #10;
end;

procedure TBookmarkConfList.SetItems(URI: string; const Value: TBookmarkConf);
begin
  Delete(URI);
  Add(Value);
end;

function TBookmarkConfList.GetTegsList: TTegsList;
var
  I: Integer;
begin
  if Assigned(FTegsList) then
    FTegsList.Clear
  else
    FTegsList:=TTegsList.Create;

  for I := 0 to Count-1 do
    FTegsList.Add(Items[i].Tegs);
  Result:=FTegsList;
end;

end.