Changeset 21

Timestamp:

Mar 23, 2018, 3:06:47 PM (6 years ago)

Author:

chronos

Message:

• Modified: Allow to create and remove tables for XML backend.

Location:

trunk

Files:

• DbEngines/UEngineMySQL.pas (modified) (3 diffs)
• DbEngines/UEngineXML.pas (modified) (6 diffs)
• Forms/UFormTables.lfm (modified) (1 diff)
• Forms/UFormTables.pas (modified) (8 diffs)
• UCore.pas (modified) (4 diffs)
• UDatabase.pas (modified) (13 diffs)

trunk/DbEngines/UEngineMySQL.pas

@@ -19 +19 @@
   public
     SqlDatabase: TSqlDatabase;
-    procedure Query(DbRows: TDbRows; Text: string); override;
+    procedure Query(Text: string; DbRows: TDbRows = nil); override;
     constructor Create; override;
     destructor Destroy; override;
@@ -87 +87 @@
       if DbRows2.Count > 0 then begin
         TypeName := TDictionaryStringString(DbRows2[0]).Values['Name'];
-        NewField.DataType := Table.DbClient.ClientType.DataTypes.FindByName(TypeName);
+        NewField.DataType := Table.DbClient.ClientType.DataTypes.SearchByName(TypeName);
         if not Assigned(NewField.DataType) then
-          NewField.DataType := Table.DbClient.ClientType.DataTypes.FindByType(ftString);
+          NewField.DataType := Table.DbClient.ClientType.DataTypes.SearchByType(ftString);
       end else begin
         // Use string as default
-        NewField.DataType := Table.DbClient.ClientType.DataTypes.FindByType(ftString);
+        NewField.DataType := Table.DbClient.ClientType.DataTypes.SearchByType(ftString);
       end;
       Table.Fields.Add(NewField);
@@ -125 +125 @@
 end;
 
-procedure TDatabaseMySQL.Query(DbRows: TDbRows; Text: string);
+procedure TDatabaseMySQL.Query(Text: string; DbRows: TDbRows = nil);
 begin
   SqlDatabase.Query(DbRows, Text);

trunk/DbEngines/UEngineXML.pas

@@ -30 +30 @@
     procedure LoadFromFile(FileName: string);
     procedure SaveToFile(FileName: string);
-    function GetNextPart(var Text: string): string;
+    function GetNextPart(var Text: string; Separator: string = ' '): string;
   protected
   public
-    procedure Query(DbRows: TDbRows; Text: string); override;
+    procedure Query(Text: string; DbRows: TDbRows = nil); override;
     procedure LoadTables(Tables: TTables); override;
     procedure Load; override;
@@ -158 +158 @@
 begin
   Field.Name := ReadString(Node, 'Name', '');
-  Field.DataType := Field.Table.DbClient.ClientType.DataTypes.FindByType(TFieldType(ReadInteger(Node, 'Type', 0)));
+  Field.DataType := Field.Table.DbClient.ClientType.DataTypes.SearchByType(TFieldType(ReadInteger(Node, 'Type', 0)));
   Field.TextBefore := ReadString(Node, 'TextBefore', '');
   Field.TextAfter := ReadString(Node, 'TextAfter', '');
@@ -296 +296 @@
       SaveNodeTables(Tables, NewNode);
     end;
-    ForceDirectories(ExtractFileDir(FileName));
+    if Pos(DirectorySeparator, FileName) > 0 then
+      ForceDirectories(ExtractFileDir(FileName));
     WriteXMLFile(Doc, FileName);
   finally
@@ -303 +304 @@
 end;
 
-function TDatabaseXML.GetNextPart(var Text: string): string;
-begin
-  if Pos(' ', Text) > 0 then begin
-    Result := Trim(Copy(Text, 1, Pos(' ', Text) - 1));
-    Delete(Text, 1, Pos(' ', Text));
+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;
@@ -314 +315 @@
 end;
 
-procedure TDatabaseXML.Query(DbRows: TDbRows; Text: string);
+procedure TDatabaseXML.Query(Text: string; DbRows: TDbRows = nil);
 var
   Command: string;
@@ -348 +349 @@
       end else raise Exception.Create('Unsupported columns ' + Columns + ' specification');
     end else raise Exception.Create('Table ' + TableName + ' not found.');
-  end else raise Exception.Create('Unsupported SQL command ' + Command);
+  end else
+  if Command = 'CREATE' then begin
+    Command := GetNextPart(Text);
+    if Command = 'TABLE' then begin
+      TableName := GetNextPart(Text);
+      Table := TTable.Create;
+      Table.Name := TableName;
+      Table.DbClient := Self;
+      Tables.Add(Table);;
+    end else raise Exception.Create('TABLE keyword expected');
+  end else
+  if Command = 'DROP' then begin
+    Command := GetNextPart(Text);
+    if Command = 'TABLE' then begin
+      TableName := GetNextPart(Text);
+      Table := Tables.SearchByName(TableName);
+      if Assigned(Table) then Tables.Remove(Table)
+      else raise Exception.Create('Table ' + TableName + ' not found');
+    end else raise Exception.Create('TABLE keyword expected');
+  end else
+    raise Exception.Create('Unsupported SQL command ' + Command);
 end;
 
 procedure TDatabaseXML.LoadTables(Tables: TTables);
 begin
-  inherited;
-
+  Tables.Assign(Self.Tables);
 end;
 
 procedure TDatabaseXML.Load;
 begin
+  FileName := TDbConnectParamsXml(ConnectProfile.Params).FileName;
   if FileExists(FileName) then
     LoadFromFile(FileName);

trunk/Forms/UFormTables.lfm

@@ -10 +10 @@
   OnActivate = FormActivate
   OnClose = FormClose
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
   OnShow = FormShow
   LCLVersion = '1.8.0.6'

trunk/Forms/UFormTables.pas

@@ -40 +40 @@
     procedure FormActivate(Sender: TObject);
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
     procedure FormShow(Sender: TObject);
     procedure ListView1Data(Sender: TObject; Item: TListItem);
@@ -45 +47 @@
       Selected: Boolean);
   private
+    FDbClient: TDbClient;
     FTables: TTables;
-    procedure SetTables(AValue: TTables);
+    procedure SetDbClient(AValue: TDbClient);
   public
-    property Tables: TTables read FTables write SetTables;
+    property DbClient: TDbClient read FDbClient write SetDbClient;
+    property Tables: TTables read FTables;
     procedure UpdateInterface;
     procedure ReloadList;
@@ -87 +91 @@
 end;
 
-procedure TFormTables.SetTables(AValue: TTables);
-begin
-  if FTables = AValue then Exit;
-  FTables := AValue;
+procedure TFormTables.SetDbClient(AValue: TDbClient);
+begin
+  if FDbClient = AValue then Exit;
+  FDbClient := AValue;
+  FTables.DbClient := AValue;
   ReloadList;
 end;
@@ -114 +119 @@
   if FormTable.ShowModal = mrOk then begin
     FormTable.Save(NewTable);
-    Tables.Add(NewTable);
+    Tables.DbClient.Query('CREATE TABLE ' + NewTable.Name + ' (ID INTEGER)');
     ReloadList;
   end else NewTable.Free;
@@ -135 +140 @@
     if MessageDlg(SRemoveTable, Format(SRemoveTableConfirm, [TTable(ListView1.Selected.Data).Name]),
     mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
-      Tables.Remove(ListView1.Selected.Data);
+      Tables.DbClient.Query('DROP TABLE ' + TTable(ListView1.Selected.Data).Name);
       ReloadList;
     end;
@@ -201 +206 @@
 procedure TFormTables.FormClose(Sender: TObject; var CloseAction: TCloseAction);
 begin
-  //Tables.DbClient.Save;
+end;
+
+procedure TFormTables.FormCreate(Sender: TObject);
+begin
+  FTables := TTables.Create;
+end;
+
+procedure TFormTables.FormDestroy(Sender: TObject);
+begin
+  FTables.Free;
 end;
 
@@ -208 +222 @@
   I: Integer;
 begin
+  ReloadList;
   for I := 0 to ToolBar1.ButtonCount - 1 do
     ToolBar1.Buttons[I].Hint := ToolBar1.Buttons[I].Caption;
@@ -217 +232 @@
   I: Integer;
 begin
+  if Assigned(DbClient) then DbClient.LoadTables(Tables)
+    else Tables.Clear;
   for I := 0 to Tables.Count - 1 do
     TTable(Tables[I]).LoadRecordsCount;

trunk/UCore.pas

@@ -87 +87 @@
 
 procedure TCore.ADatabaseConnectExecute(Sender: TObject);
-var
-  NewClient: TDbClient;
 begin
   if FormDatabases.ShowModal = mrOk then begin
     DbClient := nil;
-    NewClient := FormDatabases.SelectedProfile.ClientType.DatabaseClientClass.Create;
-    NewClient.ConnectProfile := FormDatabases.SelectedProfile;
-    DbClient := NewClient;
+    DbClient := FormDatabases.SelectedProfile.GetClient;
   end;
 end;
@@ -134 +130 @@
     DbClient.Load;
     Preferences.LastDatabaseName := FDbClient.ConnectProfile.Name;
-    if not Assigned(FormTables.Tables) then
-      FormTables.Tables := TTables.Create;
-    DbClient.LoadTables(FormTables.Tables);
+    FormTables.DbClient := DbClient;
   end;
   UpdateInterface;
@@ -186 +180 @@
     UpdateInterface;
     if Preferences.RememberDatabase then begin
-      ConnectProfile := DbManager.ConnectProfiles.FindByName(Preferences.LastDatabaseName);
-      if Assigned(ConnectProfile) then
-        DbClient := ConnectProfile.ClientType.DatabaseClientClass.Create;
+      ConnectProfile := DbManager.ConnectProfiles.SearchByName(Preferences.LastDatabaseName);
+      if Assigned(ConnectProfile) then begin
+        DbClient := ConnectProfile.GetClient;
+      end;
     end else ADatabaseConnect.Execute;
   end;
@@ -196 +191 @@
 begin
   SaveConfig;
+  DbClient := nil;
 end;
 

trunk/UDatabase.pas

@@ -143 +143 @@
     Name: string;
     Params: TDbConnectParams;
+    destructor Destroy; override;
+    function GetClient: TDbClient;
     property ClientType: TDbClientType read FClientType write SetClientType;
   end;
@@ -152 +154 @@
     procedure LoadFromRegistry(Context: TRegistryContext);
     procedure SaveToRegistry(Context: TRegistryContext);
-    function FindByName(Name: string): TDbConnectProfile;
+    function SearchByName(Name: string): TDbConnectProfile;
   end;
 
@@ -170 +172 @@
     function RegisterType(Id: Integer; Name, Title: string;
       FieldType: TFieldType; FieldTypeClass: TFieldTypeSpecificClass): TDataType;
-    function FindByType(FieldType: TFieldType): TDataType;
-    function FindByName(Name: string): TDataType;
+    function SearchByType(FieldType: TFieldType): TDataType;
+    function SearchByName(Name: string): TDataType;
   end;
 
@@ -183 +185 @@
     procedure SetConnectProfile(AValue: TDbConnectProfile); virtual;
   public
-    procedure Query(DbRows: TDbRows; Text: string); virtual;
+    procedure Query(Text: string; DbRows: TDbRows = nil); virtual;
     procedure LoadTables(Tables: TTables); virtual;
     constructor Create; virtual;
@@ -373 +375 @@
 end;
 
-function TDbConnectProfiles.FindByName(Name: string): TDbConnectProfile;
+function TDbConnectProfiles.SearchByName(Name: string): TDbConnectProfile;
 var
   I: Integer;
@@ -389 +391 @@
   if FClientType = AValue then Exit;
   if Assigned(FClientType) then begin
-    Params.Free;
+    FreeAndNil(Params);
   end;
   FClientType := AValue;
@@ -395 +397 @@
     Params := FClientType.ConnectParmasClass.Create;
   end;
+end;
+
+destructor TDbConnectProfile.Destroy;
+begin
+  ClientType := nil;
+  if Assigned(Params) then Params.Free;
+  inherited Destroy;
+end;
+
+function TDbConnectProfile.GetClient: TDbClient;
+begin
+  Result := ClientType.DatabaseClientClass.Create;
+  Result.ConnectProfile := Self;
 end;
 
@@ -422 +437 @@
 end;
 
-procedure TDbClient.Query(DbRows: TDbRows; Text: string);
+procedure TDbClient.Query(Text: string; DbRows: TDbRows = nil);
 begin
 end;
@@ -482 +497 @@
 end;
 
-function TDataTypes.FindByType(FieldType: TFieldType): TDataType;
+function TDataTypes.SearchByType(FieldType: TFieldType): TDataType;
 var
   I: Integer;
@@ -492 +507 @@
 end;
 
-function TDataTypes.FindByName(Name: string): TDataType;
+function TDataTypes.SearchByName(Name: string): TDataType;
 var
   I: Integer;
@@ -510 +525 @@
   DataTypes.Clear;
   for I := Low(TFieldType) to High(TFieldType) do
-    if I in Types then DataTypes.Add(ADataTypes.FindByType(I));
+    if I in Types then DataTypes.Add(ADataTypes.SearchByType(I));
 end;
 
@@ -698 +713 @@
   Records.Clear;
   DbRows := TDbRows.Create;
-  DbClient.Query(DbRows, 'SELECT * FROM ' + Name);
+  DbClient.Query('SELECT * FROM ' + Name, DbRows);
   for I := 0 to DbRows.Count - 1 do begin
     NewRecord := TRecord.Create;
@@ -723 +738 @@
   Records.Clear;
   DbRows := TDbRows.Create;
-  DbClient.Query(DbRows, 'SELECT COUNT(*) FROM ' + Name);
+  DbClient.Query('SELECT COUNT(*) FROM ' + Name, DbRows);
   if DbRows.Count = 1 then begin
     RecordsCount := StrToInt(TDictionaryStringString(DbRows[0]).Items[0].Value);