Ai
1 Star 1 Fork 1

大量/QuickCore

加入 Gitee
与超过 1200万 开发者一起发现、参与优秀开源项目,私有仓库也完全免费 :)
免费加入
文件
克隆/下载
Quick.Core.Entity.pas 17.63 KB
一键复制 编辑 原始数据 按行查看 历史
Exilon 提交于 2022-02-13 07:30 +08:00 . [global] removed some warnings & hints
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597
{ ***************************************************************************
Copyright (c) 2016-2020 Kike Prez
Unit : Quick.Core.Entity
Description : Core Entity DataBase
Author : Kike Prez
Version : 1.8
Created : 02/11/2019
Modified : 06/06/2020
This file is part of QuickCore: https://github.com/exilon/QuickCore
***************************************************************************
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
*************************************************************************** }
unit Quick.Core.Entity;
{$i QuickCore.inc}
interface
uses
System.SysUtils,
RTTI,
System.Generics.Collections,
Quick.RTTI.Utils,
System.TypInfo,
Quick.Commons,
Quick.Core.Entity.DAO,
Quick.Core.Entity.Database,
Quick.Core.Entity.Factory.Database,
Quick.Core.Entity.Query,
Quick.Core.Identity;
type
TID = Int64;
TAutoID = Quick.Core.Entity.DAO.TAutoID;
IDBSetResult<T : class> = interface(IEntityResult<T>)
['{9F8B912D-EFCC-498F-A929-847C2E117A24}']
end;
TEntity = Quick.Core.Entity.DAO.TEntity;
TEntityTS = Quick.Core.Entity.DAO.TEntityTS;
TEntityDatabase = Quick.Core.Entity.Database.TEntityDataBase;
TEntityModel = Quick.Core.Entity.DAO.TEntityModel;
Key = class(TCustomAttribute);
StringLength = Quick.Core.Entity.DAO.StringLength;
DecimalLength = Quick.Core.Entity.DAO.DecimalLength;
MapField = Quick.Core.Entity.DAO.MapField;
MapName = Quick.Core.Entity.DAO.MapField;
Table = Quick.Core.Entity.DAO.MapField;
TFieldDataType = Quick.Core.Entity.DAO.TFieldDataType;
&Index = class(TCustomAttribute)
private
fFieldnames : TFieldNamesArray;
fIndexOrder : TEntityIndexOrder;
public
constructor Create(const aFieldname : string; aIndexOrder : TEntityIndexOrder = TEntityIndexOrder.orAscending); overload;
constructor Create(const aFieldname1, aFieldname2 : string; aIndexOrder : TEntityIndexOrder = TEntityIndexOrder.orAscending); overload;
constructor Create(aIndexOrder : TEntityIndexOrder = TEntityIndexOrder.orAscending); overload;
constructor Create(aFieldnames : TFieldNamesArray; aIndexOrder : TEntityIndexOrder = TEntityIndexOrder.orAscending); overload;
property FieldNames : TFieldNamesArray read fFieldnames write fFieldnames;
property IndexOrder : TEntityIndexOrder read fIndexOrder write fIndexOrder;
end;
IDBContext = interface
['{EC512E62-77BA-461D-A6D9-FFA8431FBF64}']
function GetDBConnection : TDBConnectionSettings;
procedure SetDBConnection(aValue : TDBConnectionSettings);
function GetModels : TEntityModels;
function GetIndexes : TEntityIndexes;
procedure SetIndexes(aValue : TEntityIndexes);
property Connection : TDBConnectionSettings read GetDBConnection write SetDBConnection;
property Models : TEntityModels read GetModels;
property Indexes : TEntityIndexes read GetIndexes write SetIndexes;
function CreateQuery(aModel : TEntityModel) : IEntityQuery<TEntity>;
function GetTableNames : TArray<string>;
function GetFieldNames(const aTableName : string) : TArray<string>;
function Connect : Boolean;
function IsConnected : Boolean;
function AddOrUpdate(aEntity : TEntity) : Boolean;
function Add(aEntity : TEntity) : Boolean;
function Update(aEntity : TEntity) : Boolean;
function Delete(aEntity : TEntity) : Boolean; overload;
end;
TDBSet<T : class, constructor> = record
private
fDatabase : TEntityDatabase;
fModel : TEntityModel;
function NewQuery : IEntityQuery<T>;
function NewLinQ : IEntityLinqQuery<T>;
public
property Model : TEntityModel read fModel;
procedure SetDatabase(aEntityDatabase : TEntityDatabase; aModel : TEntityModel);
function Eof : Boolean;
function AddOrUpdate(aEntity : TEntity) : Boolean;
function Add(aEntity : TEntity) : Boolean;
function CountResults : Integer;
function Update(aEntity : TEntity) : Boolean; overload;
function Delete(aEntity : TEntity) : Boolean; overload;
function Delete(const aWhere : string) : Boolean; overload;
//LINQ queries
{$IFDEF VALUE_FORMATPARAMS}
function Where(const aFormatSQLWhere: string; const aValuesSQLWhere: array of TValue) : IEntityLinqQuery<T>; overload;
{$ELSE}
function Where(const aFormatSQLWhere: string; const aValuesSQLWhere: array of const) : IEntityLinqQuery<T>; overload;
{$ENDIF}
function Where(const aWhereClause: string) : IEntityLinqQuery<T>; overload;
function SelectFirst : T;
function SelectLast : T;
function Select : IDBSetResult<T>; overload;
function Select(const aFieldNames : string) : IDBSetResult<T>; overload;
function SelectTop(aNumber : Integer) : IDBSetResult<T>;
function Sum(const aFieldname : string) : Int64;
function Count : Int64;
function Update(const aFieldNames : string; const aFieldValues : array of const) : Boolean; overload;
function Delete : Boolean; overload;
function OrderBy(const aFieldValues : string) : IEntityLinqQuery<T>;
function OrderByDescending(const aFieldValues : string) : IEntityLinqQuery<T>;
end;
TDBContext = class(TInterfacedObject,IDBContext)
private
fDatabase : TEntityDatabase;
fDBSets : TDictionary<string,TDBSet<TEntity>>;
procedure GetEntityInfo(aCtx : TRttiContext; aEntityClass : TEntityClass);
protected
function GetDBConnection : TDBConnectionSettings;
procedure SetDBConnection(aValue : TDBConnectionSettings);
function GetModels : TEntityModels;
procedure GetModelsFromContext;
procedure InitializeEntities;
function GetIndexes : TEntityIndexes;
procedure SetIndexes(aValue : TEntityIndexes);
public
constructor Create; overload;
constructor Create(aEntityDatabase : TEntityDatabase); overload;
destructor Destroy; override;
property Database : TEntityDatabase read fDatabase write fDatabase;
property Connection : TDBConnectionSettings read GetDBConnection write SetDBConnection;
property Models : TEntityModels read GetModels;
property Indexes : TEntityIndexes read GetIndexes write SetIndexes;
function CreateQuery(aModel : TEntityModel) : IEntityQuery<TEntity>; virtual;
function GetTableNames : TArray<string>; virtual;
function GetFieldNames(const aTableName : string) : TArray<string>; virtual;
function GetDBSet(const aTableName : string) : TDBSet<TEntity>;
function Connect : Boolean; virtual;
function IsConnected : Boolean; virtual; abstract;
function AddOrUpdate(aEntity : TEntity) : Boolean; virtual;
function Add(aEntity : TEntity) : Boolean; virtual;
function Update(aEntity : TEntity) : Boolean; virtual;
function Delete(aEntity : TEntity) : Boolean; overload; virtual;
end;
{$M+}
TIdentityUser<TKey> = class
private
fId : TKey;
fUserName : string;
fPasswordHash : string;
fOptions : TIdentityOptions;
fRoleId: TKey;
public
property Options : TIdentityOptions read fOptions write fOptions;
published
[Key]
property Id : TKey read fId write fId;
property RoleId : TKey read fRoleId write fRoleId;
[StringLength(50)]
property UserName : string read fUserName write fUserName;
[StringLength(100)]
property PasswordHash : string read fPasswordHash write fPasswordHash;
end;
{$M-}
{$M+}
TIdentityRole<TKey> = class
private
fId : TKey;
fName : string;
published
[Key]
property Id : TKey read fId write fId;
[StringLength(100)]
property Name : string read fName write fName;
end;
{$M-}
TIdentityDbContext<TUser, TRole : class, constructor> = class(TDBContext)
private
fUsers : TDBSet<TUser>;
fRoles : TDBSet<TRole>;
public
property Users : TDBSet<TUser> read fUsers write fUsers;
property Roles : TDBSet<TRole> read fRoles write fRoles;
function IsConnected : Boolean; override;
end;
implementation
{ TDBContext }
constructor TDBContext.Create;
begin
fDBSets := TDictionary<string,TDBSet<TEntity>>.Create;
end;
constructor TDBContext.Create(aEntityDatabase: TEntityDatabase);
begin
Create;
fDatabase := aEntityDatabase;
end;
destructor TDBContext.Destroy;
begin
if Assigned(fDatabase) then fDatabase.Free;
if Assigned(fDBSets) then fDBSets.Free;
inherited;
end;
function TDBContext.GetDBConnection: TDBConnectionSettings;
begin
Result := fDatabase.Connection;
end;
function TDBContext.GetDBSet(const aTableName: string): TDBSet<TEntity>;
begin
if not fDBSets.TryGetValue(aTableName.ToLower,Result) then raise EEntityModelError.CreateFmt('Table "%s" not found in DataBase',[aTableName]);
end;
function TDBContext.GetIndexes: TEntityIndexes;
begin
Result := fDatabase.Indexes;
end;
function TDBContext.GetModels: TEntityModels;
begin
Result := fDatabase.Models;
end;
procedure TDBContext.SetDBConnection(aValue: TDBConnectionSettings);
begin
fDatabase.Connection := aValue;
end;
procedure TDBContext.SetIndexes(aValue: TEntityIndexes);
begin
fDatabase.Indexes := aValue;
end;
procedure TDBContext.GetModelsFromContext;
var
ctx : TRttiContext;
rtype : TRttiType;
rprop : TRttiProperty;
value : TValue;
cname : string;
entityclass : TEntityClass;
attr : TCustomAttribute;
rectype : string;
numTables : Integer;
begin
Models.Clear;
numTables:= 0;
rtype := ctx.GetType(Self.ClassInfo);
if rtype <> nil then
begin
for rprop in rtype.GetProperties do
begin
if True then
if rprop.PropertyType.TypeKind <> tkRecord then continue;
value := rprop.GetValue(Self);
rectype := GetTypeName(value.TypeInfo);
if rectype.StartsWith('TDBSet') then
begin
cname := GetSubString(rectype,'<','>');
entityclass := TEntityClass(TRTTI.FindClass(cname));
//get complex indexes from DBSet
for attr in rprop.GetAttributes do
begin
if attr is &Index then fDatabase.Indexes.Add(entityclass,Index(attr).FieldNames,Index(attr).IndexOrder);
end;
//get DBSet info
GetEntityInfo(ctx,entityclass);
Inc(NumTables);
end;
end;
end;
if numTables = 0 then raise EEntityModelError.Create('No valid models found in DBContext!');
end;
procedure TDBContext.InitializeEntities;
var
ctx : TRttiContext;
rtype : TRttiType;
rprop : TRttiProperty;
value : TValue;
cname : string;
entityclass : TEntityClass;
rRec : TRttiRecordType;
rectype : string;
entityModel : TEntityModel;
dbset : TDBSet<TEntity>;
begin
if not Assigned(fDBSets) then fDBSets := TDictionary<string,TDBSet<TEntity>>.Create
else fDBSets.Clear;
rtype := ctx.GetType(Self.ClassInfo);
if rtype <> nil then
begin
for rprop in rtype.GetProperties do
begin
if rprop.PropertyType.TypeKind <> tkRecord then continue;
value := rprop.GetValue(Self);
rectype := GetTypeName(value.TypeInfo);
if rectype.StartsWith('TDBSet') then
begin
cname := GetSubString(rectype,'<','>');
entityclass := TEntityClass(TRTTI.FindClass(cname));
//create DBSet query
rRec := ctx.GetType(value.TypeInfo).AsRecord;
entityModel := Models.Get(entityclass);
rRec.GetMethod('SetDatabase').Invoke(value,[fDatabase,entityModel]);
rprop.SetValue(Self,value);
//add to dbsets
dbset := TDBSet<TEntity>(value.GetReferenceToRawData^);
fDBSets.Add(entityModel.TableName.ToLower,dbset);
end;
end;
end;
end;
procedure TDBContext.GetEntityInfo(aCtx : TRttiContext; aEntityClass : TEntityClass);
var
rtype : TRttiType;
rprop : TRttiProperty;
attr : TCustomAttribute;
tablename : string;
entityModel : TEntityModel;
numFields : Integer;
begin
tablename := '';
numFields := 0;
rtype := aCtx.GetType(aEntityClass.ClassInfo);
if rtype = nil then raise EEntityModelError.CreateFmt('Cannot get DBSet "%s" Info',[aEntityClass.ClassName]);
//get entity attributes
for attr in rtype.GetAttributes do
begin
if (attr is MapName) or (attr is Table) then tablename := MapField(attr).Name;
end;
fDatabase.Models.Add(aEntityClass,'',tablename);
//get entity properties attributes
for rprop in rtype.GetProperties do
begin
if (rprop.Visibility = TMemberVisibility.mvPublished) and (rprop.IsWritable) then Inc(numFields);
for attr in rprop.GetAttributes do
begin
if attr is Key then
begin
entityModel := GetModels.Get(aEntityClass);
entityModel.PrimaryKey := entityModel.GetFieldByName(rprop.Name);
end
else if attr is &Index then fDatabase.Indexes.Add(aEntityClass,[rprop.Name],index(attr).IndexOrder);
end;
end;
if numFields = 0 then raise EEntityModelError.CreateFmt('No valid fields found in Entity "%s"!',[aEntityClass.ClassName]);
end;
function TDBContext.GetFieldNames(const aTableName: string): TArray<string>;
begin
Result := fDatabase.GetFieldNames(aTableName);
end;
function TDBContext.CreateQuery(aModel: TEntityModel): IEntityQuery<TEntity>;
begin
Result := fDatabase.CreateQuery(aModel);
end;
function TDBContext.GetTableNames: TArray<string>;
begin
Result := fDatabase.GetTableNames;
end;
function TDBContext.Add(aEntity: TEntity): Boolean;
begin
Result := fDatabase.AddOrUpdate(aEntity);
end;
function TDBContext.AddOrUpdate(aEntity: TEntity): Boolean;
begin
Result := fDatabase.AddOrUpdate(aEntity);
end;
function TDBContext.Connect: Boolean;
begin
Result := fDatabase.IsConnected;
if not Result then
begin
GetModelsFromContext;
Result := fDatabase.Connect;
end;
InitializeEntities;
end;
function TDBContext.Update(aEntity: TEntity): Boolean;
begin
Result := fDatabase.Update(aEntity);
end;
function TDBContext.Delete(aEntity: TEntity): Boolean;
begin
Result := fDatabase.Delete(aEntity);
end;
{ Index }
constructor &Index.Create(const aFieldname : string; aIndexOrder : TEntityIndexOrder = TEntityIndexOrder.orAscending);
begin
fFieldnames := [aFieldname];
fIndexOrder := aIndexOrder;
end;
constructor &Index.Create(const aFieldname1, aFieldname2 : string; aIndexOrder : TEntityIndexOrder = TEntityIndexOrder.orAscending);
begin
fFieldNames := [aFieldname1,aFieldname2];
fIndexOrder := aIndexOrder;
end;
constructor &Index.Create(aFieldnames : TFieldNamesArray; aIndexOrder : TEntityIndexOrder = TEntityIndexOrder.orAscending);
begin
fFieldnames := aFieldnames;
fIndexOrder := aIndexOrder;
end;
constructor &Index.Create(aIndexOrder : TEntityIndexOrder = TEntityIndexOrder.orAscending);
begin
fFieldNames := [];
fIndexOrder := aIndexOrder;
end;
{ TDBSet<T> }
function TDBSet<T>.Add(aEntity: TEntity): Boolean;
begin
Result := NewQuery.Add(aEntity);
end;
function TDBSet<T>.AddOrUpdate(aEntity: TEntity): Boolean;
begin
Result := NewQuery.AddOrUpdate(aEntity);
end;
function TDBSet<T>.Count: Int64;
begin
Result := NewLinQ.Count;
end;
function TDBSet<T>.CountResults: Integer;
begin
Result := NewQuery.CountResults;
end;
procedure TDBSet<T>.SetDatabase(aEntityDatabase : TEntityDatabase; aModel : TEntityModel);
begin
fDatabase := aEntityDatabase;
fModel := aModel;
end;
function TDBSet<T>.Delete: Boolean;
begin
Result := NewLinQ.Delete;
end;
function TDBSet<T>.Delete(const aWhere: string): Boolean;
begin
Result := NewQuery.Delete(aWhere);
end;
function TDBSet<T>.Delete(aEntity: TEntity): Boolean;
begin
Result := NewQuery.Delete(aEntity);
end;
function TDBSet<T>.Eof: Boolean;
begin
Result := NewQuery.Eof;
end;
function TDBSet<T>.NewLinQ: IEntityLinqQuery<T>;
begin
Result := TEntityDatabaseFactory.GetQueryInstance<T>(fDatabase,Self.Model);
end;
function TDBSet<T>.NewQuery: IEntityQuery<T>;
begin
Result := TEntityDatabaseFactory.GetQueryInstance<T>(fDatabase,Self.Model);
end;
function TDBSet<T>.OrderBy(const aFieldValues: string): IEntityLinqQuery<T>;
begin
Result := NewLinQ.OrderBy(aFieldValues);
end;
function TDBSet<T>.OrderByDescending(const aFieldValues: string): IEntityLinqQuery<T>;
begin
Result := NewLinQ.OrderByDescending(aFieldValues);
end;
function TDBSet<T>.Select(const aFieldNames: string): IDBSetResult<T>;
begin
Result := IDBSetResult<T>(NewLinQ.Select(aFieldNames));
end;
function TDBSet<T>.Select: IDBSetResult<T>;
begin
Result := IDBSetResult<T>(NewLinQ.Select);
end;
function TDBSet<T>.SelectFirst: T;
begin
Result := NewLinQ.SelectFirst;
end;
function TDBSet<T>.SelectLast: T;
begin
Result := NewLinQ.SelectLast;
end;
function TDBSet<T>.SelectTop(aNumber: Integer): IDBSetResult<T>;
begin
Result := IDBSetResult<T>(NewLinQ.SelectTop(aNumber));
end;
function TDBSet<T>.Sum(const aFieldname: string): Int64;
begin
Result := NewLinQ.Sum(aFieldname);
end;
function TDBSet<T>.Update(const aFieldNames: string; const aFieldValues: array of const): Boolean;
begin
Result := NewLinQ.Update(aFieldNames,aFieldValues);
end;
function TDBSet<T>.Where(const aWhereClause: string): IEntityLinqQuery<T>;
begin
Result := NewLinQ.Where(aWhereClause);
end;
function TDBSet<T>.Update(aEntity: TEntity): Boolean;
begin
Result := NewQuery.Update(aEntity);
end;
{$IFDEF VALUE_FORMATPARAMS}
function TDBSet<T>.Where(const aFormatSQLWhere: string; const aValuesSQLWhere: array of TValue): IEntityLinqQuery<T>;
{$ELSE}
function TDBSet<T>.Where(const aFormatSQLWhere: string; const aValuesSQLWhere: array of const): IEntityLinqQuery<T>;
{$ENDIF}
begin
Result := NewLinQ.Where(aFormatSQLWhere,aValuesSQLWhere);
end;
{ TIdentityDbContext<TUser, TRole> }
function TIdentityDbContext<TUser, TRole>.IsConnected: Boolean;
begin
Result := fDatabase.IsConnected;
end;
end.
Loading...
马建仓 AI 助手
尝试更多
代码解读
代码找茬
代码优化
1
https://gitee.com/wzdlsoft/QuickCore.git
git@gitee.com:wzdlsoft/QuickCore.git
wzdlsoft
QuickCore
QuickCore
master

搜索帮助