Changeset 6 for trunk/UCore.pas

Timestamp:

Jan 20, 2015, 12:31:24 AM (10 years ago)

Author:

chronos

Message:

• Added: Allow to create multiple database connections and set their parmaters.
• Added: Defined database engines to support various database backends. Each supports different set of field data types.

File:

• trunk/UCore.pas (modified) (5 diffs)

trunk/UCore.pas

@@ -22 +22 @@
   private
     Initialized: Boolean;
+    procedure InitEngines;
   public
-    Database: TDatabase;
+    Databases: TDatabases;
+    Engines: TDatabaseEngines;
     procedure LoadConfig;
     procedure SaveConfig;
@@ -36 +38 @@
 
 uses
-  UDatabaseXML, UFormTables;
+  UEngineXML, UEngineMySQL, UEngineSQLite, UFormTables, UFormConnect, UFormDatabases;
 
 {$R *.lfm}
@@ -44 +46 @@
 procedure TCore.DataModuleCreate(Sender: TObject);
 begin
-  Database := TDatabaseXML.Create;
+  Databases := TDatabases.Create;
+  Engines := TDatabaseEngines.Create;
 end;
 
 procedure TCore.AExitExecute(Sender: TObject);
 begin
-  FormMain.Close;
+  FormTables.Close;
 end;
 
 procedure TCore.DataModuleDestroy(Sender: TObject);
 begin
-  Database.Free;
+  Engines.Free;
+  Databases.Free;
+end;
+
+procedure TCore.InitEngines;
+var
+  NewEngine: TDatabaseEngine;
+begin
+  Engines.Clear;
+
+  NewEngine := Engines.RegisterEngine('XML file', TDatabaseXML);
+  with NewEngine.DataTypes do begin
+    RegisterType('String', ftString);
+    RegisterType('Integer', ftInteger);
+    RegisterType('Date and time', ftDateTime);
+    RegisterType('Boolean', ftBoolean);
+    RegisterType('Float', ftFloat);
+  end;
+
+  NewEngine := Engines.RegisterEngine('MySQL', TDatabaseMySQL);
+  with NewEngine.DataTypes do begin
+    RegisterType('String', ftString);
+    RegisterType('Integer', ftInteger);
+    RegisterType('Date and time', ftDateTime);
+    RegisterType('Boolean', ftBoolean);
+    RegisterType('Float', ftFloat);
+  end;
+
+  NewEngine := Engines.RegisterEngine('SQLite', TDatabaseSQLite);
+  with NewEngine.DataTypes do begin
+    RegisterType('String', ftString);
+    RegisterType('Integer', ftInteger);
+    RegisterType('Date and time', ftDateTime);
+    RegisterType('Boolean', ftBoolean);
+    RegisterType('Float', ftFloat);
+  end;
 end;
 
 procedure TCore.LoadConfig;
+var
+  I: Integer;
+  NewDatabase: TDatabase;
 begin
-  Database.ConnectionString := XMLConfig1.GetValue('ConnectionString', 'file://' + ExtractFileDir(Application.ExeName) + '/data.xml');
+  Databases.Count := XMLConfig1.GetValue('Database/Count', 0);
+  for I := 0 to Databases.Count - 1 do begin
+    NewDatabase := TDatabase.Create;
+    NewDatabase.Name := XMLConfig1.GetValue('Database/Item' + IntToStr(I) + '/Name', '');
+    NewDatabase.ConnectionString := XMLConfig1.GetValue('Database/Item' + IntToStr(I) + '/ConnectionString', '');
+    NewDatabase.Engine := Core.Engines.FindByName(XMLConfig1.GetValue('Database/Item' + IntToStr(I) + '/Engine', ''));
+    Databases[I] := NewDatabase;
+  end;
+  //Databases.ConnectionString := XMLConfig1.GetValue('ConnectionString', 'file://' + ExtractFileDir(Application.ExeName) + '/data.xml');
 end;
 
 procedure TCore.SaveConfig;
+var
+  I: Integer;
 begin
-  XMLConfig1.SetValue('ConnectionString', Database.ConnectionString);
+  XMLConfig1.SetValue('Database/Count', Databases.Count);
+  for I := 0 to Databases.Count - 1 do begin
+    XMLConfig1.SetValue('Database/Item' + IntToStr(I) + '/Name', TDatabase(Databases[I]).Name);
+    XMLConfig1.SetValue('Database/Item' + IntToStr(I) + '/ConnectionString', TDatabase(Databases[I]).ConnectionString);
+    XMLConfig1.SetValue('Database/Item' + IntToStr(I) + '/Engine', TDatabase(Databases[I]).Engine.Name);
+  end;
 end;
 
@@ -70 +126 @@
 begin
   if not Initialized then begin
+    InitEngines;
+    FormConnect.Init;
     Initialized := True;
     LoadConfig;
-    Database.Load;
-    FormMain.ReloadList;
+    FormDatabases.ReloadList;
   end;
 end;
@@ -79 +136 @@
 procedure TCore.Done;
 begin
-  Database.Save;
   SaveConfig;
 end;