![(please configure the [header_logo] section in trac.ini)](/MyData/chrome/site/your_project_logo.png){kind=logo}
Changeset 26 for trunk/UDatabase.pas
- Timestamp:
- Sep 10, 2022, 8:03:08 PM (20 months ago)
- Location:
- trunk
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
UDatabase.pas (modified) (31 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk
- Property svn:ignore
-
old new 7 7 heaptrclog.trc 8 8 MyData.exe 9 MyData.dbg 10
-
- Property svn:ignore
-
trunk/UDatabase.pas
r24 r26 1 1 unit UDatabase; 2 2 3 {$mode delphi}4 5 3 interface 6 4 7 5 uses 8 Classes, SysUtils, Contnrs,ExtCtrls, StdCtrls, EditBtn, dialogs, USqlDatabase,9 SpecializedDictionary, URegistry;6 Classes, SysUtils, ExtCtrls, StdCtrls, EditBtn, dialogs, USqlDatabase, 7 URegistry, UGenerics, Generics.Collections; 10 8 11 9 type … … 33 31 { TValues } 34 32 35 TValues = class(TObjectList )33 TValues = class(TObjectList<TValue>) 36 34 procedure Assign(Source: TValues); 37 35 end; … … 73 71 { TFields } 74 72 75 TFields = class(TObjectList )73 TFields = class(TObjectList<TField>) 76 74 Table: TTable; 77 75 function SearchByName(Name: string): TField; … … 94 92 { TRecords } 95 93 96 TRecords = class(TObjectList )94 TRecords = class(TObjectList<TRecord>) 97 95 Parent: TTable; 98 96 procedure Assign(Source: TRecords); … … 121 119 { TTables } 122 120 123 TTables = class(TObjectList )121 TTables = class(TObjectList<TTable>) 124 122 DbClient: TDbClient; 125 123 function SearchByName(Name: string): TTable; … … 158 156 { TDbConnectProfiles } 159 157 160 TDbConnectProfiles = class(TObjectList )158 TDbConnectProfiles = class(TObjectList<TDbConnectProfile>) 161 159 DbManager: TDbManager; 162 160 procedure LoadFromRegistry(Context: TRegistryContext); … … 177 175 { TDataTypes } 178 176 179 TDataTypes = class(TObjectList )177 TDataTypes = class(TObjectList<TDataType>) 180 178 function RegisterType(Id: Integer; Name, Title: string; 181 179 FieldType: TFieldType; FieldTypeClass: TFieldTypeSpecificClass): TDataType; … … 223 221 { TDbClientTypes } 224 222 225 TDbClientTypes = class(TObjectList )223 TDbClientTypes = class(TObjectList<TDbClientType>) 226 224 function RegisterClientType(Name: string; DatabaseClass: TDbClientClass; 227 225 ConnectParamsClass: TDbConnectParamsClass): TDbClientType; … … 265 263 266 264 uses 267 UDataTypes, 268 UEngineXML, UEngineMySQL, UEngineSQLite, UDbClientRegistry; 265 UDataTypes, UEngineXML, UEngineMySQL, UEngineSQLite, UDbClientRegistry; 269 266 270 267 { TDbManager } … … 319 316 destructor TDbManager.Destroy; 320 317 begin 321 DataTypes.Free;322 ClientTypes.Free;323 ConnectProfiles.Free;324 inherited Destroy;318 FreeAndNil(DataTypes); 319 FreeAndNil(ClientTypes); 320 FreeAndNil(ConnectProfiles); 321 inherited; 325 322 end; 326 323 … … 378 375 for I := 0 to Count - 1 do begin 379 376 OpenKey(Context.Key + '\Item' + IntToStr(I), True); 380 SetValue('Name', TDbConnectProfile(Items[I]).Name);381 SetValue('ConnectionString', TDbConnectProfile(Items[I]).Params.ConnectionString);382 SetValue('ClientType', TDbConnectProfile(Items[I]).ClientType.Name);377 SetValue('Name', Items[I].Name); 378 SetValue('ConnectionString', Items[I].Params.ConnectionString); 379 SetValue('ClientType', Items[I].ClientType.Name); 383 380 end; 384 381 finally … … 392 389 begin 393 390 I := 0; 394 while (I < Count) and ( TDbConnectProfile(Items[I]).Name <> Name) do Inc(I);395 if (I < Count) then Result := TDbConnectProfile(Items[I])391 while (I < Count) and (Items[I].Name <> Name) do Inc(I); 392 if (I < Count) then Result := Items[I] 396 393 else Result := nil; 397 394 end; … … 415 412 ClientType := nil; 416 413 if Assigned(Params) then Params.Free; 417 inherited Destroy;414 inherited; 418 415 end; 419 416 … … 432 429 begin 433 430 I := 0; 434 while (I < Count) and ( TTable(Items[I]).Name <> Name) do Inc(I);435 if I < Count then Result := TTable(Items[I])431 while (I < Count) and (Items[I].Name <> Name) do Inc(I); 432 if I < Count then Result := Items[I] 436 433 else Result := nil; 437 434 end; … … 469 466 procedure TDbClient.Load; 470 467 begin 471 472 468 end; 473 469 474 470 procedure TDbClient.Save; 475 471 begin 476 477 472 end; 478 473 … … 494 489 begin 495 490 I := 0; 496 while (I < Count) and ( TDbClientType(Items[I]).Name <> Name) do Inc(I);497 if I < Count then Result := TDbClientType(Items[I])491 while (I < Count) and (Items[I].Name <> Name) do Inc(I); 492 if I < Count then Result := Items[I] 498 493 else Result := nil; 499 494 end; … … 518 513 begin 519 514 I := 0; 520 while (I < Count) and ( TDataType(Items[I]).FieldType <> FieldType) do Inc(I);521 if I < Count then Result := TDataType(Items[I])515 while (I < Count) and (Items[I].FieldType <> FieldType) do Inc(I); 516 if I < Count then Result := Items[I] 522 517 else Result := nil; 523 518 end; … … 528 523 begin 529 524 I := 0; 530 while (I < Count) and ( TDataType(Items[I]).Name <> Name) do Inc(I);531 if I < Count then Result := TDataType(Items[I])525 while (I < Count) and (Items[I].Name <> Name) do Inc(I); 526 if I < Count then Result := Items[I] 532 527 else Result := nil; 533 528 end; … … 552 547 destructor TDbClientType.Destroy; 553 548 begin 554 DataTypes.Free;555 inherited Destroy;549 FreeAndNil(DataTypes); 550 inherited; 556 551 end; 557 552 … … 567 562 for I := OldCount to Count - 1 do 568 563 //ShowMessage(TValue(Source.Items[I]).ClassName); 569 Items[I] := TValueClass( TValue(Source.Items[I]).ClassType).Create;564 Items[I] := TValueClass(Source.Items[I].ClassType).Create; 570 565 for I := 0 to Count - 1 do 571 if TValue(Items[I]).ClassType <> TValue(Source.Items[I]).ClassType then begin572 Items[I] := TValueClass( TValue(Source.Items[I]).ClassType).Create;566 if TValue(Items[I]).ClassType <> Source.Items[I].ClassType then begin 567 Items[I] := TValueClass(Source.Items[I].ClassType).Create; 573 568 end; 574 569 for I := 0 to Source.Count - 1 do begin 575 TValue(Items[I]).Assign(TValue(Source.Items[I]));570 Items[I].Assign(Source.Items[I]); 576 571 end; 577 572 end; … … 589 584 Items[I] := TRecord.Create; 590 585 for I := 0 to Source.Count - 1 do begin 591 TRecord(Items[I]).Assign(TRecord(Source.Items[I]));586 Items[I].Assign(Source.Items[I]); 592 587 end; 593 588 end; … … 604 599 FieldIndex := Parent.Fields.IndexOf(Field); 605 600 I := 0; 606 while (I < Count) and ( TValue(TRecord(Items[I]).Values[FieldIndex]).GetString <> Value) do Inc(I);607 if I < Count then Result := TRecord(Items[I])601 while (I < Count) and (Items[I].Values[FieldIndex].GetString <> Value) do Inc(I); 602 if I < Count then Result := Items[I] 608 603 else Result := nil; 609 604 end; … … 616 611 Result := nil; 617 612 I := 0; 618 while (I < Count) and ( TRecord(Items[I]).Match(Values)) do Inc(I);619 if I < Count then Result := TRecord(Items[I])613 while (I < Count) and (Items[I].Match(Values)) do Inc(I); 614 if I < Count then Result := Items[I] 620 615 else Result := nil; 621 616 end; … … 651 646 Items[I] := TField.Create; 652 647 for I := 0 to Source.Count - 1 do begin 653 TField(Items[I]).Assign(TField(Source.Items[I]));648 Items[I].Assign(Source.Items[I]); 654 649 end; 655 650 end; … … 706 701 destructor TRecord.Destroy; 707 702 begin 708 Values.Free;709 inherited Destroy;703 FreeAndNil(Values); 704 inherited; 710 705 end; 711 706 … … 723 718 procedure TValue.SetString(Value: string); 724 719 begin 725 726 720 end; 727 721 … … 739 733 procedure TFieldTypeSpecific.Assign(Source: TFieldTypeSpecific); 740 734 begin 741 742 735 end; 743 736 … … 786 779 begin 787 780 DataType := nil; 788 inherited Destroy;781 inherited; 789 782 end; 790 783 … … 798 791 NewRecord: TRecord; 799 792 NewValue: TValue; 800 Index: Integer;793 Value: string; 801 794 begin 802 795 Records.Clear; 803 796 DbRows := TDbRows.Create; 804 DbClient.Query('SELECT * FROM ' + Name, DbRows); 805 for I := 0 to DbRows.Count - 1 do begin 806 NewRecord := TRecord.Create; 807 for F := 0 to Fields.Count - 1 do begin 808 NewValue := TField(Fields[F]).GetValueClass.Create; 809 Index := TDictionaryStringString(DbRows[I]).SearchKey(TField(Fields[F]).Name); 810 if Index <> -1 then begin 811 NewValue.SetString(TDictionaryStringString(DbRows[I]).Values[TField(Fields[F]).Name]); 812 NewRecord.Values.Add(NewValue); 813 end else begin 814 //NewValue.SetString(''); 815 NewRecord.Values.Add(NewValue); 797 try 798 DbClient.Query('SELECT * FROM ' + Name, DbRows); 799 for I := 0 to DbRows.Count - 1 do begin 800 NewRecord := TRecord.Create; 801 for F := 0 to Fields.Count - 1 do begin 802 NewValue := Fields[F].GetValueClass.Create; 803 if DbRows[I].TryGetValue(Fields[F].Name, Value) then begin 804 NewValue.SetString(Value); 805 NewRecord.Values.Add(NewValue); 806 end else begin 807 //NewValue.SetString(''); 808 NewRecord.Values.Add(NewValue); 809 end; 816 810 end; 811 Records.Add(NewRecord); 817 812 end; 818 Records.Add(NewRecord);819 end;820 DbRows.Free;813 finally 814 DbRows.Free; 815 end; 821 816 end; 822 817 … … 827 822 Records.Clear; 828 823 DbRows := TDbRows.Create; 829 DbClient.Query('SELECT COUNT(*) FROM ' + Name, DbRows); 830 if DbRows.Count = 1 then begin 831 RecordsCount := StrToInt(TDictionaryStringString(DbRows[0]).Items[0].Value); 832 end else RecordsCount := 0; 833 DbRows.Free; 824 try 825 DbClient.Query('SELECT COUNT(*) AS `Count` FROM ' + Name, DbRows); 826 if DbRows.Count = 1 then begin 827 RecordsCount := StrToInt(DbRows[0].Items['Count']); 828 end else RecordsCount := 0; 829 finally 830 DbRows.Free; 831 end; 834 832 end; 835 833 … … 852 850 destructor TTable.Destroy; 853 851 begin 854 F ields.Free;855 Records.Free;852 FreeAndNil(Fields); 853 FreeAndNil(Records); 856 854 inherited Destroy; 857 855 end;
Note:
See TracChangeset
for help on using the changeset viewer.
