source: tags/1.1.0/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, ipfRemove);
  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 = (ifkParseURL, ifkMSAccess, ifkParseFile);

  { 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
    ResponseStream: TMemoryStream;
    procedure DoPassword(Sender: TObject; var RepeatRequest : Boolean);
    procedure TextParse(S: string);
  public
    Enabled: Boolean;
    Name: string;
    URL: string;
    Format: TImportFormat;
    LastTime: TDateTime;
    Sources: TImportSources;
    ItemCount: Integer;
    LastImportTime: TDateTime;
    Categories: TAcronymCategories;
    UserName: string;
    Password: string;
    function DownloadHTTP(URL: string; Stream: TStream): Boolean;
    procedure Process;
    procedure ProcessTextParseURL;
    procedure ProcessTextParseFile;
    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;
    AddedCount: Integer;
    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;

var
  ImportVariableString: array [TImportVariable] of string;
  ImportPatternFlagString: array [TImportPatternFlag] of string;

procedure Translate;

implementation

resourcestring
  SWrongFileFormat = 'Wrong file format';
  SUnsupportedImportFormat = 'Unsupported import format';
  SDescription = 'Description';
  SMeaning = 'Meaning';
  SAcronym = 'Acronym';
  SNone = 'None';
  SNewItem = 'New item';
  SSkip = 'Skip';
  SRemoveOnStart = 'Remove on start';
  SUnsupportedAuthMethod = 'Unsupported HTTP authorization method';
  SFileNotFound = 'File %s not found';


procedure Translate;
begin
  ImportVariableString[ivAcronym] := SAcronym;
  ImportVariableString[ivNone] := SNone;
  ImportVariableString[ivMeaning] := SMeaning;
  ImportVariableString[ivDescription] := SDescription;
  ImportPatternFlagString[ipfNone] := SNone;
  ImportPatternFlagString[ipfNewItem] := SNewItem;
  ImportPatternFlagString[ipfSkip] := SSkip;
  ImportPatternFlagString[ipfRemove] := SRemoveOnStart;
end;

function AcronymComparer(Item1, Item2: Pointer): Integer;
begin
  Result := CompareStr(TAcronym(Item1).Name, TAcronym(Item2).Name);
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;

{ 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;
      if (NewAcronym.Name <> '') and (NewAcronym.Meaning <> '') then
        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);
var
  H: string;
begin
  with TFPHttpClient(Sender) do begin
    H := GetHeader(ResponseHeaders, 'WWW-Authenticate');
    if Pos(' ', H) > 0 then H := Copy(H, 1, Pos(' ', H) - 1);

    if H <> 'Basic' then
      raise Exception.Create(SUnsupportedAuthMethod);

    if (Self.UserName <> '') and (UserName = '') then begin
      UserName := Self.UserName;
      Password := Self.Password;
      ResponseStream.Clear;
      RepeatRequest := True;
    end else RepeatRequest := False;
  end;
end;

procedure TImportSource.TextParse(S: string);
var
  SS: string;
  NewAcronym: TAcronymEntry;
  P: Integer;
  P1, P2: Integer;
  Q: Integer;
  I: Integer;
  T: string;
  LastLength: Integer;
  AddedAcronym: TAcronymMeaning;
begin
  ItemCount := 0;
  NewAcronym := TAcronymEntry.Create;
  try

  // 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 = ipfRemove 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 <> ipfRemove 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 := Copy(S, 1, P - 1);
          if Flag <> ipfSkip then begin
            T := StripHTML(T);
            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;
          end;
          Delete(S, 1, P + Length(EndString) - 1);

          if (Flag = ipfNewItem) and (NewAcronym.Name <> '') and
            (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;
  finally
    NewAcronym.Free;
  end;
end;


function TImportSource.DownloadHTTP(URL: string; Stream: TStream): Boolean;
var
  HTTPClient: TFPHTTPClient;
  FormData: TStringList;
begin
  Result := False;
  HTTPClient := TFPHttpClient.Create(nil);
  HTTPClient.AllowRedirect := True;
  HTTPClient.OnPassword := DoPassword;
  FormData := TStringList.Create;
  try
    HTTPClient.Get(URL, Stream);
    Result := True;
  finally
    FormData.Free;
    HTTPClient.Free;
  end;
end;

procedure TImportSource.Process;
begin
  case Format.Kind of
    ifkParseURL: ProcessTextParseURL;
    ifkMSAccess: ProcessMSAccess;
    ifkParseFile: ProcessTextParseFile;
    else raise Exception.Create(SUnsupportedImportFormat);
  end;
  LastImportTime := Now;
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.ProcessTextParseURL;
var
  S: string;
begin
  if DownloadHTTP(URL, ResponseStream) then begin
    ResponseStream.Position := 0;
    SetLength(S, ResponseStream.Size);
    ResponseStream.Read(S[1], Length(S));

    TextParse(S);
  end;
end;

procedure TImportSource.ProcessTextParseFile;
var
  S: TStringList;
begin
  if FileExists(URL) then begin
    S := TStringList.Create;
    try
      S.LoadFromFile(URL);
      TextParse(S.Text);
    finally
      S.Free;
    end;
  end else ShowMessage(SysUtils.Format(SFileNotFound, [URL]));
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);
  UserName := Source.UserName;
  Password := Source.Password;
  LastImportTime := Source.LastImportTime;
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);
  WriteDateTime(Node, 'LastImportTime', LastImportTime);
  WriteString(Node, 'UserName', UserName);

  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);
  UserName := ReadString(Node, 'UserName', '');
  LastImportTime := ReadDateTime(Node, 'LastImportTime', 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;
  ResponseStream := TMemoryStream.Create;
end;

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

{ TAcronymEntry }

constructor TAcronymEntry.Create;
begin
  Categories := TStringList.Create;
  Name := '';
  Meaning := '';
  Description := '';
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);
    Inc(AddedCount);
  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.