source: tags/1.0.1/UAcronym.pas

unit UAcronym;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, Contnrs, XMLConf, XMLRead, XMLWrite, DOM, UXMLUtils,
  SpecializedList, fphttpclient, Dialogs, odbcconn, sqldb;

type
  TAcronymCategories = class;
  TAcronymMeanings = class;
  TAcronymDb = class;
  TImportSources = class;
  TImportFormats = class;

  TAcronymSource = class
    Name: string;
    URL: string;
  end;

  TAcronymSources = class(TObjectList)

  end;

  { TAcronym }

  TAcronym = class
    Db: TAcronymDb;
    Name: string;
    Meanings: TAcronymMeanings;
    procedure SaveToNode(Node: TDOMNode);
    procedure LoadFromNode(Node: TDOMNode);
    constructor Create;
    destructor Destroy; override;
  end;

  { TAcronyms }

  TAcronyms = class(TObjectList)
    Db: TAcronymDb;
    procedure SaveToNode(Node: TDOMNode);
    procedure LoadFromNode(Node: TDOMNode);
    function SearchByName(Name: string): TAcronym;
    function AddAcronym(Name: string): TAcronym;
  end;

  { TAcronymMeaning }

  TAcronymMeaning = class
    Id: Integer;
    Name: string;
    Description: string;
    Language: string;
    Acronym: TAcronym;
    Categories: TAcronymCategories;
    Source: TAcronymSource;
    procedure SaveToNode(Node: TDOMNode);
    procedure LoadFromNode(Node: TDOMNode);
    constructor Create;
    destructor Destroy; override;
  end;

  { TAcronymMeanings }

  TAcronymMeanings = class(TObjectList)
  public
    Acronym: TAcronym;
    procedure UpdateIds;
    procedure SaveToNode(Node: TDOMNode);
    procedure LoadFromNode(Node: TDOMNode);
    function SearchByName(Name: string): TAcronymMeaning;
    function AddMeaning(Name: string): TAcronymMeaning;
  end;

  { TAcronymCategory }

  TAcronymCategory = class
    Id: Integer;
    Name: string;
    AcronymMeanings: TAcronymMeanings;
    procedure SaveToNode(Node: TDOMNode);
    procedure LoadFromNode(Node: TDOMNode);
    constructor Create;
    destructor Destroy; override;
  end;

  { TAcronymCategories }

  TAcronymCategories = class(TObjectList)
    Db: TAcronymDb;
    procedure UpdateIds;
    procedure SaveToNode(Node: TDOMNode);
    procedure LoadFromNode(Node: TDOMNode);
    procedure SaveRefToNode(Node: TDOMNode);
    procedure LoadRefFromNode(Node: TDOMNode);
    function SearchByName(Name: string): TAcronymCategory;
    function SearchById(Id: Integer): TAcronymCategory;
    function AddContext(Name: string): TAcronymCategory;
    procedure AssignToStrings(Strings: TStrings);
    procedure AssignFromStrings(Strings: TStrings);
    function GetString: string;
  end;

  { TAcronymEntry }

  TAcronymEntry = class
    Name: string;
    Meaning: string;
    Description: string;
    Categories: TStringList;
    constructor Create;
    destructor Destroy; override;
  end;

  TImportPatternFlag = (ipfNone, ipfNewItem, ipfSkip);
  TImportVariable = (ivNone, ivAcronym, ivMeaning, ivDescription);

  { TImportPattern }

  TImportPattern = class
    StartString: string;
    EndString: string;
    Variable: TImportVariable;
    Flag: TImportPatternFlag;
    Repetition: Boolean;
    procedure Assign(Source: TImportPattern);
    procedure SaveToNode(Node: TDOMNode);
    procedure LoadFromNode(Node: TDOMNode);
  end;

  { TImportPatterns }

  TImportPatterns = class(TObjectList)
    procedure SaveToNode(Node: TDOMNode);
    procedure LoadFromNode(Node: TDOMNode);
  end;

  TImportFormatKind = (ifkParse, ifkMSAccess);

  { TImportFormat }

  TImportFormat = class
    Id: Integer;
    Name: string;
    Kind: TImportFormatKind;
    Block: TImportPattern;
    ItemPatterns: TImportPatterns;
    Formats: TImportFormats;
    procedure Assign(Source: TImportFormat);
    procedure SaveToNode(Node: TDOMNode);
    procedure LoadFromNode(Node: TDOMNode);
    constructor Create;
    destructor Destroy; override;
  end;

  { TImportFormats }

  TImportFormats = class(TObjectList)
    procedure UpdateIds;
    procedure SaveToNode(Node: TDOMNode);
    procedure LoadFromNode(Node: TDOMNode);
    function SearchByName(Name: string): TImportFormat;
    function SearchById(Id: Integer): TImportFormat;
  end;

  { TImportSource }

  TImportSource = class
  private
    procedure DoPassword(Sender: TObject; var RepeatRequest : Boolean);
  public
    Enabled: Boolean;
    Name: string;
    URL: string;
    Format: TImportFormat;
    LastTime: TDateTime;
    Sources: TImportSources;
    ItemCount: Integer;
    Categories: TAcronymCategories;
    function DownloadHTTP(URL: string; Stream: TStream): Boolean;
    procedure Process;
    procedure ProcessTextParse;
    procedure ProcessMSAccess;
    procedure Assign(Source: TImportSource);
    procedure SaveToNode(Node: TDOMNode);
    procedure LoadFromNode(Node: TDOMNode);
    constructor Create;
    destructor Destroy; override;
  end;

  { TImportSources }

  TImportSources = class(TObjectList)
    AcronymDb: TAcronymDb;
    function SearchByName(Name: string): TImportSource;
    procedure SaveToNode(Node: TDOMNode);
    procedure LoadFromNode(Node: TDOMNode);
  end;

  { TAcronymDb }

  TAcronymDb = class
    FileName: string;
    Sources: TAcronymSources;
    Acronyms: TAcronyms;
    Categories: TAcronymCategories;
    ImportSources: TImportSources;
    ImportFormats: TImportFormats;
    Modified: Boolean;
    constructor Create;
    destructor Destroy; override;
    procedure LoadFromFile(FileName: string);
    procedure SaveToFile(FileName: string);
    procedure LoadFromFileCSV(FileName: string);
    procedure SaveToFileCSV(FileName: string);
    procedure FilterList(AName: string; Items: TAcronymMeanings);
    function AddAcronym(AcronymName, MeaningName: string): TAcronymMeaning;
    procedure RemoveMeaning(Meaning: TAcronymMeaning);
    procedure RemoveAcronym(AcronymName, MeaningName: string);
    procedure AssignToList(List: TListObject);
  end;

function AcronymComparer(Item1, Item2: Pointer): Integer;

const
  ImportVariableString: array [TImportVariable] of string = ('None', 'Acronym',
    'Meaning', 'Description');
  ImportPatternFlagString: array [TImportPatternFlag] of string = ('None', 'New item',
    'Skip');


implementation

resourcestring
  SWrongFileFormat = 'Wrong file format';


function AcronymComparer(Item1, Item2: Pointer): Integer;
begin
  Result := CompareStr(TAcronym(Item1).Name, TAcronym(Item2).Name);
end;

{ TImportSourceMSAccess }

procedure TImportSource.ProcessMSAccess;
var
  ODBCConnection1: TODBCConnection;
  SQLTransaction1: TSQLTransaction;
  SQLQuery1: TSQLQuery;
  NewAcronym: TAcronymEntry;
begin
  ItemCount := 0;
  ODBCConnection1 := TODBCCOnnection.Create(nil);
  SQLQuery1 := TSQLQuery.Create(nil);
  SQLTransaction1 := TSQLTransaction.Create(nil);
  try
    ODBCConnection1.Driver := 'Microsoft Access Driver (*.mdb, *.accdb)';
    ODBCConnection1.Params.Add('DBQ=' + URL);
    ODBCConnection1.Params.Add('Locale Identifier=1031');
    ODBCConnection1.Params.Add('ExtendedAnsiSQL=1');
    ODBCConnection1.Params.Add('CHARSET=ansi');
    ODBCConnection1.Connected := True;
    ODBCConnection1.KeepConnection := True;

    SQLTransaction1.DataBase := ODBCConnection1;
    SQLTransaction1.Action := caCommit;
    SQLTransaction1.Active := True;

    SQLQuery1.DataBase := ODBCConnection1;
    SQLQuery1.UsePrimaryKeyAsKey := False;
    SQLQuery1.SQL.Text := 'SELECT Acronym,Meaning FROM data1';
    SQLQuery1.Open;

    NewAcronym := TAcronymEntry.Create;
    while not SQLQuery1.EOF do begin
      NewAcronym.Name := SQLQuery1.FieldByName('Acronym').AsString;
      NewAcronym.Meaning := SQLQuery1.FieldByName('Meaning').AsString;
      Sources.AcronymDb.AddAcronym(NewAcronym.Name, NewAcronym.Meaning);
      SQLQuery1.Next;
      Inc(ItemCount);
    end;
    NewAcronym.Free;
  finally
    SQLQuery1.Free;
    SQLTransaction1.Free;
    ODBCConnection1.Free;
  end;
end;

{ TImportPatterns }

procedure TImportPatterns.SaveToNode(Node: TDOMNode);
var
  I: Integer;
  NewNode2: TDOMNode;
begin
  for I := 0 to Count - 1 do
  with TImportPattern(Items[I]) do begin
    NewNode2 := Node.OwnerDocument.CreateElement('Pattern');
    Node.AppendChild(NewNode2);
    SaveToNode(NewNode2);
  end;
end;

procedure TImportPatterns.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  NewItem: TImportPattern;
begin
  Count := 0;
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = 'Pattern') do begin
    NewItem := TImportPattern.Create;
    NewItem.LoadFromNode(Node2);
    Add(NewItem);
    Node2 := Node2.NextSibling;
  end;
end;

{ TImportPattern }

procedure TImportPattern.Assign(Source: TImportPattern);
begin
  StartString := Source.StartString;
  EndString := Source.EndString;
  Variable := Source.Variable;
  Flag := Source.Flag;
  Repetition := Source.Repetition;
end;

procedure TImportPattern.SaveToNode(Node: TDOMNode);
begin
  WriteString(Node, 'StartString', StartString);
  WriteString(Node, 'EndString', EndString);
  WriteInteger(Node, 'Variable', Integer(Variable));
  WriteInteger(Node, 'Flag', Integer(Flag));
  WriteBoolean(Node, 'Repetition', Repetition);
end;

procedure TImportPattern.LoadFromNode(Node: TDOMNode);
begin
  StartString := ReadString(Node, 'StartString', '');
  EndString := ReadString(Node, 'EndString', '');
  Variable := TImportVariable(ReadInteger(Node, 'Variable', 0));
  Flag := TImportPatternFlag(ReadInteger(Node, 'Flag', 0));
  Repetition := ReadBoolean(Node, 'Repetition', False);
end;

procedure TImportSource.DoPassword(Sender: TObject; var RepeatRequest: Boolean);
begin
  if TFPHttpClient(Sender).Password = '' then begin
    TFPHttpClient(Sender).UserName := 'test';
    TFPHttpClient(Sender).Password := 'test';
    RepeatRequest := True;
  end else RepeatRequest := False;
end;

function TImportSource.DownloadHTTP(URL: string; Stream: TStream): Boolean;
var
  HTTPClient: TFPHTTPClient;
  FormData: TStringList;
begin
  HTTPClient := TFPHttpClient.Create(nil);
  HTTPClient.OnPassword := DoPassword;
  FormData := TStringList.Create;
(*
FormData.action=clientlogin
  &loginreturnurl=http://example.com/&
  logintoken=29590a3037d325be70b93fb8258ed29257448cfb%2B%5C&
  username=Bob&
  password=secret&
  rememberMe=1
  HTTPClient.FormPost(URL, FormData, Stream);
  *)
  HTTPClient.Get(URL, Stream);
  FormData.Free;
  HTTPClient.Free;
  Result := True;
end;

procedure TImportSource.Process;
begin
  case Format.Kind of
    ifkParse: ProcessTextParse;
    ifkMSAccess: ProcessMSAccess;
    else raise Exception.Create('Unsupported import format');
  end;
end;

function StripHTML(S: string): string;
var
  TagBegin, TagEnd, TagLength: Integer;
begin
  TagBegin := Pos( '<', S);      // search position of first <

  while (TagBegin > 0) do begin  // while there is a < in S
    TagEnd := Pos('>', S);              // find the matching >
    if TagEnd = 0 then TagLength := Length(S) - TagBegin
      else TagLength := TagEnd - TagBegin + 1;
    if TagLength > 0 then
      Delete(S, TagBegin, TagLength)     // delete the tag
      else Delete(S, 1, TagEnd);     // delete the tag
    TagBegin := Pos( '<', S);            // search for next <
  end;

  Result := S;                   // give the result
end;

{ TImportFormat }

procedure TImportFormat.Assign(Source: TImportFormat);
var
  I: Integer;
begin
  Kind := Source.Kind;
  Name := Source.Name;
  Block.StartString := Source.Block.StartString;
  Block.EndString := Source.Block.EndString;
  while ItemPatterns.Count < Source.ItemPatterns.Count do
    ItemPatterns.Add(TImportPattern.Create);
  if ItemPatterns.Count > Source.ItemPatterns.Count then
    ItemPatterns.Count := Source.ItemPatterns.Count;
  for I := 0 to ItemPatterns.Count - 1 do begin
    TImportPattern(ItemPatterns[I]).Assign(TImportPattern(Source.ItemPatterns[I]));
  end;
end;

procedure TImportFormat.SaveToNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  WriteInteger(Node, 'Id', Id);
  WriteString(Node, 'Name', Name);
  WriteInteger(Node, 'Kind', Integer(Kind));
  WriteString(Node, 'BlockStartString', Block.StartString);
  WriteString(Node, 'BlockEndString', Block.EndString);

  NewNode := Node.OwnerDocument.CreateElement('Patterns');
  Node.AppendChild(NewNode);
  ItemPatterns.SaveToNode(NewNode);
end;

procedure TImportFormat.LoadFromNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  Id := ReadInteger(Node, 'Id', 0);
  Name := ReadString(Node, 'Name', '');
  Kind := TImportFormatKind(ReadInteger(Node, 'Kind', 0));
  Block.StartString := ReadString(Node, 'BlockStartString', '');
  Block.EndString := ReadString(Node, 'BlockEndString', '');

  NewNode := Node.FindNode('Patterns');
  if Assigned(NewNode) then
    ItemPatterns.LoadFromNode(NewNode);
end;

constructor TImportFormat.Create;
begin
  Block := TImportPattern.Create;
  ItemPatterns := TImportPatterns.Create;
end;

destructor TImportFormat.Destroy;
begin
  Block.Free;
  ItemPatterns.Free;
  inherited Destroy;
end;

{ TImportSources }

function TImportSources.SearchByName(Name: string): TImportSource;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (TImportSource(Items[I]).Name <> Name) do Inc(I);
  if I < Count then Result := TImportSource(Items[I])
    else Result := nil;
end;

procedure TImportSources.SaveToNode(Node: TDOMNode);
var
  I: Integer;
  NewNode2: TDOMNode;
begin
  for I := 0 to Count - 1 do
  with TImportSource(Items[I]) do begin
    NewNode2 := Node.OwnerDocument.CreateElement('ImportSource');
    Node.AppendChild(NewNode2);
    SaveToNode(NewNode2);
  end;
end;

procedure TImportSources.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  NewItem: TImportSource;
begin
  Count := 0;
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = 'ImportSource') do begin
    NewItem := TImportSource.Create;
    NewItem.Sources := Self;
    NewItem.LoadFromNode(Node2);
    Add(NewItem);
    Node2 := Node2.NextSibling;
  end;
end;

{ TImportFormats }

function TImportFormats.SearchByName(Name: string): TImportFormat;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (TImportFormat(Items[I]).Name <> Name) do Inc(I);
  if I < Count then Result := TImportFormat(Items[I])
    else Result := nil;
end;

procedure TImportFormats.UpdateIds;
var
  LastId: Integer;
  I: Integer;
begin
  // Get highest used ID
  LastId := 0;
  for I := 0 to Count - 1 do begin
    if TImportFormat(Items[I]).Id > LastId then LastId := TImportFormat(Items[I]).Id;
  end;
  // Add ID to new items without ID
  for I := 0 to Count - 1 do begin
    if TImportFormat(Items[I]).Id = 0 then begin
      Inc(LastId);
      TImportFormat(Items[I]).Id := LastId;
    end;
  end;
end;

procedure TImportFormats.SaveToNode(Node: TDOMNode);
var
  I: Integer;
  NewNode2: TDOMNode;
begin
  UpdateIds;
  for I := 0 to Count - 1 do
  with TImportFormat(Items[I]) do begin
    NewNode2 := Node.OwnerDocument.CreateElement('ImportFormat');
    Node.AppendChild(NewNode2);
    SaveToNode(NewNode2);
  end;
end;

procedure TImportFormats.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  NewItem: TImportFormat;
begin
  Count := 0;
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = 'ImportFormat') do begin
    NewItem := TImportFormat.Create;
    NewItem.LoadFromNode(Node2);
    Add(NewItem);
    Node2 := Node2.NextSibling;
  end;
  UpdateIds;
end;

function TImportFormats.SearchById(Id: Integer): TImportFormat;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (TImportFormat(Items[I]).Id <> Id) do Inc(I);
  if I < Count then Result := TImportFormat(Items[I])
    else Result := nil;
end;

{ TImportSource }

procedure TImportSource.ProcessTextParse;
var
  Stream: TMemoryStream;
  S: string;
  SS: string;
  NewAcronym: TAcronymEntry;
  P: Integer;
  P1, P2: Integer;
  Q: Integer;
  I: Integer;
  T: string;
  LastLength: Integer;
  AddedAcronym: TAcronymMeaning;
begin
  ItemCount := 0;
  Stream := TMemoryStream.Create;
  NewAcronym := TAcronymEntry.Create;
  try
    if DownloadHTTP(URL, Stream) then begin
      Stream.Position := 0;
      SetLength(S, Stream.Size);
      Stream.Read(S[1], Length(S));

      // Find main block
      if Format.Block.StartString <> '' then begin
        P := Pos(Format.Block.StartString, S);
        if P > 0 then
          Delete(S, 1, P + Length(Format.Block.StartString) - 1);
      end;
      if Format.Block.EndString <> '' then begin
        P := Pos(Format.Block.EndString, S);
        if P > 0 then
          Delete(S, P, Length(S));
      end;

      // Remove unneeded items
      repeat
        LastLength := Length(S);
        for I := 0 to Format.ItemPatterns.Count - 1 do
        with TImportPattern(Format.ItemPatterns[I]) do
        if Flag = ipfSkip then begin
          P := Pos(StartString, S);
          if P > 0 then begin
            SS := Copy(S, P + Length(StartString), Length(S));
            Q := Pos(EndString, SS);
            if Q > 0 then begin
              Delete(S, P, Q + Length(EndString) + Length(StartString) - 1);
            end;
          end;
        end;
      until Length(S) = LastLength;

      // Find items
      repeat
        LastLength := Length(S);
        I := 0;
        while I < Format.ItemPatterns.Count do
        with TImportPattern(Format.ItemPatterns[I]) do begin
          if Flag <> ipfSkip then begin
            if Length(StartString) > 0 then begin
              P := Pos(StartString, S);
              if P > 0 then Delete(S, 1, P + Length(StartString) - 1);
            end;

            if ((Length(StartString) > 0) and (P > 0)) or (Length(StartString) = 0) then begin
              P := Pos(EndString, S);
              T := StripHTML(Copy(S, 1, P - 1));
              T := StringReplace(T, '&quot;', '"', [rfReplaceAll]);
              T := StringReplace(T, '&trade;', 'TM', [rfReplaceAll]);
              T := StringReplace(T, '&amp;', '&', [rfReplaceAll]);
              T := StringReplace(T, '&#160;', ' ', [rfReplaceAll]); // No break space
              T := Trim(T);
              case Variable of
                ivAcronym: NewAcronym.Name := T;
                ivMeaning: NewAcronym.Meaning := T;
                ivDescription: NewAcronym.Description := T;
              end;
              Delete(S, 1, P + Length(EndString) - 1);

              if (Flag = ipfNewItem) and (Trim(NewAcronym.Name) <> '') and
                (Trim(NewAcronym.Meaning) <> '') then begin
                  AddedAcronym := Sources.AcronymDb.AddAcronym(NewAcronym.Name, NewAcronym.Meaning);
                  AddedAcronym.Description := NewAcronym.Description;
                  AddedAcronym.Categories.Assign(Categories, laOr);
                  Inc(ItemCount);
                end;

              if Repetition then begin
                if Length(StartString) > 0 then begin
                  P1 := Pos(StartString, S);
                  if P1 > 0 then begin
                    P2 := Pos(TImportPattern(Format.ItemPatterns[(I + 1) mod Format.ItemPatterns.Count]).StartString, S);
                    if (P2 > 0) and (P1 < P2) then Continue;
                  end;
                end;
              end;
            end;
          end;
          Inc(I);
        end;
      until Length(S) = LastLength;
    end;
  finally
    NewAcronym.Free;
    Stream.Free;
  end;
end;

procedure TImportSource.Assign(Source: TImportSource);
begin
  Enabled := Source.Enabled;
  Name := Source.Name;
  URL := Source.URL;
  Format := Source.Format;
  LastTime := Source.LastTime;
  ItemCount := Source.ItemCount;
  Categories.Assign(Source.Categories);
end;

procedure TImportSource.SaveToNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  WriteString(Node, 'Name', Name);
  WriteString(Node, 'URL', URL);
  if Assigned(Format) then WriteInteger(Node, 'ImportFormat', Format.Id)
    else WriteInteger(Node, 'ImportFormat', -1);
  WriteBoolean(Node, 'Enabled', Enabled);
  WriteInteger(Node, 'ItemCount', ItemCount);

  NewNode := Node.OwnerDocument.CreateElement('Categories');
  Node.AppendChild(NewNode);
  Categories.SaveRefToNode(NewNode);
end;

procedure TImportSource.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
begin
  Name := ReadString(Node, 'Name', '');
  URL := ReadString(Node, 'URL', '');
  Format := Sources.AcronymDb.ImportFormats.SearchById(ReadInteger(Node, 'ImportFormat', -1));
  Enabled := ReadBoolean(Node, 'Enabled', True);
  ItemCount := ReadInteger(Node, 'ItemCount', 0);

  Categories.Db := Sources.AcronymDb;
  Node2 := Node.FindNode('Categories');
  if Assigned(Node2) then
    Categories.LoadRefFromNode(Node2);
end;

constructor TImportSource.Create;
begin
  Format := nil;
  Enabled := True;
  Categories := TAcronymCategories.Create;
  Categories.OwnsObjects := False;
end;

destructor TImportSource.Destroy;
begin
  FreeAndNil(Categories);
  inherited Destroy;
end;

{ TAcronymEntry }

constructor TAcronymEntry.Create;
begin
  Categories := TStringList.Create;
end;

destructor TAcronymEntry.Destroy;
begin
  FreeAndNil(Categories);
  inherited Destroy;
end;

{ TAcronymMeanings }

procedure TAcronymMeanings.UpdateIds;
var
  LastId: Integer;
  I: Integer;
begin
  // Get highest used ID
  LastId := 0;
  for I := 0 to Count - 1 do begin
    if TAcronymMeaning(Items[I]).Id > LastId then LastId := TAcronymMeaning(Items[I]).Id;
  end;
  // Add ID to new items without ID
  for I := 0 to Count - 1 do begin
    if TAcronymMeaning(Items[I]).Id = 0 then begin
      Inc(LastId);
      TAcronymMeaning(Items[I]).Id := LastId;
    end;
  end;
end;

procedure TAcronymMeanings.SaveToNode(Node: TDOMNode);
var
  I: Integer;
  NewNode2: TDOMNode;
begin
  UpdateIds;
  for I := 0 to Count - 1 do
  with TAcronymMeaning(Items[I]) do begin
    NewNode2 := Node.OwnerDocument.CreateElement('Meaning');
    Node.AppendChild(NewNode2);
    SaveToNode(NewNode2);
  end;
end;

procedure TAcronymMeanings.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  NewItem: TAcronymMeaning;
begin
  Count := 0;
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = 'Meaning') do begin
    NewItem := TAcronymMeaning.Create;
    NewItem.Acronym := Acronym;
    NewItem.LoadFromNode(Node2);
    Add(NewItem);
    Node2 := Node2.NextSibling;
  end;
  UpdateIds;
end;

function TAcronymMeanings.SearchByName(Name: string): TAcronymMeaning;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (TAcronymMeaning(Items[I]).Name <> Name) do Inc(I);
  if I < Count then Result := TAcronymMeaning(Items[I])
    else Result := nil;
end;

function TAcronymMeanings.AddMeaning(Name: string): TAcronymMeaning;
begin
  Result := TAcronymMeaning.Create;
  Result.Name := Name;
  Add(Result);
end;

{ TAcronymMeaning }

procedure TAcronymMeaning.SaveToNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  WriteString(Node, 'Name', Name);
  WriteString(Node, 'Description', Description);
  WriteString(Node, 'Language', Language);

  NewNode := Node.OwnerDocument.CreateElement('Categories');
  Node.AppendChild(NewNode);
  Categories.SaveRefToNode(NewNode);
end;

procedure TAcronymMeaning.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  I: Integer;
begin
  Name := ReadString(Node, 'Name', '');
  Description := ReadString(Node, 'Description', '');
  Language := ReadString(Node, 'Language', '');

  Categories.Db := Acronym.Db;
  Node2 := Node.FindNode('Categories');
  if Assigned(Node2) then begin
    Categories.LoadRefFromNode(Node2);

    // Add reverse references
    for I := 0 to Categories.Count - 1 do
      TAcronymCategory(Categories[I]).AcronymMeanings.Add(Self);
  end;
end;

constructor TAcronymMeaning.Create;
begin
  Categories := TAcronymCategories.Create(False);
end;

destructor TAcronymMeaning.Destroy;
var
  I: Integer;
begin
  for I := 0 to Categories.Count - 1 do
    TAcronymCategory(Categories[I]).AcronymMeanings.Remove(Self);
  FreeAndNil(Categories);
  inherited Destroy;
end;

{ TAcronyms }

procedure TAcronyms.SaveToNode(Node: TDOMNode);
var
  I: Integer;
  NewNode2: TDOMNode;
begin
  for I := 0 to Count - 1 do
  with TAcronym(Items[I]) do begin
    NewNode2 := Node.OwnerDocument.CreateElement('Acronym');
    Node.AppendChild(NewNode2);
    SaveToNode(NewNode2);
  end;
end;

procedure TAcronyms.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  NewItem: TAcronym;
begin
  Count := 0;
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = 'Acronym') do begin
    NewItem := TAcronym.Create;
    NewItem.Db := Db;
    NewItem.LoadFromNode(Node2);
    Add(NewItem);
    Node2 := Node2.NextSibling;
  end;
end;

function TAcronyms.SearchByName(Name: string): TAcronym;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (TAcronym(Items[I]).Name <> Name) do Inc(I);
  if I < Count then Result := TAcronym(Items[I])
    else Result := nil;
end;

function TAcronyms.AddAcronym(Name: string): TAcronym;
begin
  Result := TAcronym.Create;
  Result.Name := Name;
  Add(Result);
end;

{ TAcronymCategories }

procedure TAcronymCategories.UpdateIds;
var
  LastId: Integer;
  I: Integer;
begin
  // Get highest used ID
  LastId := 0;
  for I := 0 to Count - 1 do begin
    if TAcronymCategory(Items[I]).Id > LastId then LastId := TAcronymCategory(Items[I]).Id;
  end;
  // Add ID to new items without ID
  for I := 0 to Count - 1 do begin
    if TAcronymCategory(Items[I]).Id = 0 then begin
      Inc(LastId);
      TAcronymCategory(Items[I]).Id := LastId;
    end;
  end;
end;

procedure TAcronymCategories.SaveToNode(Node: TDOMNode);
var
  I: Integer;
  NewNode2: TDOMNode;
begin
  UpdateIds;
  for I := 0 to Count - 1 do
  with TAcronymCategory(Items[I]) do begin
    NewNode2 := Node.OwnerDocument.CreateElement('Category');
    Node.AppendChild(NewNode2);
    SaveToNode(NewNode2);
  end;
end;

procedure TAcronymCategories.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  NewItem: TAcronymCategory;
begin
  Count := 0;
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = 'Category') do begin
    NewItem := TAcronymCategory.Create;
    NewItem.LoadFromNode(Node2);
    Add(NewItem);
    Node2 := Node2.NextSibling;
  end;
  UpdateIds;
end;

procedure TAcronymCategories.SaveRefToNode(Node: TDOMNode);
var
  I: Integer;
  NewNode: TDOMNode;
begin
  for I := 0 to Count - 1 do begin
    NewNode := Node.OwnerDocument.CreateElement('Category');
    Node.AppendChild(NewNode);
    WriteInteger(NewNode, 'Id', TAcronymCategory(Items[I]).Id);
  end;
end;

procedure TAcronymCategories.LoadRefFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  Id: Integer;
  Category: TAcronymCategory;
begin
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = 'Category') do begin
    Id := ReadInteger(Node2, 'Id', 0);
    Category := Db.Categories.SearchById(Id);
    if Assigned(Category) then begin
      Add(Category);
    end;
    Node2 := Node2.NextSibling;
  end;
end;

function TAcronymCategories.SearchByName(Name: string): TAcronymCategory;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (TAcronymCategory(Items[I]).Name <> Name) do Inc(I);
  if I < Count then Result := TAcronymCategory(Items[I])
    else Result := nil;
end;

function TAcronymCategories.SearchById(Id: Integer): TAcronymCategory;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (TAcronymCategory(Items[I]).Id <> Id) do Inc(I);
  if I < Count then Result := TAcronymCategory(Items[I])
    else Result := nil;
end;

function TAcronymCategories.AddContext(Name: string): TAcronymCategory;
begin
  Result := TAcronymCategory.Create;
  Result.Name := Name;
  Add(Result);
end;

procedure TAcronymCategories.AssignToStrings(Strings: TStrings);
var
  I: Integer;
begin
  Strings.Clear;
  for I := 0 to Count - 1 do
    Strings.AddObject(TAcronymCategory(Items[I]).Name, Items[I]);
end;

procedure TAcronymCategories.AssignFromStrings(Strings: TStrings);
var
  I: Integer;
begin
  Clear;
  for I := 0 to Strings.Count - 1 do begin
    Add(TAcronymCategory(Strings.Objects[I]));
  end;
end;

function TAcronymCategories.GetString: string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to Count - 1 do
    Result := Result + TAcronymCategory(Items[I]).Name + ',';
  System.Delete(Result, Length(Result), 1);
end;


{ TAcronym }

procedure TAcronym.SaveToNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  WriteString(Node, 'Name', Name);

  NewNode := Node.OwnerDocument.CreateElement('Meanings');
  Node.AppendChild(NewNode);
  Meanings.SaveToNode(NewNode);
end;

procedure TAcronym.LoadFromNode(Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  Name := ReadString(Node, 'Name', '');

  NewNode := Node.FindNode('Meanings');
  if Assigned(NewNode) then
    Meanings.LoadFromNode(NewNode);
end;

constructor TAcronym.Create;
begin
  Meanings := TAcronymMeanings.Create;
  Meanings.Acronym := Self;
end;

destructor TAcronym.Destroy;
begin
  FreeAndNil(Meanings);
  inherited Destroy;
end;

{ TAcronymCategory }

procedure TAcronymCategory.SaveToNode(Node: TDOMNode);
begin
  WriteString(Node, 'Name', Name);
  WriteInteger(Node, 'Id', Id);
end;

procedure TAcronymCategory.LoadFromNode(Node: TDOMNode);
begin
  Name := ReadString(Node, 'Name', '');
  Id := ReadInteger(Node, 'Id', 0);
end;

constructor TAcronymCategory.Create;
begin
  AcronymMeanings := TAcronymMeanings.Create(False);
end;

destructor TAcronymCategory.Destroy;
var
  I: Integer;
begin
  for I := 0 to AcronymMeanings.Count - 1 do
    TAcronymMeaning(AcronymMeanings[I]).Categories.Remove(Self);
  FreeAndNil(AcronymMeanings);
  inherited Destroy;
end;

{ TAcronymDb }

constructor TAcronymDb.Create;
begin
  Sources := TAcronymSources.Create;
  Acronyms := TAcronyms.Create;
  Acronyms.Db := Self;
  Categories := TAcronymCategories.Create;
  ImportSources := TImportSources.Create;
  ImportSources.AcronymDb := Self;
  ImportFormats := TImportFormats.Create;
end;

destructor TAcronymDb.Destroy;
begin
  FreeAndNil(ImportFormats);
  FreeAndNil(ImportSources);
  FreeAndNil(Sources);
  FreeAndNil(Acronyms);
  FreeAndNil(Categories);
  inherited Destroy;
end;

procedure TAcronymDb.LoadFromFile(FileName: string);
var
  NewNode: TDOMNode;
  Doc: TXMLDocument;
  RootNode: TDOMNode;
begin
  if ExtractFileExt(FileName) = '.csv' then begin
    LoadFromFileCSV(FileName);
    Exit;
  end;
  Self.FileName := FileName;
  ReadXMLFile(Doc, FileName);
  with Doc do try
    if Doc.DocumentElement.NodeName <> 'AcronymDecoderProject' then
      raise Exception.Create(SWrongFileFormat);
    RootNode := Doc.DocumentElement;
    with RootNode do begin
      NewNode := FindNode('Categories');
      if Assigned(NewNode) then
        Categories.LoadFromNode(NewNode);

      // Load acronyms after categories because of references
      NewNode := FindNode('Acronyms');
      if Assigned(NewNode) then
        Acronyms.LoadFromNode(NewNode);

      NewNode := FindNode('ImportFormats');
      if Assigned(NewNode) then
        ImportFormats.LoadFromNode(NewNode);

      NewNode := FindNode('ImportSources');
      if Assigned(NewNode) then
        ImportSources.LoadFromNode(NewNode);
    end;
  finally
    Doc.Free;
  end;
end;

procedure TAcronymDb.SaveToFile(FileName: string);
var
  NewNode: TDOMNode;
  Doc: TXMLDocument;
  RootNode: TDOMNode;
begin
  if ExtractFileExt(FileName) = '.csv' then begin
    SaveToFileCSV(FileName);
    Exit;
  end;
  Self.FileName := FileName;
  Doc := TXMLDocument.Create;
  with Doc do try
    RootNode := CreateElement('AcronymDecoderProject');
    AppendChild(RootNode);
    with RootNode do begin
      NewNode := OwnerDocument.CreateElement('Categories');
      AppendChild(NewNode);
      Categories.SaveToNode(NewNode);

      // Save acronyms after categories because of references
      NewNode := OwnerDocument.CreateElement('Acronyms');
      AppendChild(NewNode);
      Acronyms.SaveToNode(NewNode);

      NewNode := OwnerDocument.CreateElement('ImportFormats');
      AppendChild(NewNode);
      ImportFormats.SaveToNode(NewNode);

      NewNode := OwnerDocument.CreateElement('ImportSources');
      AppendChild(NewNode);
      ImportSources.SaveToNode(NewNode);
    end;
    ForceDirectories(ExtractFileDir(FileName));
    WriteXMLFile(Doc, FileName);
  finally
    Doc.Free;
  end;
  Modified := False;
end;

procedure TAcronymDb.LoadFromFileCSV(FileName: string);
var
  F: TStringList;
  Line: TStringList;
  CategoryStrings: TStringList;
  NewAcronym: TAcronym;
  NewMeaning: TAcronymMeaning;
  I: Integer;
  J: Integer;
  AcronymCategory: TAcronymCategory;
begin
  Self.FileName := FileName;
  Acronyms.Clear;
  F := TStringList.Create;
  Line := TStringList.Create;
  Line.StrictDelimiter := True;
  CategoryStrings := TStringList.Create;
  CategoryStrings.Delimiter := ';';
  try
    F.LoadFromFile(FileName);
    for I := 0 to F.Count - 1 do begin
      Line.CommaText := F[I];
      NewAcronym := Acronyms.SearchByName(Line[0]);
      if not Assigned(NewAcronym) then begin
        NewAcronym := TAcronym.Create;
        NewAcronym.Name := Line[0];
        Acronyms.Add(NewAcronym);
      end;
      NewMeaning := NewAcronym.Meanings.SearchByName(Line[1]);
      if not Assigned(NewMeaning) then begin
        NewMeaning := TAcronymMeaning.Create;
        NewMeaning.Name := Line[1];
        NewMeaning.Acronym := NewAcronym;
        NewAcronym.Meanings.Add(NewMeaning);
      end;
      CategoryStrings.DelimitedText := Line[2];
      for J := 0 to CategoryStrings.Count - 1 do begin
        AcronymCategory := Categories.SearchByName(CategoryStrings[J]);
        if not Assigned(AcronymCategory) then begin
          AcronymCategory := TAcronymCategory.Create;
          AcronymCategory.Name := CategoryStrings[J];
          Categories.Add(AcronymCategory);
        end;
        NewMeaning.Categories.Add(AcronymCategory);
        AcronymCategory.AcronymMeanings.Add(NewMeaning);
      end;
    end;
  finally
    F.Free;
    Line.Free;
    CategoryStrings.Free;
  end;
  Modified := False;
end;

procedure TAcronymDb.SaveToFileCSV(FileName: string);
var
  I: Integer;
  J: Integer;
  K: Integer;
  F: TStringList;
  Line: TStringList;
  Context: TStringList;
begin
  Self.FileName := FileName;
  F := TStringList.Create;
  Line := TStringList.Create;
  Line.StrictDelimiter := True;
  Context := TStringList.Create;
  Context.Delimiter := ';';
  try
    Line.Clear;
    for I := 0 to Acronyms.Count - 1 do
    with TAcronym(Acronyms[I]) do begin
      for K := 0 to Meanings.Count - 1 do
      with TAcronymMeaning(Meanings[K]) do begin
        Line.Clear;
        Line.Add(Acronym.Name);
        Line.Add(Name);
        Context.Clear;
        for J := 0 to Categories.Count - 1 do
          Context.Add(TAcronymCategory(Categories[J]).Name);
        Line.Add(Context.DelimitedText);
        F.Add(Line.CommaText);
      end;
    end;
    F.SaveToFile(FileName);
  finally
    F.Free;
    Line.Free;
    Context.Free;
  end;
  Modified := False;
end;

procedure TAcronymDb.FilterList(AName: string; Items: TAcronymMeanings);
var
  I: Integer;
  J: Integer;
begin
  AName := LowerCase(AName);
  Items.Clear;
  for I := 0 to Acronyms.Count - 1 do
  with TAcronym(Acronyms[I]) do begin
    for J := 0 to Meanings.Count - 1 do
    with TAcronymMeaning(Meanings[J]) do begin
      if (AName = '') or (Pos(AName, LowerCase(TAcronym(Acronyms[I]).Name)) > 0)
        or (Pos(AName, LowerCase(Name)) > 0) then Items.Add(TAcronymMeaning(Meanings[J]))
    end;
  end;
end;

function TAcronymDb.AddAcronym(AcronymName, MeaningName: string): TAcronymMeaning;
var
  Acronym: TAcronym;
  Meaning: TAcronymMeaning;
begin
  Acronym := Acronyms.SearchByName(AcronymName);
  if not Assigned(Acronym) then begin
    Acronym := TAcronym.Create;
    Acronym.Name := AcronymName;
    Acronyms.Add(Acronym);
  end;
  Meaning := Acronym.Meanings.SearchByName(MeaningName);
  if not Assigned(Meaning) then begin
    Meaning := TAcronymMeaning.Create;
    Meaning.Name := MeaningName;
    Meaning.Acronym := Acronym;
    Acronym.Meanings.Add(Meaning);
  end;
  Result := Meaning;
  Modified := True;
end;

procedure TAcronymDb.RemoveMeaning(Meaning: TAcronymMeaning);
var
  Acronym: TAcronym;
begin
  Acronym := Meaning.Acronym;
  Acronym.Meanings.Remove(Meaning);
  if Acronym.Meanings.Count = 0 then
    Acronyms.Remove(Acronym);
  Modified := True;
end;

procedure TAcronymDb.RemoveAcronym(AcronymName, MeaningName: string);
var
  Acronym: TAcronym;
  Meaning: TAcronymMeaning;
begin
  Acronym := Acronyms.SearchByName(AcronymName);
  if Assigned(Acronym) then begin
    Meaning := Acronym.Meanings.SearchByName(MeaningName);
    if Assigned(Meaning) then RemoveMeaning(Meaning);
  end;
end;

procedure TAcronymDb.AssignToList(List: TListObject);
var
  I: Integer;
  J: Integer;
begin
  List.Clear;
  for I := 0 to Acronyms.Count - 1 do
  with TAcronym(Acronyms[I]) do begin
    for J := 0 to Meanings.Count - 1 do
    with TAcronymMeaning(Meanings[J]) do begin
      List.Add(TAcronymMeaning(Meanings[J]))
    end;
  end;
end;

end.