Changeset 20 for trunk/UDatabase.pas

Timestamp:

Mar 23, 2018, 1:59:25 PM (6 years ago)

Author:

chronos

Message:

• Modified: Database classes reorganized. Now TDbConnectProfile is class which holds information about connection to database.
• Modified: TDbManager is top most class for managing other database classes.
• Modified: TDbConnectParams class contains client specific parameters for connect profile.

File:

• trunk/UDatabase.pas (modified) (13 diffs)

trunk/UDatabase.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, Contnrs, ExtCtrls, StdCtrls, EditBtn, dialogs, USqlDatabase,
-  SpecializedDictionary;
+  SpecializedDictionary, URegistry;
 
 type
   TTable = class;
-  TDatabaseEngine = class;
-  TDatabaseClient = class;
-  TDatabase = class;
+  TDbClientType = class;
+  TDbClient = class;
   TDataType = class;
+  TDbManager = class;
 
   TFieldType = (ftString, ftInteger, ftDateTime, ftBoolean, ftFloat, ftImage,
@@ -104 +104 @@
     Records: TRecords;
     Fields: TFields;
-    Database: TDatabase;
+    DbClient: TDbClient;
     RecordsCount: Integer;
     procedure LoadRecords;
@@ -116 +116 @@
 
   TTables = class(TObjectList)
-    Database: TDatabase;
+    DbClient: TDbClient;
     function SearchByName(Name: string): TTable;
   end;
 
-  // CSV, INI, WinRegistry, XML, sqlite, mysql
-
-  { TDatabase }
-
-  TDatabase = class
+  { TDbConnectParams }
+
+  TDbConnectParams = class
+  protected
+    FConnectionString: string;
+    function GetConnectionString: string; virtual;
+    procedure SetConnectionString(AValue: string); virtual;
+  public
+    property ConnectionString: string read GetConnectionString
+      write SetConnectionString;
+  end;
+
+  TDbConnectParamsClass = class of TDbConnectParams;
+
+  { TDbConnectProfile }
+
+  TDbConnectProfile = class
   private
-    FEngine: TDatabaseEngine;
-    procedure SetEngine(AValue: TDatabaseEngine);
+    FClientType: TDbClientType;
+    procedure SetClientType(AValue: TDbClientType);
   public
     Name: string;
-    Tables: TTables;
-    ConnectionString: string;
-    Client: TDatabaseClient;
-    constructor Create;
-    destructor Destroy; override;
-    procedure Load; virtual;
-    procedure Save; virtual;
-    procedure Clear;
-    property Engine: TDatabaseEngine read FEngine write SetEngine;
-  end;
-
-  { TDatabases }
-
-  TDatabases = class(TObjectList)
-    function FindByName(Name: string): TDatabase;
-  end;
-
-  TDatabaseClass = class of TDatabase;
+    Params: TDbConnectParams;
+    property ClientType: TDbClientType read FClientType write SetClientType;
+  end;
+
+  { TDbConnectProfiles }
+
+  TDbConnectProfiles = class(TObjectList)
+    DbManager: TDbManager;
+    procedure LoadFromRegistry(Context: TRegistryContext);
+    procedure SaveToRegistry(Context: TRegistryContext);
+    function FindByName(Name: string): TDbConnectProfile;
+  end;
 
   { TDataType }
@@ -168 +174 @@
   end;
 
-  { TDatabaseClient }
-
-  TDatabaseClient = class
-    Database: TDatabase;
+  { TDbClient }
+
+  TDbClient = class
+  private
+    function GetClientType: TDbClientType;
+  protected
+    FConnectProfile: TDbConnectProfile;
+    procedure SetConnectProfile(AValue: TDbConnectProfile); virtual;
+  public
     procedure Query(DbRows: TDbRows; Text: string); virtual;
+    procedure LoadTables(Tables: TTables); virtual;
     constructor Create; virtual;
     procedure Load; virtual;
     procedure Save; virtual;
-  end;
-
-  TDatabaseClientClass = class of TDatabaseClient;
+    property ClientType: TDbClientType read GetClientType;
+    property ConnectProfile: TDbConnectProfile read FConnectProfile
+      write SetConnectProfile;
+  end;
+
+  TDbClientClass = class of TDbClient;
 
   TFieldTypeSet = set of TFieldType;
 
-  { TDatabaseEngine }
-
-  TDatabaseEngine = class
+  { TDbClientType }
+
+  TDbClientType = class
     Name: string;
     DataTypes: TDataTypes;
-    DatabaseClientClass: TDatabaseClientClass;
+    DatabaseClientClass: TDbClientClass;
+    ConnectParmasClass: TDbConnectParamsClass;
     procedure UseTypes(ADataTypes: TDataTypes; Types: TFieldTypeSet);
     constructor Create;
@@ -193 +209 @@
   end;
 
-  { TDatabaseEngines }
-
-  TDatabaseEngines = class(TObjectList)
-    function RegisterEngine(Name: string; DatabaseClass: TDatabaseClientClass): TDatabaseEngine;
-    function FindByName(Name: string): TDatabaseEngine;
+  { TDbClientTypes }
+
+  TDbClientTypes = class(TObjectList)
+    function RegisterClientType(Name: string; DatabaseClass: TDbClientClass;
+      ConnectParamsClass: TDbConnectParamsClass): TDbClientType;
+    function FindByName(Name: string): TDbClientType;
   end;
 
@@ -205 +222 @@
   end;
 
+  { TDbManager }
+
+  TDbManager = class
+  private
+    procedure InitClientTypes;
+    procedure InitDataTypes;
+  public
+    ConnectProfiles: TDbConnectProfiles;
+    ClientTypes: TDbClientTypes;
+    DataTypes: TDataTypes;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+resourcestring
+  STypeString = 'String';
+  STypeInteger = 'Integer';
+  STypeFloat = 'Float';
+  STypeBoolean = 'Boolean';
+  STypeMapPosition = 'Map position';
+  STypeImage = 'Image';
+  STypeDate = 'Date';
+  STypeTime = 'Time';
+  STypeDateTime = 'Date and time';
+  STypeReference = 'Reference';
+
 
 implementation
 
 uses
-  UDataTypes;
+  UDataTypes,
+  UEngineXML, UEngineMySQL, UEngineSQLite, UDbClientRegistry;
+
+{ TDbManager }
+
+procedure TDbManager.InitClientTypes;
+var
+  ClientType: TDbClientType;
+begin
+  ClientTypes.Clear;
+
+  ClientType := ClientTypes.RegisterClientType('XML file', TDatabaseXML, TDbConnectParamsXml);
+  ClientType.UseTypes(DataTypes, [ftString, ftInteger, ftDateTime, ftBoolean, ftFloat]);
+
+  ClientType := ClientTypes.RegisterClientType('MySQL', TDatabaseMySQL, TDbConnectParamsMySql);
+  ClientType.UseTypes(DataTypes, [ftString, ftInteger, ftDateTime, ftBoolean, ftFloat,
+    ftReference]);
+
+  ClientType := ClientTypes.RegisterClientType('SQLite', TDatabaseSQLite, TDbConnectParamsSqlite);
+  ClientType.UseTypes(DataTypes, [ftString, ftInteger, ftDateTime, ftBoolean, ftFloat]);
+
+  ClientType := ClientTypes.RegisterClientType('Registry', TDbClientRegistry, TDbConnectParamsRegistry);
+  ClientType.UseTypes(DataTypes, [ftString, ftInteger]);
+end;
+
+procedure TDbManager.InitDataTypes;
+begin
+  DataTypes.Clear;
+  with DataTypes do begin
+    RegisterType(1, 'String', STypeString, ftString, TFieldString);
+    RegisterType(2, 'Integer', STypeInteger, ftInteger, TFieldInteger);
+    RegisterType(3, 'DateTime', STypeDateTime, ftDateTime, TFieldDateTime);
+    RegisterType(4, 'Boolean', STypeBoolean, ftBoolean, TFieldBoolean);
+    RegisterType(5, 'Float', STypeFloat, ftFloat, TFieldFloat);
+    RegisterType(6, 'MapPosition', STypeMapPosition, ftMapPosition, TFieldMapPosition);
+    RegisterType(7, 'Date', STypeDate, ftDate, TFieldDate);
+    RegisterType(8, 'Time', STypeTime, ftTime, TFieldTime);
+    RegisterType(9, 'Image', STypeImage, ftImage, TFieldImage);
+    RegisterType(10, 'Reference', STypeReference, ftReference, TFieldReference);
+  end;
+end;
+
+constructor TDbManager.Create;
+begin
+  ConnectProfiles := TDbConnectProfiles.Create;
+  ConnectProfiles.DbManager := Self;
+  ClientTypes := TDbClientTypes.Create;
+  DataTypes := TDataTypes.Create;
+  InitDataTypes;
+  InitClientTypes;
+end;
+
+destructor TDbManager.Destroy;
+begin
+  DataTypes.Free;
+  ClientTypes.Free;
+  ConnectProfiles.Free;
+  inherited Destroy;
+end;
+
+{ TDbConnectParams }
+
+procedure TDbConnectParams.SetConnectionString(AValue: string);
+begin
+  if FConnectionString = AValue then Exit;
+  FConnectionString := AValue;
+end;
+
+function TDbConnectParams.GetConnectionString: string;
+begin
+  Result := FConnectionString;
+end;
+
+{ TDbConnectProfiles }
+
+procedure TDbConnectProfiles.LoadFromRegistry(Context: TRegistryContext);
+var
+  I: Integer;
+  ConnectProfile: TDbConnectProfile;
+  ClientType: TDbClientType;
+begin
+  with TRegistryEx.Create do
+  try
+    CurrentContext := Context;
+    Count := GetValue('Count', 0);
+    for I := 0 to Count - 1 do begin
+      OpenKey(Context.Key + '\Item' + IntToStr(I), True);
+      ClientType := DbManager.ClientTypes.FindByName(GetValue('ClientType', ''));
+      if not Assigned(ClientType) and (DbManager.ClientTypes.Count > 0) then
+        ClientType := TDbClientType(DbManager.ClientTypes[0]);
+
+      ConnectProfile := TDbConnectProfile.Create;
+      ConnectProfile.ClientType := ClientType;
+      ConnectProfile.Name := GetValue('Name', '');
+      ConnectProfile.Params.ConnectionString := GetValue('ConnectionString', '');
+      Items[I] := ConnectProfile;
+    end;
+  finally
+    Free;
+  end;
+end;
+
+procedure TDbConnectProfiles.SaveToRegistry(Context: TRegistryContext);
+var
+  I: Integer;
+begin
+  with TRegistryEx.Create do
+  try
+    CurrentContext := Context;
+    SetValue('Count', Count);
+    for I := 0 to Count - 1 do begin
+      OpenKey(Context.Key + '\Item' + IntToStr(I), True);
+      SetValue('Name', TDbConnectProfile(Items[I]).Name);
+      SetValue('ConnectionString', TDbConnectProfile(Items[I]).Params.ConnectionString);
+      SetValue('ClientType', TDbConnectProfile(Items[I]).ClientType.Name);
+    end;
+  finally
+    Free;
+  end;
+end;
+
+function TDbConnectProfiles.FindByName(Name: string): TDbConnectProfile;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TDbConnectProfile(Items[I]).Name <> Name) do Inc(I);
+  if (I < Count) then Result := TDbConnectProfile(Items[I])
+    else Result := nil;
+end;
+
+{ TDbConnectProfile }
+
+procedure TDbConnectProfile.SetClientType(AValue: TDbClientType);
+begin
+  if FClientType = AValue then Exit;
+  if Assigned(FClientType) then begin
+    Params.Free;
+  end;
+  FClientType := AValue;
+  if Assigned(FClientType) then begin
+    Params := FClientType.ConnectParmasClass.Create;
+  end;
+end;
 
 { TTables }
@@ -223 +409 @@
 end;
 
-{ TDatabases }
-
-function TDatabases.FindByName(Name: string): TDatabase;
-var
-  I: Integer;
-begin
-  I := 0;
-  while (I < Count) and (TDatabase(Items[I]).Name <> Name) do Inc(I);
-  if (I < Count) then Result := TDatabase(Items[I])
-    else Result := nil;
-end;
-
-{ TDatabaseClient }
-
-procedure TDatabaseClient.Query(DbRows: TDbRows; Text: string);
-begin
-end;
-
-constructor TDatabaseClient.Create;
-begin
-end;
-
-procedure TDatabaseClient.Load;
-begin
-
-end;
-
-procedure TDatabaseClient.Save;
-begin
-
-end;
-
-{ TDatabaseEngines }
-
-function TDatabaseEngines.RegisterEngine(Name: string;
-  DatabaseClass: TDatabaseClientClass): TDatabaseEngine;
-begin
-  Result := TDatabaseEngine.Create;
+{ TDbClient }
+
+function TDbClient.GetClientType: TDbClientType;
+begin
+  Result := FConnectProfile.ClientType;
+end;
+
+procedure TDbClient.SetConnectProfile(AValue: TDbConnectProfile);
+begin
+  if FConnectProfile = AValue then Exit;
+  FConnectProfile := AValue;
+end;
+
+procedure TDbClient.Query(DbRows: TDbRows; Text: string);
+begin
+end;
+
+procedure TDbClient.LoadTables(Tables: TTables);
+begin
+  Tables.Clear;
+end;
+
+constructor TDbClient.Create;
+begin
+  inherited;
+end;
+
+procedure TDbClient.Load;
+begin
+
+end;
+
+procedure TDbClient.Save;
+begin
+
+end;
+
+{ TDbClientTypes }
+
+function TDbClientTypes.RegisterClientType(Name: string;
+  DatabaseClass: TDbClientClass; ConnectParamsClass: TDbConnectParamsClass): TDbClientType;
+begin
+  Result := TDbClientType.Create;
   Result.Name := Name;
   Result.DatabaseClientClass := DatabaseClass;
+  Result.ConnectParmasClass := ConnectParamsClass;
   Add(Result);
 end;
 
-function TDatabaseEngines.FindByName(Name: string): TDatabaseEngine;
+function TDbClientTypes.FindByName(Name: string): TDbClientType;
 var
   I: Integer;
 begin
   I := 0;
-  while (I < Count) and (TDatabaseEngine(Items[I]).Name <> Name) do Inc(I);
-  if I < Count then Result := TDatabaseEngine(Items[I])
+  while (I < Count) and (TDbClientType(Items[I]).Name <> Name) do Inc(I);
+  if I < Count then Result := TDbClientType(Items[I])
     else Result := nil;
 end;
@@ -310 +502 @@
 end;
 
-{ TDatabaseEngine }
-
-procedure TDatabaseEngine.UseTypes(ADataTypes: TDataTypes; Types: TFieldTypeSet);
+{ TDbClientType }
+
+procedure TDbClientType.UseTypes(ADataTypes: TDataTypes; Types: TFieldTypeSet);
 var
   I: TFieldType;
@@ -321 +513 @@
 end;
 
-constructor TDatabaseEngine.Create;
+constructor TDbClientType.Create;
 begin
   DataTypes := TDataTypes.Create;
@@ -327 +519 @@
 end;
 
-destructor TDatabaseEngine.Destroy;
+destructor TDbClientType.Destroy;
 begin
   DataTypes.Free;
@@ -506 +698 @@
   Records.Clear;
   DbRows := TDbRows.Create;
-  Database.Client.Query(DbRows, 'SELECT * FROM ' + Name);
+  DbClient.Query(DbRows, 'SELECT * FROM ' + Name);
   for I := 0 to DbRows.Count - 1 do begin
     NewRecord := TRecord.Create;
@@ -531 +723 @@
   Records.Clear;
   DbRows := TDbRows.Create;
-  Database.Client.Query(DbRows, 'SELECT COUNT(*) FROM ' + Name);
+  DbClient.Query(DbRows, 'SELECT COUNT(*) FROM ' + Name);
   if DbRows.Count = 1 then begin
     RecordsCount := StrToInt(TDictionaryStringString(DbRows[0]).Items[0].Value);
@@ -561 +753 @@
 end;
 
-{ TDatabase }
-
-procedure TDatabase.SetEngine(AValue: TDatabaseEngine);
-begin
-  if FEngine = AValue then Exit;
-  if Assigned(Client) then
-    Client.Free;
-  FEngine := AValue;
-  if Assigned(FEngine) then begin
-    Client := Engine.DatabaseClientClass.Create;
-    Client.Database := Self;
-  end;
-end;
-
-constructor TDatabase.Create;
-begin
-  Tables := TTables.Create;
-  Tables.Database := Self;
-  Engine := nil;
-end;
-
-destructor TDatabase.Destroy;
-begin
-  Engine := nil;
-  Tables.Free;
-  inherited Destroy;
-end;
-
-procedure TDatabase.Load;
-begin
-  if Assigned(Client) then Client.Load;
-end;
-
-procedure TDatabase.Save;
-begin
-  if Assigned(Client) then Client.Save;
-end;
-
-procedure TDatabase.Clear;
-begin
-  Tables.Clear;
-end;
-
 end.