Browse Source

* Patch from Laco with minor modification from bug ID #27251

git-svn-id: trunk@30291 -
michael 10 năm trước cách đây
mục cha
commit
743324f72b

+ 22 - 5
packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -107,9 +107,10 @@ type
     procedure CommitRetaining(trans : TSQLHandle); override;
     procedure CommitRetaining(trans : TSQLHandle); override;
     procedure RollBackRetaining(trans : TSQLHandle); override;
     procedure RollBackRetaining(trans : TSQLHandle); override;
     procedure UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string); override;
     procedure UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string); override;
-    function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); override;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); override;
     function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
     function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
+    function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
+    function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; override;
   public
   public
     constructor Create(AOwner : TComponent); override;
     constructor Create(AOwner : TComponent); override;
     function GetConnectionInfo(InfoType:TConnInfoType): string; override;
     function GetConnectionInfo(InfoType:TConnInfoType): string; override;
@@ -208,7 +209,8 @@ begin
   else result := true;
   else result := true;
 end;
 end;
 
 
-function TIBConnection.StartDBTransaction(trans : TSQLHandle;AParams : String) : boolean;
+function TIBConnection.StartdbTransaction(trans: TSQLHandle; AParams: string
+  ): boolean;
 var
 var
   DBHandle : pointer;
   DBHandle : pointer;
   tr       : TIBTrans;
   tr       : TIBTrans;
@@ -641,7 +643,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-Function TIBConnection.AllocateCursorHandle : TSQLCursor;
+function TIBConnection.AllocateCursorHandle: TSQLCursor;
 
 
 var curs : TIBCursor;
 var curs : TIBCursor;
 
 
@@ -665,7 +667,7 @@ begin
   FreeAndNil(cursor);
   FreeAndNil(cursor);
 end;
 end;
 
 
-Function TIBConnection.AllocateTransactionHandle : TSQLHandle;
+function TIBConnection.AllocateTransactionHandle: TSQLHandle;
 
 
 begin
 begin
   result := TIBTrans.create;
   result := TIBTrans.create;
@@ -1388,12 +1390,27 @@ begin
                           '(r.rdb$system_flag = 0 or r.rdb$system_flag is null) and (rdb$relation_name = ''' + Uppercase(SchemaObjectName) + ''') ' +
                           '(r.rdb$system_flag = 0 or r.rdb$system_flag is null) and (rdb$relation_name = ''' + Uppercase(SchemaObjectName) + ''') ' +
                         'ORDER BY '+
                         'ORDER BY '+
                           'r.rdb$field_name';
                           'r.rdb$field_name';
+    stSequences  : s := 'SELECT ' +
+                          'rdb$generator_id         as recno,' +
+                          '''' + DatabaseName + ''' as sequence_catalog,' +
+                          '''''                     as sequence_schema,' +
+                          'rdb$generator_name       as sequence_name ' +
+                        'FROM ' +
+                          'rdb$generators ' +
+                        'WHERE ' +
+                          'rdb$system_flag = 0 or rdb$system_flag is null ' +
+                        'ORDER BY ' +
+                          'rdb$generator_name';
   else
   else
     DatabaseError(SMetadataUnavailable)
     DatabaseError(SMetadataUnavailable)
   end; {case}
   end; {case}
   result := s;
   result := s;
 end;
 end;
 
 
+function TIBConnection.GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
+begin
+  Result := Format('SELECT gen_id(%s, %d) FROM RDB$DATABASE', [SequenceName, IncrementBy]);
+end;
 
 
 procedure TIBConnection.UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string);
 procedure TIBConnection.UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string);
 
 
@@ -1480,7 +1497,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure TIBConnection.GetFloat(CurrBuff, Buffer : pointer; Size : byte);
+procedure TIBConnection.GetFloat(CurrBuff, Buffer: pointer; Size: Byte);
 var
 var
   Ext : extended;
   Ext : extended;
   Dbl : double;
   Dbl : double;

+ 15 - 9
packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -124,9 +124,10 @@ type
     function StartdbTransaction(trans : TSQLHandle; AParams : string) : boolean; override;
     function StartdbTransaction(trans : TSQLHandle; AParams : string) : boolean; override;
     procedure RollBackRetaining(trans : TSQLHandle); override;
     procedure RollBackRetaining(trans : TSQLHandle); override;
     procedure UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string); override;
     procedure UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string); override;
-    function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor;ATransaction : TSQLTransaction); override;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor;ATransaction : TSQLTransaction); override;
     function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
     function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
+    function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
+    function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; override;
   public
   public
     constructor Create(AOwner : TComponent); override;
     constructor Create(AOwner : TComponent); override;
     destructor Destroy; override;
     destructor Destroy; override;
@@ -332,7 +333,7 @@ begin
 {$EndIf}
 {$EndIf}
 end;
 end;
 
 
-Procedure TPQConnection.GetExtendedFieldInfo(cursor: TPQCursor;
+procedure TPQConnection.GetExtendedFieldInfo(cursor: TPQCursor;
   Bindings: TFieldBindings);
   Bindings: TFieldBindings);
 
 
 Var
 Var
@@ -387,7 +388,7 @@ begin
     P.SQLDBData:=TPQCursor(C).GetFieldBinding(F.FieldDef);
     P.SQLDBData:=TPQCursor(C).GetFieldBinding(F.FieldDef);
 end;
 end;
 
 
-Function TPQConnection.ErrorOnUnknownType: Boolean;
+function TPQConnection.ErrorOnUnknownType: Boolean;
 begin
 begin
   Result:=False;
   Result:=False;
 end;
 end;
@@ -555,8 +556,8 @@ begin
   Result := true;
   Result := true;
 end;
 end;
 
 
-function TPQConnection.StartDBTransaction(trans: TSQLHandle;
-  AParams: string): boolean;
+function TPQConnection.StartdbTransaction(trans: TSQLHandle; AParams: string
+  ): boolean;
 
 
 Var
 Var
   res : PPGresult;
   res : PPGresult;
@@ -724,7 +725,7 @@ begin
 end;
 end;
 
 
 function TPQConnection.TranslateFldType(res: PPGresult; Tuple: integer; out
 function TPQConnection.TranslateFldType(res: PPGresult; Tuple: integer; out
-  Size: integer; Out ATypeOID: oid): TFieldType;
+  Size: integer; out ATypeOID: oid): TFieldType;
 
 
 const
 const
   VARHDRSZ=sizeof(longint);
   VARHDRSZ=sizeof(longint);
@@ -805,18 +806,18 @@ begin
   end;
   end;
 end;
 end;
 
 
-Function TPQConnection.AllocateCursorHandle: TSQLCursor;
+function TPQConnection.AllocateCursorHandle: TSQLCursor;
 
 
 begin
 begin
   result := TPQCursor.create;
   result := TPQCursor.create;
 end;
 end;
 
 
-Procedure TPQConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
+procedure TPQConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
 begin
 begin
   FreeAndNil(cursor);
   FreeAndNil(cursor);
 end;
 end;
 
 
-Function TPQConnection.AllocateTransactionHandle: TSQLHandle;
+function TPQConnection.AllocateTransactionHandle: TSQLHandle;
 
 
 begin
 begin
   result := TPQTrans.create;
   result := TPQTrans.create;
@@ -1495,6 +1496,11 @@ begin
   result := s;
   result := s;
 end;
 end;
 
 
+function TPQConnection.GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
+begin
+  Result := Format('SELECT nextval(''%s'')', [SequenceName]);
+end;
+
 procedure TPQConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef;
 procedure TPQConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef;
   ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
   ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
 var
 var

+ 135 - 11
packages/fcl-db/src/sqldb/sqldb.pp

@@ -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;

+ 63 - 18
packages/fcl-db/tests/testsqldb.pas

@@ -53,6 +53,7 @@ type
     Procedure TestRefreshSQLMultipleRecords;
     Procedure TestRefreshSQLMultipleRecords;
     Procedure TestRefreshSQLNoRecords;
     Procedure TestRefreshSQLNoRecords;
     Procedure TestFetchAutoInc;
     Procedure TestFetchAutoInc;
+    procedure TestSequence;
   end;
   end;
 
 
   { TTestTSQLConnection }
   { TTestTSQLConnection }
@@ -86,7 +87,7 @@ implementation
 
 
 { TTestTSQLQuery }
 { TTestTSQLQuery }
 
 
-Procedure TTestTSQLQuery.Setup;
+procedure TTestTSQLQuery.Setup;
 begin
 begin
   inherited Setup;
   inherited Setup;
   SQLDBConnector.Connection.Options:=[];
   SQLDBConnector.Connection.Options:=[];
@@ -181,7 +182,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-Procedure TTestTSQLQuery.TestKeepOpenOnCommit;
+procedure TTestTSQLQuery.TestKeepOpenOnCommit;
 var Q: TSQLQuery;
 var Q: TSQLQuery;
     I: Integer;
     I: Integer;
 begin
 begin
@@ -219,12 +220,12 @@ begin
     end;
     end;
 end;
 end;
 
 
-Procedure TTestTSQLQuery.TrySetPacketRecords;
+procedure TTestTSQLQuery.TrySetPacketRecords;
 begin
 begin
   FMyQ.PacketRecords:=10;
   FMyQ.PacketRecords:=10;
 end;
 end;
 
 
-Procedure TTestTSQLQuery.TestKeepOpenOnCommitPacketRecords;
+procedure TTestTSQLQuery.TestKeepOpenOnCommitPacketRecords;
 begin
 begin
   with SQLDBConnector do
   with SQLDBConnector do
     begin
     begin
@@ -234,12 +235,12 @@ begin
     end;
     end;
 end;
 end;
 
 
-Procedure TTestTSQLQuery.TrySetQueryOptions;
+procedure TTestTSQLQuery.TrySetQueryOptions;
 begin
 begin
   FMyQ.Options:=[sqoKeepOpenOnCommit];
   FMyQ.Options:=[sqoKeepOpenOnCommit];
 end;
 end;
 
 
-Procedure TTestTSQLQuery.TestCheckSettingsOnlyWhenInactive;
+procedure TTestTSQLQuery.TestCheckSettingsOnlyWhenInactive;
 begin
 begin
   // Check that we can only set QueryOptions when the query is inactive.
   // Check that we can only set QueryOptions when the query is inactive.
   with SQLDBConnector do
   with SQLDBConnector do
@@ -261,7 +262,7 @@ begin
   AssertTrue('Have modifications in after post',FMyq.UpdateStatus=usModified)
   AssertTrue('Have modifications in after post',FMyq.UpdateStatus=usModified)
 end;
 end;
 
 
-Procedure TTestTSQLQuery.TestAutoApplyUpdatesPost;
+procedure TTestTSQLQuery.TestAutoApplyUpdatesPost;
 var Q: TSQLQuery;
 var Q: TSQLQuery;
     I: Integer;
     I: Integer;
 begin
 begin
@@ -296,7 +297,7 @@ begin
 
 
 end;
 end;
 
 
-Procedure TTestTSQLQuery.TestAutoApplyUpdatesDelete;
+procedure TTestTSQLQuery.TestAutoApplyUpdatesDelete;
 
 
 var Q: TSQLQuery;
 var Q: TSQLQuery;
     I: Integer;
     I: Integer;
@@ -328,13 +329,13 @@ begin
     end;
     end;
 end;
 end;
 
 
-Procedure TTestTSQLQuery.DoApplyUpdates;
+procedure TTestTSQLQuery.DoApplyUpdates;
 
 
 begin
 begin
   FMyQ.ApplyUpdates();
   FMyQ.ApplyUpdates();
 end;
 end;
 
 
-Procedure TTestTSQLQuery.TestCheckRowsAffected;
+procedure TTestTSQLQuery.TestCheckRowsAffected;
 var Q: TSQLQuery;
 var Q: TSQLQuery;
     I: Integer;
     I: Integer;
 begin
 begin
@@ -359,7 +360,7 @@ begin
     end;
     end;
 end;
 end;
 
 
-Procedure TTestTSQLQuery.TestAutoCommit;
+procedure TTestTSQLQuery.TestAutoCommit;
 var
 var
   I : Integer;
   I : Integer;
 begin
 begin
@@ -389,7 +390,7 @@ begin
     end;
     end;
 end;
 end;
 
 
-Procedure TTestTSQLQuery.TestRefreshSQL;
+procedure TTestTSQLQuery.TestRefreshSQL;
 var
 var
   Q: TSQLQuery;
   Q: TSQLQuery;
 
 
@@ -424,7 +425,7 @@ begin
   AssertEquals('Field value has been fetched from the database', 1, Q.FieldByName('b').AsInteger);
   AssertEquals('Field value has been fetched from the database', 1, Q.FieldByName('b').AsInteger);
 end;
 end;
 
 
-Procedure TTestTSQLQuery.TestGeneratedRefreshSQL;
+procedure TTestTSQLQuery.TestGeneratedRefreshSQL;
 
 
 var
 var
   Q: TSQLQuery;
   Q: TSQLQuery;
@@ -456,7 +457,7 @@ begin
   AssertEquals('Field value has been fetched from the database ','fgh',Q.FieldByName('b').AsString);
   AssertEquals('Field value has been fetched from the database ','fgh',Q.FieldByName('b').AsString);
 end;
 end;
 
 
-Procedure TTestTSQLQuery.TestGeneratedRefreshSQL1Field;
+procedure TTestTSQLQuery.TestGeneratedRefreshSQL1Field;
 var
 var
   Q: TSQLQuery;
   Q: TSQLQuery;
 
 
@@ -485,7 +486,7 @@ begin
   AssertEquals('Field value b has NOT been fetched from the database ','',Q.FieldByName('b').AsString);
   AssertEquals('Field value b has NOT been fetched from the database ','',Q.FieldByName('b').AsString);
 end;
 end;
 
 
-Procedure TTestTSQLQuery.TestGeneratedRefreshSQLNoKey;
+procedure TTestTSQLQuery.TestGeneratedRefreshSQLNoKey;
 begin
 begin
   with SQLDBConnector do
   with SQLDBConnector do
     begin
     begin
@@ -507,7 +508,7 @@ begin
   AssertException('Cannot refresh without primary key',EUpdateError,@DoApplyUpdates);
   AssertException('Cannot refresh without primary key',EUpdateError,@DoApplyUpdates);
 end;
 end;
 
 
-Procedure TTestTSQLQuery.TestRefreshSQLMultipleRecords;
+procedure TTestTSQLQuery.TestRefreshSQLMultipleRecords;
 
 
 begin
 begin
   with SQLDBConnector do
   with SQLDBConnector do
@@ -534,7 +535,7 @@ begin
   AssertException('Multiple records returned by RefreshSQL gives an error',EUpdateError,@DoApplyUpdates);
   AssertException('Multiple records returned by RefreshSQL gives an error',EUpdateError,@DoApplyUpdates);
 end;
 end;
 
 
-Procedure TTestTSQLQuery.TestRefreshSQLNoRecords;
+procedure TTestTSQLQuery.TestRefreshSQLNoRecords;
 begin
 begin
   with SQLDBConnector do
   with SQLDBConnector do
     begin
     begin
@@ -560,7 +561,7 @@ begin
   AssertException('No records returned by RefreshSQL gives an error',EUpdateError,@DoApplyUpdates);
   AssertException('No records returned by RefreshSQL gives an error',EUpdateError,@DoApplyUpdates);
 end;
 end;
 
 
-Procedure TTestTSQLQuery.TestFetchAutoInc;
+procedure TTestTSQLQuery.TestFetchAutoInc;
 var datatype: string;
 var datatype: string;
     id: largeint;
     id: largeint;
 begin
 begin
@@ -602,6 +603,50 @@ begin
     end;
     end;
 end;
 end;
 
 
+procedure TTestTSQLQuery.TestSequence;
+var SequenceNames : TStringList;
+begin
+  case SQLServerType of
+    ssFirebird:
+      SQLDBConnector.ExecuteDirect('create sequence FPDEV_SEQ1');
+    ssMSSQL, ssOracle, ssPostgreSQL:
+      SQLDBConnector.ExecuteDirect('create sequence FPDEV_SEQ1 MINVALUE 1');
+    else
+      Ignore(STestNotApplicable);
+  end;
+  SQLDBConnector.ExecuteDirect('create table FPDEV2 (id integer)');
+  SQLDBConnector.CommitDDL;
+
+  with SQLDBConnector.Query do
+    begin
+    SQL.Text := 'select * from FPDEV2';
+    Sequence.FieldName:='id';
+    Sequence.SequenceName:='FPDEV_SEQ1';
+    Open;
+    // default is get next value on new record
+    Append;
+    AssertEquals(1, FieldByName('id').AsInteger);
+
+    Sequence.ApplyEvent:=saeOnPost;
+    Append;
+    AssertTrue('Field ID must be null after Append', FieldByName('id').IsNull);
+    Post;
+    AssertEquals(2, FieldByName('id').AsInteger);
+    end;
+
+  // test GetSequenceNames
+  SequenceNames := TStringList.Create;
+  try
+    SQLDBConnector.Connection.GetSequenceNames(SequenceNames);
+    AssertTrue(SequenceNames.IndexOf('FPDEV_SEQ1') >= 0);
+  finally
+    SequenceNames.Free;
+  end;
+
+  SQLDBConnector.ExecuteDirect('drop sequence FPDEV_SEQ1');
+  SQLDBConnector.CommitDDL;
+end;
+
 
 
 { TTestTSQLConnection }
 { TTestTSQLConnection }