source: trunk/DbEngines/EngineXML.pas

unit EngineXML;

interface

uses
  Classes, SysUtils, DOM, XMLRead, XMLWrite, DbEngine, XML, FileUtil,
  HtmlClasses, USqlDatabase, Generics;

type
  { TDatabaseXML }

  TDatabaseXML = class(TDbClient)
  private
    FFileName: string;
    Tables: TTables;
    procedure LoadNodeRecord(Row: TRecord; Node: TDOMNode);
    procedure SaveNodeRecord(Row: TRecord; Node: TDOMNode);
    procedure LoadNodeRecords(Records: TRecords; Node: TDOMNode);
    procedure SaveNodeRecords(Records: TRecords; Node: TDOMNode);
    procedure LoadNodeField(Field: TField; Node: TDOMNode);
    procedure SaveNodeField(Field: TField; Node: TDOMNode);
    procedure LoadNodeFields(Fields: TFields; Node: TDOMNode);
    procedure SaveNodeFields(Fields: TFields; Node: TDOMNode);
    procedure LoadNodeTable(Table: TTable; Node: TDOMNode);
    procedure SaveNodeTable(Table: TTable; Node: TDOMNode);
    procedure LoadNodeTables(Tables: TTables; Node: TDOMNode);
    procedure SaveNodeTables(Tables: TTables; Node: TDOMNode);
    procedure LoadFromFile(FileName: string);
    procedure SaveToFile(FileName: string);
    procedure Expect(var Source: string; Text: string);
    function CheckNext(var Source: string; Text: string): Boolean;
    function GetNextPart(var Text: string; Separator: string = ' '): string;
    procedure QuerySelect(Text: string; DbRows: TDbRows = nil);
    procedure QueryInsert(Text: string; DbRows: TDbRows = nil);
    procedure QueryDelete(Text: string; DbRows: TDbRows = nil);
    procedure QueryUpdate(Text: string; DbRows: TDbRows = nil);
    function TableCreateIfNotExists(Name: string): TTable;
    function FieldCreateIfNotExists(TableName, FieldName: string; DataType: TDataType): TField;
  public
    procedure Query(Text: string; DbRows: TDbRows = nil); override;
    procedure Load; override;
    procedure Save; override;
    constructor Create; override;
    destructor Destroy; override;
    property FileName: string read FFileName write FFileName;
  end;

  { TDbConnectParamsXml }

  TDbConnectParamsXml = class(TDbConnectParams)
  protected
    function GetConnectionString: string; override;
    procedure SetConnectionString(AValue: string); override;
  public
    FileName: string;
  end;


implementation

uses
  DataTypes;

resourcestring
  SWrongFileFormat = 'Wrong file format';
  STableNotFound = 'Table %s not found';
  SFieldNotFound = 'Table field %s not found';
  SUnsupportedSqlCommand = 'Unsupported SQL command: %s';
  SColumnNotFoundInTable = 'Column %s not found in table %s';

{ TDbConnectParamsXml }

function TDbConnectParamsXml.GetConnectionString: string;
begin
  Result := 'file:///' + FileName;
end;

procedure TDbConnectParamsXml.SetConnectionString(AValue: string);
var
  URL: TURL;
begin
  URL := TURL.Create;
  try
    URL.AsString := AValue;
    if (URL.Scheme <> 'file') and (AValue <> '') then
      raise Exception.Create('Wrong connection string. Required file scheme.');
    FileName := Copy(URL.Path, 2, Length(URL.Path));
  finally
    URL.Free;
  end;
end;

{ TDatabaseXML }

procedure TDatabaseXML.LoadNodeRecord(Row: TRecord; Node: TDOMNode);
var
  Node2: TDOMNode;
  I: Integer;
begin
  Row.Values.Count := Row.Table.Fields.Count;
  for I := 0 to Row.Values.Count - 1 do
    Row.Values[I] := TValueClass(Row.Table.Fields[I].GetValueClass).Create;

  Node2 := Node.FirstChild;
  I := 0;
  while Assigned(Node2) and (Node2.NodeName = 'Value') and (I < Row.Values.Count) do begin
    case Row.Table.Fields[I].DataType.FieldType of
      ftString: TValueString(Row.Values[I]).Value := string(Node2.TextContent);
      ftInteger: TValueInteger(Row.Values[I]).Value := StrToInt(string(Node2.TextContent));
      ftDateTime: if Node2.TextContent <> '' then
        TValueDateTime(Row.Values[I]).Value := XMLTimeToDateTime(string(Node2.TextContent));
      ftBoolean: TValueBoolean(Row.Values[I]).Value := StrToBool(string(Node2.TextContent));
    end;
    Node2 := Node2.NextSibling;
    Inc(I);
  end;
end;

procedure TDatabaseXML.SaveNodeRecord(Row: TRecord; Node: TDOMNode);
var
  I: Integer;
  NewNode: TDOMNode;
begin
  for I := 0 to Row.Values.Count - 1 do begin;
    NewNode := Node.OwnerDocument.CreateElement('Value');
    Node.AppendChild(NewNode);
    case Row.Table.Fields[I].DataType.FieldType of
      ftString: NewNode.TextContent := UnicodeString(TValueString(Row.Values[I]).Value);
      ftInteger: NewNode.TextContent := UnicodeString(IntToStr(TValueInteger(Row.Values[I]).Value));
      ftDateTime: NewNode.TextContent := UnicodeString(DateTimeToXMLTime(TValueDateTime(Row.Values[I]).Value));
      ftBoolean: NewNode.TextContent := UnicodeString(BoolToStr(TValueBoolean(Row.Values[I]).Value));
      ftFloat: NewNode.TextContent := UnicodeString(FloatToStr(TValueFloat(Row.Values[I]).Value));
    end;
  end;
end;

procedure TDatabaseXML.LoadNodeRecords(Records: TRecords; Node: TDOMNode);
var
  Node2: TDOMNode;
  NewRecord: TRecord;
begin
  Records.Count := 0;
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = 'Record') do begin
    NewRecord := TRecord.Create;
    NewRecord.Table := Records.Table;
    LoadNodeRecord(NewRecord, Node2);
    Records.Add(NewRecord);
    Node2 := Node2.NextSibling;
  end;
end;

procedure TDatabaseXML.SaveNodeRecords(Records: TRecords; Node: TDOMNode);
var
  I: Integer;
  NewNode: TDOMNode;
begin
  for I := 0 to Records.Count - 1 do begin;
    NewNode := Node.OwnerDocument.CreateElement('Record');
    Node.AppendChild(NewNode);
    SaveNodeRecord(Records[I], NewNode);
  end;
end;

procedure TDatabaseXML.LoadNodeField(Field: TField; Node: TDOMNode);
begin
  Field.Name := ReadString(Node, 'Name', '');
  Field.DataType := Field.Table.DbClient.ClientType.DataTypes.SearchByType(TFieldType(ReadInteger(Node, 'Type', 0)));
  Field.TextBefore := ReadString(Node, 'TextBefore', '');
  Field.TextAfter := ReadString(Node, 'TextAfter', '');
end;

procedure TDatabaseXML.SaveNodeField(Field: TField; Node: TDOMNode);
begin
  WriteString(Node, 'Name', Field.Name);
  WriteInteger(Node, 'Type', Integer(Field.DataType.FieldType));
  WriteString(Node, 'TextBefore', Field.TextBefore);
  WriteString(Node, 'TextAfter', Field.TextAfter);
end;

procedure TDatabaseXML.LoadNodeFields(Fields: TFields; Node: TDOMNode);
var
  Node2: TDOMNode;
  NewField: TField;
begin
  Fields.Count := 0;
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = 'Field') do begin
    NewField := TField.Create;
    NewField.Table := Fields.Table;
    LoadNodeField(NewField, Node2);
    Fields.Add(NewField);
    Node2 := Node2.NextSibling;
  end;
end;

procedure TDatabaseXML.SaveNodeFields(Fields: TFields; Node: TDOMNode);
var
  I: Integer;
  NewNode: TDOMNode;
begin
  for I := 0 to Fields.Count - 1 do begin;
    NewNode := Node.OwnerDocument.CreateElement('Field');
    Node.AppendChild(NewNode);
    SaveNodeField(Fields[I], NewNode);
  end;
end;

procedure TDatabaseXML.LoadNodeTable(Table: TTable; Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  Table.Name := ReadString(Node, 'Name', '');
  Table.Caption := ReadString(Node, 'Caption', '');

  NewNode := Node.FindNode('Fields');
  if Assigned(NewNode) then
    LoadNodeFields(Table.Fields, NewNode);

  NewNode := Node.FindNode('Records');
  if Assigned(NewNode) then
    LoadNodeRecords(Table.Records, NewNode);
end;

procedure TDatabaseXML.SaveNodeTable(Table: TTable; Node: TDOMNode);
var
  NewNode: TDOMNode;
begin
  WriteString(Node, 'Name', Table.Name);
  WriteString(Node, 'Caption', Table.Caption);

  NewNode := Node.OwnerDocument.CreateElement('Fields');
  Node.AppendChild(NewNode);
  SaveNodeFields(Table.Fields, NewNode);

  NewNode := Node.OwnerDocument.CreateElement('Records');
  Node.AppendChild(NewNode);
  SaveNodeRecords(Table.Records, NewNode);
end;

procedure TDatabaseXML.LoadNodeTables(Tables: TTables; Node: TDOMNode);
var
  Node2: TDOMNode;
  NewTable: TTable;
begin
  Tables.Count := 0;
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = 'Table') do begin
    NewTable := TTable.Create;
    NewTable.DbClient := Tables.DbClient;
    LoadNodeTable(NewTable, Node2);
    Tables.Add(NewTable);
    Node2 := Node2.NextSibling;
  end;
end;

procedure TDatabaseXML.SaveNodeTables(Tables: TTables; Node: TDOMNode);
var
  I: Integer;
  NewNode: TDOMNode;
begin
  for I := 0 to Tables.Count - 1 do begin;
    NewNode := Node.OwnerDocument.CreateElement('Table');
    Node.AppendChild(NewNode);
    SaveNodeTable(Tables[I], NewNode);
  end;
end;

procedure TDatabaseXML.LoadFromFile(FileName: string);
var
  Doc: TXMLDocument;
  RootNode: TDOMNode;
  NewNode: TDOMNode;
begin
  ReadXMLFile(Doc, FileName);
  with Doc do try
    if Doc.DocumentElement.NodeName <> 'MyData' then
      raise Exception.Create(SWrongFileFormat);
    RootNode := Doc.DocumentElement;
    with RootNode do begin
      NewNode := FindNode('Tables');
      if Assigned(NewNode) then
        LoadNodeTables(Tables, NewNode);
    end;
  finally
    Doc.Free;
  end;
end;

procedure TDatabaseXML.SaveToFile(FileName: string);
var
  NewNode: TDOMNode;
  Doc: TXMLDocument;
  RootNode: TDOMNode;
begin
  if FileName = '' then exit;
  Doc := TXMLDocument.Create;
  with Doc do try
    RootNode := CreateElement('MyData');
    AppendChild(RootNode);
    with RootNode do begin
      NewNode := OwnerDocument.CreateElement('Tables');
      AppendChild(NewNode);
      SaveNodeTables(Tables, NewNode);
    end;
    if Pos(DirectorySeparator, FileName) > 0 then
      ForceDirectories(ExtractFileDir(FileName));
    WriteXMLFile(Doc, FileName);
  finally
    Doc.Free;
  end;
end;

procedure TDatabaseXML.Expect(var Source: string; Text: string);
var
  Found: string;
begin
  Found := GetNextPart(Source);
  if Found <> Text then
    raise Exception.Create('Expected ' + Text + ' but ' + Found + ' found.');
end;

function TDatabaseXML.CheckNext(var Source: string; Text: string): Boolean;
var
  Found: string;
  SourceCopy: string;
begin
  SourceCopy := Source;
  Found := GetNextPart(SourceCopy);
  if Found = Text then begin
    Source := SourceCopy;
    Result := True;
  end else Result := False;
end;

function TDatabaseXML.GetNextPart(var Text: string; Separator: string = ' '): string;
begin
  if Pos(Separator, Text) > 0 then begin
    Result := Trim(Copy(Text, 1, Pos(Separator, Text) - Length(Separator)));
    Delete(Text, 1, Pos(Separator, Text));
  end else begin
    Result := Text;
    Text := '';
  end;
end;

function TDatabaseXML.TableCreateIfNotExists(Name: string): TTable;
begin
  Result := Tables.SearchByName(Name);
  if not Assigned(Result) then begin
    Tables.AddNew(Name);
  end;
end;

function TDatabaseXML.FieldCreateIfNotExists(TableName, FieldName: string; DataType: TDataType): TField;
var
  Table: TTable;
begin
  TableCreateIfNotExists(TableName);
  Table := Tables.SearchByName(TableName);
  Result := Table.Fields.SearchByName(FieldName);
  if not Assigned(Result) then begin
    Table.Fields.AddNew(FieldName, DataType);
  end;
end;

procedure TDatabaseXML.QuerySelect(Text: string; DbRows: TDbRows = nil);
var
  Command: string;
  Columns: string;
  TableName: string;
  Table: TTable;
  NewRecord: TDictionaryStringString;
  I: Integer;
  F: Integer;
  WhereName: string;
  WhereValue: string;
begin
  DbRows.Count := 0;
  Columns := GetNextPart(Text);
  Expect(Text, 'FROM');
  TableName := GetNextPart(Text);
  if CheckNext(Text, 'WHERE') then begin
    WhereName := GetNextPart(Text);
    Command := GetNextPart(Text);
    if Command = '=' then begin
      WhereValue := GetNextPart(Text);
    end else raise Exception.Create('Expression error');
  end;
  if TableName = 'Model' then begin
    if Columns = '*' then begin
      for I := 0 to Tables.Count - 1 do begin
        NewRecord := TDictionaryStringString.Create;
        NewRecord.Add('Name', TTable(Tables[I]).Name);
        NewRecord.Add('Caption', TTable(Tables[I]).Caption);
        DbRows.Add(NewRecord);
      end;
    end else
    if Columns = 'COUNT(*)' then begin
      NewRecord := TDictionaryStringString.Create;
      NewRecord.Add('COUNT(*)', IntToStr(Tables.Count));
      DbRows.Add(NewRecord);
    end else raise Exception.Create('Unsupported columns ' + Columns + ' specification');
  end else
  if TableName = 'ModelField' then begin
    if WhereName = 'Model' then
      Table := Tables.SearchByName(WhereValue)
      else Table := nil;
    if Assigned(Table) then begin
      if Columns = '*' then begin
        for I := 0 to Table.Fields.Count - 1 do begin
          NewRecord := TDictionaryStringString.Create;
          NewRecord.Add('Name', TField(Table.Fields[I]).Name);
          NewRecord.Add('Caption', TField(Table.Fields[I]).TextBefore);
          NewRecord.Add('Model', Table.Name);
          NewRecord.Add('DataType', TField(Table.Fields[I]).DataType.Name);
          DbRows.Add(NewRecord);
        end;
      end else
      if Columns = 'COUNT(*)' then begin
        NewRecord := TDictionaryStringString.Create;
        NewRecord.Add('COUNT(*)', IntToStr(Table.Fields.Count));
        DbRows.Add(NewRecord);
      end else raise Exception.Create('Unsupported columns ' + Columns + ' specification');
    end else raise Exception.Create(Format(STableNotFound, [WhereValue]));
  end else begin
    Table := Tables.SearchByName(TableName);
    if Assigned(Table) then begin
      if Columns = '*' then begin
        for I := 0 to Table.Records.Count - 1 do begin
          NewRecord := TDictionaryStringString.Create;
          for F := 0 to Table.Fields.Count - 1 do
            NewRecord.Add(TField(Table.Fields[F]).Name, TValue(TRecord(Table.Records[I]).Values[I]).GetString);
          DbRows.Add(NewRecord);
        end;
      end else
      if Columns = 'COUNT(*)' then begin
        NewRecord := TDictionaryStringString.Create;
        NewRecord.Add('COUNT(*)', IntToStr(Table.Records.Count));
        DbRows.Add(NewRecord);
      end else raise Exception.Create('Unsupported columns ' + Columns + ' specification');
    end else raise Exception.Create(Format(STableNotFound, [TableName]));
  end;
end;

procedure TDatabaseXML.QueryInsert(Text: string; DbRows: TDbRows);
var
  TableName: string;
  Table: TTable;
  Row: TRecord;
  InsertValues: TStringList;
  Field: TField;
  FieldIndex: Integer;
  ValueIndex: Integer;
begin
  InsertValues := TStringList.Create;
  Expect(Text, 'INTO');
  TableName := GetNextPart(Text);
  Expect(Text, '(');
  InsertValues.Add(GetNextPart(Text) + InsertValues.NameValueSeparator);
  while CheckNext(Text, ',') do begin
    InsertValues.Add(GetNextPart(Text) + InsertValues.NameValueSeparator);
  end;
  Expect(Text, ')');
  Expect(Text, 'VALUES');
  Expect(Text, '(');
  ValueIndex := 0;
  InsertValues.ValueFromIndex[ValueIndex] := GetNextPart(Text);
  Inc(ValueIndex);
  while CheckNext(Text, ',') do begin
    InsertValues.ValueFromIndex[ValueIndex] := GetNextPart(Text);
    Inc(ValueIndex);
  end;
  Expect(Text, ')');
  if TableName = 'Model' then begin
    Table := Tables.AddNew(InsertValues.Values['Name']);
    Table.Caption := InsertValues.Values['Caption'];
  end else
  if TableName = 'ModelField' then begin
    Table := Tables.SearchByName(InsertValues.Values['Model']);
    if Assigned(Table) then begin
      Field := Table.Fields.AddNew(InsertValues.Values['Name'], DbManager.DataTypes.SearchByType(ftString));
      Field.TextBefore := InsertValues.Values['Caption'];
      Field.DataType := DbManager.DataTypes.SearchByName(InsertValues.Values['DataType']);
    end else raise Exception.Create(Format(STableNotFound, [InsertValues.Values['Model']]));
  end else begin
    Table := Tables.SearchByName(TableName);
    if Assigned(Table) then begin
      Row := Table.Records.AddNew;
      for ValueIndex := 0 to InsertValues.Count - 1 do begin
        Field := Table.Fields.SearchByName(InsertValues.Names[ValueIndex]);
        if Assigned(Field) then begin
          FieldIndex := Table.Fields.IndexOf(Field);
          Row.Values[FieldIndex].SetString(InsertValues.ValueFromIndex[ValueIndex]);
        end else raise Exception.Create(Format(SColumnNotFoundInTable,
          [InsertValues.Names[ValueIndex], TableName]));
      end;
    end else raise Exception.Create(Format(STableNotFound, [TableName]));
  end;
  InsertValues.Free;
end;

procedure TDatabaseXML.QueryDelete(Text: string; DbRows: TDbRows);
var
  TableName: string;
  Table: TTable;
  Row: TRecord;
  Field: TField;
  WhereValues: TStringList;
  ValueName: string;
begin
  Expect(Text, 'FROM');
  TableName := GetNextPart(Text);

  if CheckNext(Text, 'WHERE') then begin
    WhereValues := TStringList.Create;
    ValueName := GetNextPart(Text);
    Expect(Text, '=');
    WhereValues.Add(ValueName + WhereValues.NameValueSeparator + GetNextPart(Text));
    while CheckNext(Text, ',') do begin
      ValueName := GetNextPart(Text);
      Expect(Text, '=');
      WhereValues.Add(ValueName + WhereValues.NameValueSeparator + GetNextPart(Text));
    end;
  end else WhereValues := nil;

  if TableName = 'Model' then begin
    Table := Tables.SearchByName(WhereValues.Values['Name']);
    if Assigned(Table) then begin
      Tables.Remove(Table);
    end else raise Exception.Create(Format(STableNotFound, [whereValues.Values['Name']]));
  end else
  if TableName = 'ModelField' then begin
    Table := Tables.SearchByName(WhereValues.Values['Model']);
    if Assigned(Table) then begin
      Field := Table.Fields.SearchByName(WhereValues.Values['Name']);
      if Assigned(Field) then begin
        Table.Fields.Remove(Field);
      end else raise Exception.Create(Format(SFieldNotFound, [WhereValues.Values['Name']]));
    end else raise Exception.Create(Format(STableNotFound, [WhereValues.Values['Model']]));
  end else begin
    Table := Tables.SearchByName(TableName);
    if Assigned(Table) then begin
      Row := Table.Records.SearchByValues(WhereValues);
      if Assigned(Row) then begin
        Table.Records.Remove(Row);
      end else raise Exception.Create('Row not found');
    end else raise Exception.Create(Format(STableNotFound, [TableName]));
  end;

  if Assigned(WhereValues) then WhereValues.Free;
end;

procedure TDatabaseXML.QueryUpdate(Text: string; DbRows: TDbRows);
var
  TableName: string;
  Table: TTable;
  Row: TRecord;
  WhereValues: TStringList;
  Field: TField;
  Values: TStringList;
  ValueIndex: Integer;
  FieldIndex: Integer;
  ValueName: string;
begin
  TableName := GetNextPart(Text);
  Expect(Text, 'SET');
  Values := TStringList.Create;
  ValueName := GetNextPart(Text);
  Expect(Text, '=');
  Values.Add(ValueName + Values.NameValueSeparator + GetNextPart(Text));
  while CheckNext(Text, ',') do begin
    ValueName := GetNextPart(Text);
    Expect(Text, '=');
    Values.Add(ValueName + Values.NameValueSeparator + GetNextPart(Text));
  end;

  if CheckNext(Text, 'WHERE') then begin
    WhereValues := TStringList.Create;
    ValueName := GetNextPart(Text);
    Expect(Text, '=');
    WhereValues.Add(ValueName + WhereValues.NameValueSeparator + GetNextPart(Text));
    while CheckNext(Text, ',') do begin
      ValueName := GetNextPart(Text);
      Expect(Text, '=');
      WhereValues.Add(ValueName + WhereValues.NameValueSeparator + GetNextPart(Text));
    end;
  end else WhereValues := nil;

  if TableName = 'Model' then begin
    Table := Tables.SearchByName(WhereValues.Values['Name']);
    if Assigned(Table) then begin
      //Table.Name := Values.Values['Name'];
      if Values.IndexOfName('Caption') <> -1 then
        Table.Caption := Values.Values['Caption'];
    end else raise Exception.Create(Format(STableNotFound, [WhereValues.Values['Name']]));
  end else
  if TableName = 'ModelField' then begin
    Table := Tables.SearchByName(WhereValues.Values['Model']);
    if Assigned(Table) then begin
      Field := Table.Fields.SearchByName(WhereValues.Values['Name']);
      if Assigned(Field) then begin
        if Values.IndexOfName('Name') <> -1 then
          Field.Name := Values.Values['Name'];
        if Values.IndexOfName('Caption') <> -1 then
          Field.TextBefore := Values.Values['Caption'];
        if Values.IndexOfName('DataType') <> -1 then
          Field.DataType := DbManager.DataTypes.SearchByName(Values.Values['DataType']);
      end else raise Exception.Create(Format(SFieldNotFound, [WhereValues.Values['Name']]));
    end else raise Exception.Create(Format(STableNotFound, [WhereValues.Values['Model']]));
  end else begin
    Table := Tables.SearchByName(TableName);
    if Assigned(Table) then begin
      Row := Table.Records.SearchByValues(WhereValues);
      for ValueIndex := 0 to Values.Count - 1 do begin
        Field := Table.Fields.SearchByName(Values.Names[ValueIndex]);
        if Assigned(Field) then begin
          FieldIndex := Table.Fields.IndexOf(Field);
          TValue(Row.Values[FieldIndex]).SetString(Values.ValueFromIndex[ValueIndex]);
        end else raise Exception.Create(Format(SColumnNotFoundInTable,
          [Values.Names[ValueIndex], TableName]));
      end;
    end else raise Exception.Create(Format(STableNotFound, [TableName]));
  end;

  if Assigned(WhereValues) then WhereValues.Free;
  Values.Free;
end;

procedure TDatabaseXML.Query(Text: string; DbRows: TDbRows = nil);
var
  Command: string;
begin
  Command := GetNextPart(Text);
  if Command = 'SELECT' then QuerySelect(Text, DbRows)
  else if Command = 'INSERT' then QueryInsert(Text, DbRows)
  else if Command = 'DELETE' then QueryDelete(Text, DbRows)
  else if Command = 'UPDATE' then QueryUpdate(Text, DbRows)
  else raise Exception.Create(Format(SUnsupportedSqlCommand, [Command]));
end;

procedure TDatabaseXML.Load;
begin
  FileName := TDbConnectParamsXml(ConnectProfile.Params).FileName;
  Tables.DbClient := Self;
  if FileExists(FileName) then
    LoadFromFile(FileName);

(*
  TableCreateIfNotExists('Model');
  TableCreateIfNotExists('ModelField');
  TableCreateIfNotExists('DataType');
  TableCreateIfNotExists('Module');

  FieldCreateIfNotExists('ModelField', 'Name', DbManager.DataTypes.SearchByType(ftString));
  FieldCreateIfNotExists('ModelField', 'Caption', DbManager.DataTypes.SearchByType(ftString));
  FieldCreateIfNotExists('ModelField', 'Model', DbManager.DataTypes.SearchByType(ftString));
  FieldCreateIfNotExists('ModelField', 'DataType', DbManager.DataTypes.SearchByType(ftString));
  FieldCreateIfNotExists('Model', 'Name', DbManager.DataTypes.SearchByType(ftString));
  FieldCreateIfNotExists('Model', 'Caption', DbManager.DataTypes.SearchByType(ftString));
  FieldCreateIfNotExists('Model', 'Module', DbManager.DataTypes.SearchByType(ftString));
  FieldCreateIfNotExists('Model', 'System', DbManager.DataTypes.SearchByType(ftBoolean));
  FieldCreateIfNotExists('DataType', 'Name', DbManager.DataTypes.SearchByType(ftString));
  FieldCreateIfNotExists('DataType', 'Caption', DbManager.DataTypes.SearchByType(ftString));
  FieldCreateIfNotExists('DataType', 'FieldType', DbManager.DataTypes.SearchByType(ftInteger));
  FieldCreateIfNotExists('Module', 'Name', DbManager.DataTypes.SearchByType(ftString));
  FieldCreateIfNotExists('Module', 'Caption', DbManager.DataTypes.SearchByType(ftString));
  *)
end;

procedure TDatabaseXML.Save;
begin
  SaveToFile(FileName);
end;

constructor TDatabaseXML.Create;
begin
  Tables := TTables.Create;
  inherited;
end;

destructor TDatabaseXML.Destroy;
begin
  FreeAndNil(Tables);
  inherited;
end;

end.