|
@@ -23,7 +23,7 @@ interface
|
|
uses SysUtils, Classes, DB, bufdataset, sqlscript;
|
|
uses SysUtils, Classes, DB, bufdataset, sqlscript;
|
|
|
|
|
|
type
|
|
type
|
|
- TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages, stSchemata);
|
|
|
|
|
|
+ TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages, stSchemata, stSequences);
|
|
|
|
|
|
TStatementType = (stUnknown, stSelect, stInsert, stUpdate, stDelete,
|
|
TStatementType = (stUnknown, stSelect, stInsert, stUpdate, stDelete,
|
|
stDDL, stGetSegment, stPutSegment, stExecProcedure,
|
|
stDDL, stGetSegment, stPutSegment, stExecProcedure,
|
|
@@ -216,6 +216,7 @@ type
|
|
|
|
|
|
procedure UpdateIndexDefs(IndexDefs : TIndexDefs; TableName : string); virtual;
|
|
procedure UpdateIndexDefs(IndexDefs : TIndexDefs; TableName : string); virtual;
|
|
function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
|
|
function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
|
|
|
|
+ function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; virtual;
|
|
|
|
|
|
Procedure MaybeConnect;
|
|
Procedure MaybeConnect;
|
|
|
|
|
|
@@ -234,10 +235,12 @@ type
|
|
procedure GetProcedureNames(List : TStrings); virtual;
|
|
procedure GetProcedureNames(List : TStrings); virtual;
|
|
procedure GetFieldNames(const TableName : string; List : TStrings); virtual;
|
|
procedure GetFieldNames(const TableName : string; List : TStrings); virtual;
|
|
procedure GetSchemaNames(List: TStrings); virtual;
|
|
procedure GetSchemaNames(List: TStrings); virtual;
|
|
|
|
+ procedure GetSequenceNames(List: TStrings); virtual;
|
|
function GetConnectionInfo(InfoType:TConnInfoType): string; virtual;
|
|
function GetConnectionInfo(InfoType:TConnInfoType): string; virtual;
|
|
function GetStatementInfo(const ASQL: string): TSQLStatementInfo; virtual;
|
|
function GetStatementInfo(const ASQL: string): TSQLStatementInfo; virtual;
|
|
procedure CreateDB; virtual;
|
|
procedure CreateDB; virtual;
|
|
procedure DropDB; virtual;
|
|
procedure DropDB; virtual;
|
|
|
|
+ function GetNextValue(const SequenceName: string; IncrementBy: integer=1): Int64; virtual;
|
|
property ConnOptions: TConnOptions read FConnOptions;
|
|
property ConnOptions: TConnOptions read FConnOptions;
|
|
published
|
|
published
|
|
property Password : string read FPassword write FPassword;
|
|
property Password : string read FPassword write FPassword;
|
|
@@ -372,6 +375,31 @@ type
|
|
Property Transaction;
|
|
Property Transaction;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+
|
|
|
|
+ { TSQLSequence }
|
|
|
|
+
|
|
|
|
+ TSQLSequenceApplyEvent = (saeOnNewRecord, saeOnPost);
|
|
|
|
+
|
|
|
|
+ TSQLSequence = class(TPersistent)
|
|
|
|
+ private
|
|
|
|
+ FQuery: TCustomSQLQuery;
|
|
|
|
+ FFieldName: String;
|
|
|
|
+ FSequenceName: String;
|
|
|
|
+ FIncrementBy: Integer;
|
|
|
|
+ FApplyEvent: TSQLSequenceApplyEvent;
|
|
|
|
+ public
|
|
|
|
+ constructor Create(AQuery: TCustomSQLQuery);
|
|
|
|
+ procedure Assign(Source: TPersistent); override;
|
|
|
|
+ procedure Apply;
|
|
|
|
+ function GetNextValue: Int64;
|
|
|
|
+ published
|
|
|
|
+ property FieldName: String read FFieldName write FFieldName;
|
|
|
|
+ property SequenceName: String read FSequenceName write FSequenceName;
|
|
|
|
+ property IncrementBy: Integer read FIncrementBy write FIncrementBy default 1;
|
|
|
|
+ property ApplyEvent: TSQLSequenceApplyEvent read FApplyEvent write FApplyEvent default saeOnNewRecord;
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
{ TCustomSQLQuery }
|
|
{ TCustomSQLQuery }
|
|
|
|
|
|
TSQLQueryOption = (sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit);
|
|
TSQLQueryOption = (sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit);
|
|
@@ -406,6 +434,7 @@ type
|
|
FInsertQry,
|
|
FInsertQry,
|
|
FUpdateQry,
|
|
FUpdateQry,
|
|
FDeleteQry : TCustomSQLStatement;
|
|
FDeleteQry : TCustomSQLStatement;
|
|
|
|
+ FSequence : TSQLSequence;
|
|
procedure FreeFldBuffers;
|
|
procedure FreeFldBuffers;
|
|
function GetParamCheck: Boolean;
|
|
function GetParamCheck: Boolean;
|
|
function GetParams: TParams;
|
|
function GetParams: TParams;
|
|
@@ -464,6 +493,8 @@ type
|
|
procedure BeforeRefreshOpenCursor; override;
|
|
procedure BeforeRefreshOpenCursor; override;
|
|
procedure SetReadOnly(AValue : Boolean); override;
|
|
procedure SetReadOnly(AValue : Boolean); override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
|
|
+ procedure DoOnNewRecord; override;
|
|
|
|
+ procedure DoBeforePost; override;
|
|
class function FieldDefsClass : TFieldDefsClass; override;
|
|
class function FieldDefsClass : TFieldDefsClass; override;
|
|
// IProviderSupport methods
|
|
// IProviderSupport methods
|
|
function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override;
|
|
function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override;
|
|
@@ -531,6 +562,7 @@ type
|
|
property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey default true;
|
|
property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey default true;
|
|
property StatementType : TStatementType read GetStatementType;
|
|
property StatementType : TStatementType read GetStatementType;
|
|
Property DataSource : TDataSource Read GetDataSource Write SetDataSource;
|
|
Property DataSource : TDataSource Read GetDataSource Write SetDataSource;
|
|
|
|
+ property Sequence: TSQLSequence read FSequence write FSequence;
|
|
property ServerFilter: string read FServerFilterText write SetServerFilterText;
|
|
property ServerFilter: string read FServerFilterText write SetServerFilterText;
|
|
property ServerFiltered: Boolean read FServerFiltered write SetServerFiltered default False;
|
|
property ServerFiltered: Boolean read FServerFiltered write SetServerFiltered default False;
|
|
property ServerIndexDefs : TServerIndexDefs read GetServerIndexDefs;
|
|
property ServerIndexDefs : TServerIndexDefs read GetServerIndexDefs;
|
|
@@ -589,6 +621,7 @@ type
|
|
property UpdateMode;
|
|
property UpdateMode;
|
|
property UsePrimaryKeyAsKey;
|
|
property UsePrimaryKeyAsKey;
|
|
Property DataSource;
|
|
Property DataSource;
|
|
|
|
+ property Sequence;
|
|
property ServerFilter;
|
|
property ServerFilter;
|
|
property ServerFiltered;
|
|
property ServerFiltered;
|
|
property ServerIndexDefs;
|
|
property ServerIndexDefs;
|
|
@@ -745,6 +778,7 @@ begin
|
|
Result := Format('%.2d:%.2d:%.2d.%.3d',[hour,minute,second,millisecond]);
|
|
Result := Format('%.2d:%.2d:%.2d.%.3d',[hour,minute,second,millisecond]);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+
|
|
{ TSQLDBFieldDefs }
|
|
{ TSQLDBFieldDefs }
|
|
|
|
|
|
class function TSQLDBFieldDefs.FieldDefClass: TFieldDefClass;
|
|
class function TSQLDBFieldDefs.FieldDefClass: TFieldDefClass;
|
|
@@ -752,6 +786,7 @@ begin
|
|
Result:=TSQLDBFieldDef;
|
|
Result:=TSQLDBFieldDef;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+
|
|
{ TSQLDBParams }
|
|
{ TSQLDBParams }
|
|
|
|
|
|
class function TSQLDBParams.ParamClass: TParamClass;
|
|
class function TSQLDBParams.ParamClass: TParamClass;
|
|
@@ -759,6 +794,7 @@ begin
|
|
Result:=TSQLDBParam;
|
|
Result:=TSQLDBParam;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+
|
|
{ ESQLDatabaseError }
|
|
{ ESQLDatabaseError }
|
|
|
|
|
|
constructor ESQLDatabaseError.CreateFmt(const Fmt: string; const Args: array of const;
|
|
constructor ESQLDatabaseError.CreateFmt(const Fmt: string; const Args: array of const;
|
|
@@ -782,8 +818,6 @@ begin
|
|
SQLState := ASQLState;
|
|
SQLState := ASQLState;
|
|
end;
|
|
end;
|
|
|
|
|
|
-Type
|
|
|
|
- TInternalTransaction = Class(TSQLTransaction);
|
|
|
|
|
|
|
|
{ TCustomSQLStatement }
|
|
{ TCustomSQLStatement }
|
|
|
|
|
|
@@ -976,8 +1010,6 @@ begin
|
|
Result:=False;
|
|
Result:=False;
|
|
end;
|
|
end;
|
|
|
|
|
|
-
|
|
|
|
-
|
|
|
|
procedure TCustomSQLStatement.GetStatementInfo(var ASQL: String; out Info: TSQLStatementInfo);
|
|
procedure TCustomSQLStatement.GetStatementInfo(var ASQL: String; out Info: TSQLStatementInfo);
|
|
|
|
|
|
begin
|
|
begin
|
|
@@ -1090,6 +1122,7 @@ begin
|
|
Result:=FRowsAffected;
|
|
Result:=FRowsAffected;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+
|
|
{ TSQLConnection }
|
|
{ TSQLConnection }
|
|
|
|
|
|
constructor TSQLConnection.Create(AOwner: TComponent);
|
|
constructor TSQLConnection.Create(AOwner: TComponent);
|
|
@@ -1287,6 +1320,11 @@ begin
|
|
GetDBInfo(stSchemata,'','SCHEMA_NAME',List);
|
|
GetDBInfo(stSchemata,'','SCHEMA_NAME',List);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+procedure TSQLConnection.GetSequenceNames(List: TStrings);
|
|
|
|
+begin
|
|
|
|
+ GetDBInfo(stSequences,'','SEQUENCE_NAME',List);
|
|
|
|
+end;
|
|
|
|
+
|
|
function TSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
|
|
function TSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
|
|
var i: TConnInfoType;
|
|
var i: TConnInfoType;
|
|
begin
|
|
begin
|
|
@@ -1509,12 +1547,12 @@ begin
|
|
Result := nil;
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
|
|
-Function TSQLConnection.LogEvent(EventType: TDBEventType): Boolean;
|
|
|
|
|
|
+function TSQLConnection.LogEvent(EventType: TDBEventType): Boolean;
|
|
begin
|
|
begin
|
|
Result:=(Assigned(FOnLog) or Assigned(GlobalDBLogHook)) and (EventType in LogEvents);
|
|
Result:=(Assigned(FOnLog) or Assigned(GlobalDBLogHook)) and (EventType in LogEvents);
|
|
end;
|
|
end;
|
|
|
|
|
|
-Procedure TSQLConnection.Log(EventType: TDBEventType; Const Msg: String);
|
|
|
|
|
|
+procedure TSQLConnection.Log(EventType: TDBEventType; const Msg: String);
|
|
|
|
|
|
Var
|
|
Var
|
|
M : String;
|
|
M : String;
|
|
@@ -1535,13 +1573,13 @@ begin
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
-Procedure TSQLConnection.RegisterStatement(S: TCustomSQLStatement);
|
|
|
|
|
|
+procedure TSQLConnection.RegisterStatement(S: TCustomSQLStatement);
|
|
begin
|
|
begin
|
|
if FStatements.IndexOf(S)=-1 then
|
|
if FStatements.IndexOf(S)=-1 then
|
|
FStatements.Add(S);
|
|
FStatements.Add(S);
|
|
end;
|
|
end;
|
|
|
|
|
|
-Procedure TSQLConnection.UnRegisterStatement(S: TCustomSQLStatement);
|
|
|
|
|
|
+procedure TSQLConnection.UnRegisterStatement(S: TCustomSQLStatement);
|
|
begin
|
|
begin
|
|
if Assigned(FStatements) then // Can be nil, when we are destroying and datasets are uncoupled.
|
|
if Assigned(FStatements) then // Can be nil, when we are destroying and datasets are uncoupled.
|
|
FStatements.Remove(S);
|
|
FStatements.Remove(S);
|
|
@@ -1764,11 +1802,36 @@ begin
|
|
case SchemaType of
|
|
case SchemaType of
|
|
stProcedures: Result := 'SELECT *, ROUTINE_NAME AS PROCEDURE_NAME FROM INFORMATION_SCHEMA.ROUTINES';
|
|
stProcedures: Result := 'SELECT *, ROUTINE_NAME AS PROCEDURE_NAME FROM INFORMATION_SCHEMA.ROUTINES';
|
|
stSchemata : Result := 'SELECT * FROM INFORMATION_SCHEMA.SCHEMATA';
|
|
stSchemata : Result := 'SELECT * FROM INFORMATION_SCHEMA.SCHEMATA';
|
|
|
|
+ stSequences : Result := 'SELECT * FROM INFORMATION_SCHEMA.SEQUENCES';
|
|
else DatabaseError(SMetadataUnavailable);
|
|
else DatabaseError(SMetadataUnavailable);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
-Procedure TSQLConnection.MaybeConnect;
|
|
|
|
|
|
+function TSQLConnection.GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
|
|
|
|
+begin
|
|
|
|
+ Result := 'SELECT NEXT VALUE FOR ' + SequenceName;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+function TSQLConnection.GetNextValue(const SequenceName: string; IncrementBy: integer): Int64;
|
|
|
|
+var
|
|
|
|
+ Q: TCustomSQLQuery;
|
|
|
|
+begin
|
|
|
|
+ Result := 0;
|
|
|
|
+ Q := TCustomSQLQuery.Create(nil);
|
|
|
|
+ try
|
|
|
|
+ Q.DataBase := Self;
|
|
|
|
+ Q.Transaction := Transaction;
|
|
|
|
+ Q.SQL.Text := GetNextValueSQL(SequenceName, IncrementBy);
|
|
|
|
+ Q.Open;
|
|
|
|
+ if not Q.Eof then
|
|
|
|
+ Result := Q.Fields[0].AsLargeInt;
|
|
|
|
+ Q.Close;
|
|
|
|
+ finally
|
|
|
|
+ FreeAndNil(Q);
|
|
|
|
+ end;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+procedure TSQLConnection.MaybeConnect;
|
|
begin
|
|
begin
|
|
If Not Connected then
|
|
If Not Connected then
|
|
begin
|
|
begin
|
|
@@ -1790,6 +1853,7 @@ begin
|
|
DatabaseError(SNotSupported);
|
|
DatabaseError(SNotSupported);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+
|
|
{ TSQLTransaction }
|
|
{ TSQLTransaction }
|
|
|
|
|
|
procedure TSQLTransaction.EndTransaction;
|
|
procedure TSQLTransaction.EndTransaction;
|
|
@@ -1995,6 +2059,50 @@ begin
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
+{ TSQLSequence }
|
|
|
|
+
|
|
|
|
+constructor TSQLSequence.Create(AQuery: TCustomSQLQuery);
|
|
|
|
+begin
|
|
|
|
+ inherited Create;
|
|
|
|
+ FQuery := AQuery;
|
|
|
|
+ FApplyEvent := saeOnNewRecord;
|
|
|
|
+ FIncrementBy := 1;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+procedure TSQLSequence.Assign(Source: TPersistent);
|
|
|
|
+var SourceSequence: TSQLSequence;
|
|
|
|
+begin
|
|
|
|
+ if Source is TSQLSequence then
|
|
|
|
+ begin
|
|
|
|
+ SourceSequence := TSQLSequence(Source);
|
|
|
|
+ FFieldName := SourceSequence.FieldName;
|
|
|
|
+ FSequenceName := SourceSequence.SequenceName;
|
|
|
|
+ FIncrementBy := SourceSequence.IncrementBy;
|
|
|
|
+ FApplyEvent := SourceSequence.ApplyEvent;
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ inherited;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+procedure TSQLSequence.Apply;
|
|
|
|
+var Field: TField;
|
|
|
|
+begin
|
|
|
|
+ if Assigned(FQuery) and (FSequenceName<>'') and (FFieldName<>'') then
|
|
|
|
+ begin
|
|
|
|
+ Field := FQuery.FindField(FFieldName);
|
|
|
|
+ if Assigned(Field) and Field.IsNull then
|
|
|
|
+ Field.AsLargeInt := GetNextValue;
|
|
|
|
+ end;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+function TSQLSequence.GetNextValue: Int64;
|
|
|
|
+begin
|
|
|
|
+ if (FQuery=Nil) or (FQuery.SQLConnection=Nil) then
|
|
|
|
+ DatabaseError(SErrDatabasenAssigned);
|
|
|
|
+ Result := FQuery.SQLConnection.GetNextValue(FSequenceName, FIncrementBy);
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+
|
|
Type
|
|
Type
|
|
|
|
|
|
{ TQuerySQLStatement }
|
|
{ TQuerySQLStatement }
|
|
@@ -2096,6 +2204,7 @@ begin
|
|
FRefreshSQL := TStringList.Create;
|
|
FRefreshSQL := TStringList.Create;
|
|
FRefreshSQL.OnChange := @OnChangeModifySQL;
|
|
FRefreshSQL.OnChange := @OnChangeModifySQL;
|
|
|
|
|
|
|
|
+ FSequence := TSQLSequence.Create(Self);
|
|
FServerIndexDefs := TServerIndexDefs.Create(Self);
|
|
FServerIndexDefs := TServerIndexDefs.Create(Self);
|
|
|
|
|
|
FServerFiltered := False;
|
|
FServerFiltered := False;
|
|
@@ -2120,7 +2229,8 @@ begin
|
|
FreeAndNil(FUpdateSQL);
|
|
FreeAndNil(FUpdateSQL);
|
|
FreeAndNil(FDeleteSQL);
|
|
FreeAndNil(FDeleteSQL);
|
|
FreeAndNil(FRefreshSQL);
|
|
FreeAndNil(FRefreshSQL);
|
|
- FServerIndexDefs.Free;
|
|
|
|
|
|
+ FreeAndNil(FSequence);
|
|
|
|
+ FreeAndNil(FServerIndexDefs);
|
|
inherited Destroy;
|
|
inherited Destroy;
|
|
end;
|
|
end;
|
|
|
|
|
|
@@ -2823,6 +2933,20 @@ begin
|
|
DataSource:=Nil;
|
|
DataSource:=Nil;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+procedure TCustomSQLQuery.DoOnNewRecord;
|
|
|
|
+begin
|
|
|
|
+ inherited;
|
|
|
|
+ if FSequence.ApplyEvent = saeOnNewRecord then
|
|
|
|
+ FSequence.Apply;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+procedure TCustomSQLQuery.DoBeforePost;
|
|
|
|
+begin
|
|
|
|
+ if (State = dsInsert) and (FSequence.ApplyEvent = saeOnPost) then
|
|
|
|
+ FSequence.Apply;
|
|
|
|
+ inherited;
|
|
|
|
+end;
|
|
|
|
+
|
|
function TCustomSQLQuery.PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError;
|
|
function TCustomSQLQuery.PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError;
|
|
var
|
|
var
|
|
PrevErrorCode, ErrorCode: Integer;
|
|
PrevErrorCode, ErrorCode: Integer;
|