Changeset 13 for trunk/UDatabase.pas

Timestamp:

Mar 17, 2015, 12:09:11 AM (10 years ago)

Author:

chronos

Message:

• Modified: Now records are loaded from SQL database using SQL query. The query is parsed also by XML database client to load records from XML file.
• Added: Packages Network and Synapse.

File:

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

trunk/UDatabase.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Contnrs, ExtCtrls, StdCtrls, EditBtn, dialogs;
+  Classes, SysUtils, Contnrs, ExtCtrls, StdCtrls, EditBtn, dialogs, USqlDatabase,
+  SpecializedDictionary;
 
 type
@@ -23 +24 @@
     procedure Assign(Source: TValue); virtual;
     function GetString: string; virtual;
+    function SetString(Value: string): string; virtual;
   end;
 
@@ -94 +96 @@
 
   TTable = class
+    Id: Integer;
     Name: string;
     Caption: string;
@@ -99 +102 @@
     Fields: TFields;
     Database: TDatabase;
+    RecordsCount: Integer;
+    procedure LoadRecords;
+    procedure LoadRecordsCount;
     procedure Assign(Source: TTable);
     constructor Create;
@@ -104 +110 @@
   end;
 
+  { TTables }
+
   TTables = class(TObjectList)
     Database: TDatabase;
+    function SearchByName(Name: string): TTable;
   end;
 
@@ -140 +149 @@
 
   TDataType = class
+    Id: Integer;
     Name: string;
     FieldType: TFieldType;
@@ -148 +158 @@
 
   TDataTypes = class(TObjectList)
-    function RegisterType(Name: string; FieldType: TFieldType; FieldTypeClass: TFieldTypeSpecificClass): TDataType;
+    function RegisterType(Id: Integer; Name: string; FieldType: TFieldType; FieldTypeClass: TFieldTypeSpecificClass): TDataType;
     function FindByType(FieldType: TFieldType): TDataType;
   end;
@@ -156 +166 @@
   TDatabaseClient = class
     Database: TDatabase;
+    procedure Query(DbRows: TDbRows; Text: string); virtual;
     constructor Create; virtual;
     procedure Load; virtual;
@@ -194 +205 @@
   UDataTypes;
 
+{ TTables }
+
+function TTables.SearchByName(Name: string): TTable;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TTable(Items[I]).Name <> Name) do Inc(I);
+  if I < Count then Result := TTable(Items[I])
+    else Result := nil;
+end;
+
 { TDatabases }
 
@@ -208 +231 @@
 { TDatabaseClient }
 
+procedure TDatabaseClient.Query(DbRows: TDbRows; Text: string);
+begin
+end;
+
 constructor TDatabaseClient.Create;
 begin
@@ -245 +272 @@
 { TDataTypes }
 
-function TDataTypes.RegisterType(Name: string; FieldType: TFieldType;
+function TDataTypes.RegisterType(Id: Integer; Name: string; FieldType: TFieldType;
   FieldTypeClass: TFieldTypeSpecificClass): TDataType;
 begin
   Result := TDataType.Create;
+  Result.Id := Id;
   Result.Name := Name;
   Result.FieldType := FieldType;
@@ -380 +408 @@
 end;
 
+function TValue.SetString(Value: string): string;
+begin
+
+end;
+
 { TFieldTypeSpecific }
 
@@ -430 +463 @@
 { TTable }
 
+procedure TTable.LoadRecords;
+var
+  DbRows: TDbRows;
+  I: Integer;
+  F: Integer;
+  NewRecord: TRecord;
+  NewValue: TValue;
+begin
+  Records.Clear;
+  DbRows := TDbRows.Create;
+  Database.Client.Query(DbRows, 'SELECT * FROM ' + Name);
+  for I := 0 to DbRows.Count - 1 do begin
+    NewRecord := TRecord.Create;
+    for F := 0 to Fields.Count - 1 do begin
+      NewValue := TField(Fields[F]).GetValueClass.Create;
+      NewValue.SetString(TDictionaryStringString(DbRows[I]).Values[TField(Fields[F]).Name]);
+      NewRecord.Values.Add(NewValue);
+    end;
+    Records.Add(NewRecord);
+  end;
+  DbRows.Free;
+end;
+
+procedure TTable.LoadRecordsCount;
+var
+  DbRows: TDbRows;
+  I: Integer;
+  F: Integer;
+  NewRecord: TRecord;
+  NewValue: TValue;
+begin
+  Records.Clear;
+  DbRows := TDbRows.Create;
+  Database.Client.Query(DbRows, 'SELECT COUNT(*) FROM ' + Name);
+  if DbRows.Count = 1 then begin
+    RecordsCount := StrToInt(TDictionaryStringString(DbRows[0]).Items[0].Value);
+  end else RecordsCount := 0;
+  DbRows.Free;
+end;
+
 procedure TTable.Assign(Source: TTable);
 begin