Skip to content

Commit

Permalink
v3.57
Browse files Browse the repository at this point in the history
  • Loading branch information
@huzgd
huzgd committed Feb 24, 2024
1 parent b9a5fe9 commit 9bb9e69
Show file tree
Hide file tree
Showing 59 changed files with 2,946 additions and 1,015 deletions.
88 changes: 69 additions & 19 deletions DML/CtMetaTable.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -329,7 +329,8 @@ TCtMetaTable = class(TCtMetaObject)
AQuotDbType: string = ''): string;
function GetPossibleKeyName(keyFieldTp: TCtKeyFieldType): string;
function GetTitleFieldName: string;
function IsSeqNeeded: boolean; virtual;
function IsSeqNeeded: boolean; virtual;
function IsGroup: boolean; virtual;
function IsText: boolean; virtual;
function IsTable: boolean; virtual;
function IsSqlText: boolean; virtual;
Expand Down Expand Up @@ -521,6 +522,7 @@ TCtMetaField = class(TCtMetaObject)
FUILogic: string;
FOldName: string;
FIsHidden: boolean;
function GetRelateTableRealName: string;
procedure SetRelateTable(AValue: string);
protected
FValueMin: string;
Expand Down Expand Up @@ -656,6 +658,8 @@ TCtMetaField = class(TCtMetaObject)
property KeyFieldType: TCtKeyFieldType read FKeyFieldType write FKeyFieldType;
//关联表
property RelateTable: string read FRelateTable write SetRelateTable;
//关联表的物理名
property RelateTableRealName: string read GetRelateTableRealName;
//关联字段
property RelateField: string read FRelateField write FRelateField;
//索引类型_0无1唯一2普通
Expand Down Expand Up @@ -1091,6 +1095,7 @@ function IsTbPropDefViewMode: boolean;
CtCustFieldDataGenRules: array of string;
FGlobeDataModelList: TCtDataModelGraphList;
G_LastMetaDbSchema: string;
G_OdbcCharset: string;
G_CheckForUpdates: boolean;
G_CreateSeqForOracle: boolean;
G_GenSqlSketchMode: boolean;
Expand Down Expand Up @@ -1411,7 +1416,7 @@ function IsTbPropDefViewMode: boolean;
cfdtFloat, //排序号
cfdtString //其它
);
DEF_TEXT_CLOB_LEN = 1000000;
DEF_TEXT_CLOB_LEN = 99999;
DEF_RESERVED_KEYWORDS =
',action,add,aggregate,all,alter,after,and,as,asc,avg,avg_row_length,auto_increment,between,'
+
Expand Down Expand Up @@ -1942,7 +1947,7 @@ function CheckStringMaxLen(DbType, custTpName: string; var res: string; len: int
Result := False;
if dbType = 'POSTGRESQL' then
begin
if res = 'varchar' then
if LowerCase(res) = 'varchar' then
begin
if len = 0 then
Result := True
Expand All @@ -1959,11 +1964,12 @@ function CheckStringMaxLen(DbType, custTpName: string; var res: string; len: int
begin
if len > 8000 then
begin
if res = 'VARCHAR' then
res := 'VARCHAR(MAX)'
if UpperCase(res) = 'VARCHAR' then
res := res+'(MAX)'
else
res := 'TEXT';
if Trim(custTpName) <> '' then
if UpperCase(Trim(custTpName))<>'VARCHAR' then
res := custTpName;
Result := True;
end;
Expand Down Expand Up @@ -3675,7 +3681,7 @@ function TCtMetaTable.GenSqlEx(bCreatTb: boolean; bFK: boolean; dbType: string;
sFK := sFK + 'alter table ' + vTbn + #13#10 +
' add constraint ' + GetQuotName('FK_' + T) +
' foreign key (' + sFPN + ')' + #13#10 +
' references ' + GetQuotName(F.RelateTable) +
' references ' + GetQuotName(F.RelateTableRealName) +
'(' + GetQuotName(F.RelateField) + ');';
end;
end;
Expand All @@ -3691,7 +3697,7 @@ function TCtMetaTable.GenSqlEx(bCreatTb: boolean; bFK: boolean; dbType: string;
//foreign key(classes_id) references classes(id)
sFdEx := sFdEx + ',' + #13#10 + ExtStr(' ', 6) +
ExtStr('foreign key', 16) + ' (' + sFPN + GetIndexPrefixInfo(F) + ')'
+ ' references ' + F.RelateTable + '(' + F.RelateField + ')';
+ ' references ' + F.RelateTableRealName + '(' + F.RelateField + ')';
end
else if (dbType = 'MYSQL') and (Trim(F.DefaultValue) =
DEF_VAL_auto_increment) then
Expand All @@ -3701,7 +3707,7 @@ function TCtMetaTable.GenSqlEx(bCreatTb: boolean; bFK: boolean; dbType: string;
sFdEx := sFdEx + ',' + #13#10 + ExtStr(' ', 6) +
ExtStr('constraint', 16) + ' ' + GetQuotName('IDU_' + T)
+ ' foreign key(' + sFPN + GetIndexPrefixInfo(F) + ')'
+ ' references ' + F.RelateTable + '(' + F.RelateField + ')';
+ ' references ' + F.RelateTableRealName + '(' + F.RelateField + ')';
end
else if (dbType = 'HIVE') and (G_HiveVersion < 3) then
begin //hive2不支持主外键
Expand All @@ -3713,7 +3719,7 @@ function TCtMetaTable.GenSqlEx(bCreatTb: boolean; bFK: boolean; dbType: string;
sFK := sFK + 'alter table ' + vTbn + #13#10 +
' add constraint ' + GetQuotName('FK_' + T) +
' foreign key (' + sFPN + ')' + #13#10 +
' references ' + GetQuotName(F.RelateTable) +
' references ' + GetQuotName(F.RelateTableRealName) +
'(' + GetQuotName(F.RelateField) + ');';
end;
end;
Expand Down Expand Up @@ -4016,6 +4022,8 @@ function TCtMetaTable.GenSelectSqlEx(maxRowCount: integer;
else
S := S + ' ' + vFdn;
end;
if S='' then
S := ' t.*';
if S <> '' then
if dbType = 'ORACLE' then
S := S + ','#13#10' t.rowid';
Expand Down Expand Up @@ -5344,6 +5352,11 @@ function TCtMetaTable.IsSeqNeeded: boolean;
Result := False;
end;

function TCtMetaTable.IsGroup: boolean;
begin
Result := TypeName = 'GROUP';
end;

function TCtMetaTable.IsSqlText: boolean;
begin
Result := False;
Expand Down Expand Up @@ -5626,6 +5639,11 @@ function TCtMetaTableList.NewTableItem(tp: string): TCtMetaTable;
Result.TypeName := 'TEXT';
Result.Name := Format(srNewTextNameFmt, [Result.ID]);
end
else if (tp = 'GROUP') then
begin
Result.TypeName := 'GROUP';
Result.Name := Format(srNewGroupNameFmt, [Result.ID]);
end
else
begin
if LangIsEnglish then
Expand Down Expand Up @@ -7104,6 +7122,21 @@ procedure TCtMetaField.SetRelateTable(AValue: string);
FRelateTable:=AValue;
end;

function TCtMetaField.GetRelateTableRealName: string;
var
rtb: TCtMetaTable;
begin
Result := RelateTable;
if Result <> '' then
begin
rtb := GetRelateTableObj;
if rtb<>nil then
begin
Result:=rtb.RealTableName;
end;
end;
end;

procedure TCtMetaField.SetDefaultValue(const Value: string);
begin
FDefaultValue := Value;
Expand Down Expand Up @@ -7131,12 +7164,12 @@ function TCtMetaField.GetFieldTypeDesc(bPhy: boolean; dbType: string): string;
begin
//Result := Result + ' primary key'; //removed by huz 20230617: 转为独立声明 CONSTRAINT xxx PRIMARY KEY(xxx)
if (RelateTable <> '') and (RelateField <> '') and (Pos('{Link:', RelateField)=0) then
Result := Result + ' references ' + RelateTable + '(' + RelateField + ')';
Result := Result + ' references ' + RelateTableRealName + '(' + RelateField + ')';
end
else if Self.KeyFieldType = cfktRID then
begin
if (RelateTable <> '') and (RelateField <> '') and (Pos('{Link:', RelateField)=0) then
Result := Result + ' references ' + RelateTable + '(' + RelateField + ')';
Result := Result + ' references ' + RelateTableRealName + '(' + RelateField + ')';
end;
end
else if ((dbType = 'MYSQL') and (Trim(DefaultValue) = DEF_VAL_auto_increment)) then
Expand All @@ -7145,7 +7178,7 @@ function TCtMetaField.GetFieldTypeDesc(bPhy: boolean; dbType: string): string;
begin
Result := Result + ' primary key';
if (RelateTable <> '') and (RelateField <> '') then
Result := Result + ' references ' + RelateTable + '(' + RelateField + ')';
Result := Result + ' references ' + RelateTableRealName + '(' + RelateField + ')';
end;
end;
if Assigned(GProc_OnEzdmlGenFieldTypeDescEvent) then
Expand Down Expand Up @@ -8063,13 +8096,20 @@ function TCtMetaField.GetConstraintStrEx(bWithKeys, bWithRelate: boolean): strin
Result := CheckLRQ(S);
end;

function TCtMetaField.GetFieldComments: string;
function TCtMetaField.GetFieldComments: string;
function IsDivChar(ch: String): boolean;
const
sDivChars='`~!@#$%^&*()-=_+{}[]:"|;''\<>?,./ '#13#10#9;
begin
Result := Pos(ch, sDivChars)>0;
end;
begin
Result := Memo;
if Result <> '' then
begin
if (Name <> '') and (DisplayName <> '') and (Name <> DisplayName) then
Result := DisplayName + ' ' + Result;
if (Pos(DisplayName, Result)<>1) or not IsDivChar(Copy(Result, Length(DisplayName)+1, 1)) then
Result := DisplayName + ' ' + Result;
end
else if DisplayName <> '' then
Result := DisplayName;
Expand Down Expand Up @@ -9650,7 +9690,7 @@ function TCtMetaDatabase.GenObjSql(obj, obj_db: TCtMetaObject; sqlType: integer)
strSQL := 'alter table ' + GetQuotTbName(dmlLsTbObj.RealTableName) + #13#10 +
' add constraint ' + GetQuotName('FK_' + T) +
' foreign key (' + GetQuotName(ctF.Name) + ')' + #13#10 +
' references ' + GetQuotName(ctF.RelateTable) +
' references ' + GetQuotName(ctF.RelateTableRealName) +
'(' + GetQuotName(ctF.RelateField) + ');';
ResFKSQL.Add(strSQL);
end;
Expand Down Expand Up @@ -9728,7 +9768,7 @@ function TCtMetaDatabase.GenObjSql(obj, obj_db: TCtMetaObject; sqlType: integer)
if not bDiff and (ctF.Nullable <> dbF.Nullable) then
if (EngineType<>'HIVE') or (G_HiveVersion>=3) then
bDiff := True;
if not bDiff and (EngineType<>'HIVE') then //HIVE字段的注释与其它属性一起修改
if not bDiff and (EngineType='HIVE') then //HIVE字段的注释与其它属性一起修改
if not MaybeSameStr(dbF.GetFieldComments, ctF.GetFieldComments) then
bDiff := True;
if bDiff then
Expand Down Expand Up @@ -9774,6 +9814,13 @@ function TCtMetaDatabase.GenObjSql(obj, obj_db: TCtMetaObject; sqlType: integer)
else if EngineType = 'HIVE' then
begin
//HIVE统一在修改字段时设置属性
end
else if (EngineType = '') or (EngineType = 'STANDARD') then
begin
//标准SQL不支持注释
ResTbSQL.Add('-- Modify comment of ' + dmlLsTbObj.RealTableName + '.' + dbF.Name);
strSQL := '-- comment: ''' + ReplaceSingleQuotmark(ctF.GetFieldComments) + '''';
ResTbSQL.Add(strSQL);
end
else
begin
Expand Down Expand Up @@ -9807,7 +9854,7 @@ function TCtMetaDatabase.GenObjSql(obj, obj_db: TCtMetaObject; sqlType: integer)
' add constraint ' + GetQuotName('FK_' + T) +
' foreign key (' +
GetQuotName(ctF.Name) + ')' + #13#10 +
' references ' + GetQuotName(ctF.RelateTable) +
' references ' + GetQuotName(ctF.RelateTableRealName) +
'(' + GetQuotName(ctF.RelateField) + ');';
ResFKSQL.Add(strsql);
end;
Expand All @@ -9822,7 +9869,7 @@ function TCtMetaDatabase.GenObjSql(obj, obj_db: TCtMetaObject; sqlType: integer)
strSQL := 'alter table ' + GetQuotTbName(dmlLsTbObj.RealTableName) + #13#10 +
' add constraint ' + GetQuotName('FK_' + T) + ' foreign key (' +
GetQuotName(ctF.Name) + ')' + #13#10 +
' references ' + GetQuotName(ctF.RelateTable) +
' references ' + GetQuotName(ctF.RelateTableRealName) +
'(' + GetQuotName(ctF.RelateField) + ');';
ResFKSQL.Add(strsql);
end;
Expand Down Expand Up @@ -9915,7 +9962,7 @@ function TCtMetaDatabase.GenObjSql(obj, obj_db: TCtMetaObject; sqlType: integer)
strSQL := 'alter table ' + GetQuotTbName(dmlLsTbObj.RealTableName) + #13#10 +
' add constraint ' + GetQuotName('FK_' + T) + ' foreign key (' +
GetQuotName(ctF.Name) + ')' + #13#10 +
' references ' + GetQuotName(ctF.RelateTable) + '(' +
' references ' + GetQuotName(ctF.RelateTableRealName) + '(' +
GetQuotName(ctF.RelateField) + ');';
ResFKSQL.Add(strsql);
end;
Expand Down Expand Up @@ -10220,6 +10267,9 @@ function TCtMetaDatabase.IsDiffField(Fd1, Fd2: TCtMetaField): boolean;
if Fd1.DataType in [cfdtInteger, cfdtBool, cfdtEnum] then
if Fd2.DataType in [cfdtInteger, cfdtBool, cfdtEnum] then
Exit;
if Fd1.DataType in [cfdtFloat] then //数据库浮点和模型整数可以兼容
if Fd2.DataType in [cfdtInteger] then
Exit;
end;
if UpperCase(Fd1.GetFieldTypeDesc(True, EngineType)) =
UpperCase(Fd2.GetFieldTypeDesc(True, EngineType)) then
Expand Down
4 changes: 2 additions & 2 deletions DML/Ctobj/CtObjSerialer.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -177,8 +177,8 @@ TCtObjFileStream = class(TCtObjStream)
end;

const
DEF_CURCTVER = 'CT35';
DEF_CURCTVER_VAL = 35;
DEF_CURCTVER = 'CT36';
DEF_CURCTVER_VAL = 36;
var
{$IFnDEF FPC}
G_SysIsUtf8Encoding: Boolean = False; //系统是否UTF8编码？LAZARUS为TRUE，BDS为FALSE
Expand Down
45 changes: 42 additions & 3 deletions DML/DbConn/CtMetaCustomDb.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,9 @@ interface

uses
LCLIntf, LCLType, Messages, SysUtils, Variants, Classes, Graphics, Controls, ImgList,
CtMetaData, CtMetaTable, DB, memds, uJson;
CtMetaData, CtMetaTable, DB, memds, uJson
//, CtCustomSqlConn
;

type

Expand Down Expand Up @@ -56,7 +58,13 @@ TCtMetaCustomDb = class(TCtMetaDatabase)
TCtMemDataSet=class(TMemDataSet)
protected { IProviderSupport methods }
FSqlText: string;
function PSGetTableName: string; override;
FDsReadOnly: Boolean;
procedure CheckDsReadOnly;
function PSGetTableName: string; override;
procedure DoBeforeDelete; override;
procedure DoBeforeEdit; override;
procedure DoBeforeInsert; override;
procedure DoBeforePost; override;
end;

function ConvertStrToJson(const str: string): TJSONObject;
Expand Down Expand Up @@ -178,6 +186,12 @@ function ConvertStrToJson(const str: string): TJSONObject;

{ TCtMemDataSet }

procedure TCtMemDataSet.CheckDsReadOnly;
begin
if FDsReadOnly then
raise Exception.Create('DataSet is readonly');
end;

function TCtMemDataSet.PSGetTableName: string;
begin
Result:='';
Expand All @@ -187,6 +201,30 @@ function TCtMemDataSet.PSGetTableName: string;
{$endif}
end;

procedure TCtMemDataSet.DoBeforeDelete;
begin
CheckDsReadOnly;
inherited DoBeforeDelete;
end;

procedure TCtMemDataSet.DoBeforeEdit;
begin
CheckDsReadOnly;
inherited DoBeforeEdit;
end;

procedure TCtMemDataSet.DoBeforeInsert;
begin
CheckDsReadOnly;
inherited DoBeforeInsert;
end;

procedure TCtMemDataSet.DoBeforePost;
begin
CheckDsReadOnly;
inherited DoBeforePost;
end;

{ TCtMetaCustomDb }

constructor TCtMetaCustomDb.Create;
Expand Down Expand Up @@ -279,7 +317,8 @@ function TCtMetaCustomDb.OpenTable(ASql, op: string): TDataSet;
S := ASql
else
S := 'select * from ' + ASql;
TCtMemDataSet(Result).FSqlText:=S;
TCtMemDataSet(Result).FSqlText:=S;
TCtMemDataSet(Result).FDsReadOnly:=True;
end;
finally
map.Free;
Expand Down
Loading

0 comments on commit 9bb9e69

Please sign in to comment.