mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-23 00:09:31 +02:00
* Patch from Laco with minor modification from bug ID #27251
git-svn-id: trunk@30291 -
This commit is contained in:
michael
parent
ac3aa6b602
commit
743324f72b
@ -107,9 +107,10 @@ type
|
||||
procedure CommitRetaining(trans : TSQLHandle); override;
|
||||
procedure RollBackRetaining(trans : TSQLHandle); 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;
|
||||
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
|
||||
constructor Create(AOwner : TComponent); override;
|
||||
function GetConnectionInfo(InfoType:TConnInfoType): string; override;
|
||||
@ -208,7 +209,8 @@ begin
|
||||
else result := true;
|
||||
end;
|
||||
|
||||
function TIBConnection.StartDBTransaction(trans : TSQLHandle;AParams : String) : boolean;
|
||||
function TIBConnection.StartdbTransaction(trans: TSQLHandle; AParams: string
|
||||
): boolean;
|
||||
var
|
||||
DBHandle : pointer;
|
||||
tr : TIBTrans;
|
||||
@ -641,7 +643,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TIBConnection.AllocateCursorHandle : TSQLCursor;
|
||||
function TIBConnection.AllocateCursorHandle: TSQLCursor;
|
||||
|
||||
var curs : TIBCursor;
|
||||
|
||||
@ -665,7 +667,7 @@ begin
|
||||
FreeAndNil(cursor);
|
||||
end;
|
||||
|
||||
Function TIBConnection.AllocateTransactionHandle : TSQLHandle;
|
||||
function TIBConnection.AllocateTransactionHandle: TSQLHandle;
|
||||
|
||||
begin
|
||||
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) + ''') ' +
|
||||
'ORDER BY '+
|
||||
'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
|
||||
DatabaseError(SMetadataUnavailable)
|
||||
end; {case}
|
||||
result := s;
|
||||
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);
|
||||
|
||||
@ -1480,7 +1497,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TIBConnection.GetFloat(CurrBuff, Buffer : pointer; Size : byte);
|
||||
procedure TIBConnection.GetFloat(CurrBuff, Buffer: pointer; Size: Byte);
|
||||
var
|
||||
Ext : extended;
|
||||
Dbl : double;
|
||||
|
||||
@ -124,9 +124,10 @@ type
|
||||
function StartdbTransaction(trans : TSQLHandle; AParams : string) : boolean; override;
|
||||
procedure RollBackRetaining(trans : TSQLHandle); 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;
|
||||
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
|
||||
constructor Create(AOwner : TComponent); override;
|
||||
destructor Destroy; override;
|
||||
@ -332,7 +333,7 @@ begin
|
||||
{$EndIf}
|
||||
end;
|
||||
|
||||
Procedure TPQConnection.GetExtendedFieldInfo(cursor: TPQCursor;
|
||||
procedure TPQConnection.GetExtendedFieldInfo(cursor: TPQCursor;
|
||||
Bindings: TFieldBindings);
|
||||
|
||||
Var
|
||||
@ -387,7 +388,7 @@ begin
|
||||
P.SQLDBData:=TPQCursor(C).GetFieldBinding(F.FieldDef);
|
||||
end;
|
||||
|
||||
Function TPQConnection.ErrorOnUnknownType: Boolean;
|
||||
function TPQConnection.ErrorOnUnknownType: Boolean;
|
||||
begin
|
||||
Result:=False;
|
||||
end;
|
||||
@ -555,8 +556,8 @@ begin
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
function TPQConnection.StartDBTransaction(trans: TSQLHandle;
|
||||
AParams: string): boolean;
|
||||
function TPQConnection.StartdbTransaction(trans: TSQLHandle; AParams: string
|
||||
): boolean;
|
||||
|
||||
Var
|
||||
res : PPGresult;
|
||||
@ -724,7 +725,7 @@ begin
|
||||
end;
|
||||
|
||||
function TPQConnection.TranslateFldType(res: PPGresult; Tuple: integer; out
|
||||
Size: integer; Out ATypeOID: oid): TFieldType;
|
||||
Size: integer; out ATypeOID: oid): TFieldType;
|
||||
|
||||
const
|
||||
VARHDRSZ=sizeof(longint);
|
||||
@ -805,18 +806,18 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TPQConnection.AllocateCursorHandle: TSQLCursor;
|
||||
function TPQConnection.AllocateCursorHandle: TSQLCursor;
|
||||
|
||||
begin
|
||||
result := TPQCursor.create;
|
||||
end;
|
||||
|
||||
Procedure TPQConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
|
||||
procedure TPQConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
|
||||
begin
|
||||
FreeAndNil(cursor);
|
||||
end;
|
||||
|
||||
Function TPQConnection.AllocateTransactionHandle: TSQLHandle;
|
||||
function TPQConnection.AllocateTransactionHandle: TSQLHandle;
|
||||
|
||||
begin
|
||||
result := TPQTrans.create;
|
||||
@ -1495,6 +1496,11 @@ begin
|
||||
result := s;
|
||||
end;
|
||||
|
||||
function TPQConnection.GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
|
||||
begin
|
||||
Result := Format('SELECT nextval(''%s'')', [SequenceName]);
|
||||
end;
|
||||
|
||||
procedure TPQConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef;
|
||||
ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
|
||||
var
|
||||
|
||||
@ -23,7 +23,7 @@ interface
|
||||
uses SysUtils, Classes, DB, bufdataset, sqlscript;
|
||||
|
||||
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,
|
||||
stDDL, stGetSegment, stPutSegment, stExecProcedure,
|
||||
@ -216,6 +216,7 @@ type
|
||||
|
||||
procedure UpdateIndexDefs(IndexDefs : TIndexDefs; TableName : string); virtual;
|
||||
function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
|
||||
function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; virtual;
|
||||
|
||||
Procedure MaybeConnect;
|
||||
|
||||
@ -234,10 +235,12 @@ type
|
||||
procedure GetProcedureNames(List : TStrings); virtual;
|
||||
procedure GetFieldNames(const TableName : string; List : TStrings); virtual;
|
||||
procedure GetSchemaNames(List: TStrings); virtual;
|
||||
procedure GetSequenceNames(List: TStrings); virtual;
|
||||
function GetConnectionInfo(InfoType:TConnInfoType): string; virtual;
|
||||
function GetStatementInfo(const ASQL: string): TSQLStatementInfo; virtual;
|
||||
procedure CreateDB; virtual;
|
||||
procedure DropDB; virtual;
|
||||
function GetNextValue(const SequenceName: string; IncrementBy: integer=1): Int64; virtual;
|
||||
property ConnOptions: TConnOptions read FConnOptions;
|
||||
published
|
||||
property Password : string read FPassword write FPassword;
|
||||
@ -372,6 +375,31 @@ type
|
||||
Property Transaction;
|
||||
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 }
|
||||
|
||||
TSQLQueryOption = (sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit);
|
||||
@ -406,6 +434,7 @@ type
|
||||
FInsertQry,
|
||||
FUpdateQry,
|
||||
FDeleteQry : TCustomSQLStatement;
|
||||
FSequence : TSQLSequence;
|
||||
procedure FreeFldBuffers;
|
||||
function GetParamCheck: Boolean;
|
||||
function GetParams: TParams;
|
||||
@ -464,6 +493,8 @@ type
|
||||
procedure BeforeRefreshOpenCursor; override;
|
||||
procedure SetReadOnly(AValue : Boolean); override;
|
||||
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
procedure DoOnNewRecord; override;
|
||||
procedure DoBeforePost; override;
|
||||
class function FieldDefsClass : TFieldDefsClass; override;
|
||||
// IProviderSupport methods
|
||||
function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override;
|
||||
@ -531,6 +562,7 @@ type
|
||||
property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey default true;
|
||||
property StatementType : TStatementType read GetStatementType;
|
||||
Property DataSource : TDataSource Read GetDataSource Write SetDataSource;
|
||||
property Sequence: TSQLSequence read FSequence write FSequence;
|
||||
property ServerFilter: string read FServerFilterText write SetServerFilterText;
|
||||
property ServerFiltered: Boolean read FServerFiltered write SetServerFiltered default False;
|
||||
property ServerIndexDefs : TServerIndexDefs read GetServerIndexDefs;
|
||||
@ -589,6 +621,7 @@ type
|
||||
property UpdateMode;
|
||||
property UsePrimaryKeyAsKey;
|
||||
Property DataSource;
|
||||
property Sequence;
|
||||
property ServerFilter;
|
||||
property ServerFiltered;
|
||||
property ServerIndexDefs;
|
||||
@ -745,6 +778,7 @@ begin
|
||||
Result := Format('%.2d:%.2d:%.2d.%.3d',[hour,minute,second,millisecond]);
|
||||
end;
|
||||
|
||||
|
||||
{ TSQLDBFieldDefs }
|
||||
|
||||
class function TSQLDBFieldDefs.FieldDefClass: TFieldDefClass;
|
||||
@ -752,6 +786,7 @@ begin
|
||||
Result:=TSQLDBFieldDef;
|
||||
end;
|
||||
|
||||
|
||||
{ TSQLDBParams }
|
||||
|
||||
class function TSQLDBParams.ParamClass: TParamClass;
|
||||
@ -759,6 +794,7 @@ begin
|
||||
Result:=TSQLDBParam;
|
||||
end;
|
||||
|
||||
|
||||
{ ESQLDatabaseError }
|
||||
|
||||
constructor ESQLDatabaseError.CreateFmt(const Fmt: string; const Args: array of const;
|
||||
@ -782,8 +818,6 @@ begin
|
||||
SQLState := ASQLState;
|
||||
end;
|
||||
|
||||
Type
|
||||
TInternalTransaction = Class(TSQLTransaction);
|
||||
|
||||
{ TCustomSQLStatement }
|
||||
|
||||
@ -976,8 +1010,6 @@ begin
|
||||
Result:=False;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TCustomSQLStatement.GetStatementInfo(var ASQL: String; out Info: TSQLStatementInfo);
|
||||
|
||||
begin
|
||||
@ -1090,6 +1122,7 @@ begin
|
||||
Result:=FRowsAffected;
|
||||
end;
|
||||
|
||||
|
||||
{ TSQLConnection }
|
||||
|
||||
constructor TSQLConnection.Create(AOwner: TComponent);
|
||||
@ -1287,6 +1320,11 @@ begin
|
||||
GetDBInfo(stSchemata,'','SCHEMA_NAME',List);
|
||||
end;
|
||||
|
||||
procedure TSQLConnection.GetSequenceNames(List: TStrings);
|
||||
begin
|
||||
GetDBInfo(stSequences,'','SEQUENCE_NAME',List);
|
||||
end;
|
||||
|
||||
function TSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
|
||||
var i: TConnInfoType;
|
||||
begin
|
||||
@ -1509,12 +1547,12 @@ begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
Function TSQLConnection.LogEvent(EventType: TDBEventType): Boolean;
|
||||
function TSQLConnection.LogEvent(EventType: TDBEventType): Boolean;
|
||||
begin
|
||||
Result:=(Assigned(FOnLog) or Assigned(GlobalDBLogHook)) and (EventType in LogEvents);
|
||||
end;
|
||||
|
||||
Procedure TSQLConnection.Log(EventType: TDBEventType; Const Msg: String);
|
||||
procedure TSQLConnection.Log(EventType: TDBEventType; const Msg: String);
|
||||
|
||||
Var
|
||||
M : String;
|
||||
@ -1535,13 +1573,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TSQLConnection.RegisterStatement(S: TCustomSQLStatement);
|
||||
procedure TSQLConnection.RegisterStatement(S: TCustomSQLStatement);
|
||||
begin
|
||||
if FStatements.IndexOf(S)=-1 then
|
||||
FStatements.Add(S);
|
||||
end;
|
||||
|
||||
Procedure TSQLConnection.UnRegisterStatement(S: TCustomSQLStatement);
|
||||
procedure TSQLConnection.UnRegisterStatement(S: TCustomSQLStatement);
|
||||
begin
|
||||
if Assigned(FStatements) then // Can be nil, when we are destroying and datasets are uncoupled.
|
||||
FStatements.Remove(S);
|
||||
@ -1764,11 +1802,36 @@ begin
|
||||
case SchemaType of
|
||||
stProcedures: Result := 'SELECT *, ROUTINE_NAME AS PROCEDURE_NAME FROM INFORMATION_SCHEMA.ROUTINES';
|
||||
stSchemata : Result := 'SELECT * FROM INFORMATION_SCHEMA.SCHEMATA';
|
||||
stSequences : Result := 'SELECT * FROM INFORMATION_SCHEMA.SEQUENCES';
|
||||
else DatabaseError(SMetadataUnavailable);
|
||||
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
|
||||
If Not Connected then
|
||||
begin
|
||||
@ -1790,6 +1853,7 @@ begin
|
||||
DatabaseError(SNotSupported);
|
||||
end;
|
||||
|
||||
|
||||
{ TSQLTransaction }
|
||||
|
||||
procedure TSQLTransaction.EndTransaction;
|
||||
@ -1995,6 +2059,50 @@ begin
|
||||
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
|
||||
|
||||
{ TQuerySQLStatement }
|
||||
@ -2096,6 +2204,7 @@ begin
|
||||
FRefreshSQL := TStringList.Create;
|
||||
FRefreshSQL.OnChange := @OnChangeModifySQL;
|
||||
|
||||
FSequence := TSQLSequence.Create(Self);
|
||||
FServerIndexDefs := TServerIndexDefs.Create(Self);
|
||||
|
||||
FServerFiltered := False;
|
||||
@ -2120,7 +2229,8 @@ begin
|
||||
FreeAndNil(FUpdateSQL);
|
||||
FreeAndNil(FDeleteSQL);
|
||||
FreeAndNil(FRefreshSQL);
|
||||
FServerIndexDefs.Free;
|
||||
FreeAndNil(FSequence);
|
||||
FreeAndNil(FServerIndexDefs);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -2823,6 +2933,20 @@ begin
|
||||
DataSource:=Nil;
|
||||
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;
|
||||
var
|
||||
PrevErrorCode, ErrorCode: Integer;
|
||||
|
||||
@ -53,6 +53,7 @@ type
|
||||
Procedure TestRefreshSQLMultipleRecords;
|
||||
Procedure TestRefreshSQLNoRecords;
|
||||
Procedure TestFetchAutoInc;
|
||||
procedure TestSequence;
|
||||
end;
|
||||
|
||||
{ TTestTSQLConnection }
|
||||
@ -86,7 +87,7 @@ implementation
|
||||
|
||||
{ TTestTSQLQuery }
|
||||
|
||||
Procedure TTestTSQLQuery.Setup;
|
||||
procedure TTestTSQLQuery.Setup;
|
||||
begin
|
||||
inherited Setup;
|
||||
SQLDBConnector.Connection.Options:=[];
|
||||
@ -181,7 +182,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.TestKeepOpenOnCommit;
|
||||
procedure TTestTSQLQuery.TestKeepOpenOnCommit;
|
||||
var Q: TSQLQuery;
|
||||
I: Integer;
|
||||
begin
|
||||
@ -219,12 +220,12 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.TrySetPacketRecords;
|
||||
procedure TTestTSQLQuery.TrySetPacketRecords;
|
||||
begin
|
||||
FMyQ.PacketRecords:=10;
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.TestKeepOpenOnCommitPacketRecords;
|
||||
procedure TTestTSQLQuery.TestKeepOpenOnCommitPacketRecords;
|
||||
begin
|
||||
with SQLDBConnector do
|
||||
begin
|
||||
@ -234,12 +235,12 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.TrySetQueryOptions;
|
||||
procedure TTestTSQLQuery.TrySetQueryOptions;
|
||||
begin
|
||||
FMyQ.Options:=[sqoKeepOpenOnCommit];
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.TestCheckSettingsOnlyWhenInactive;
|
||||
procedure TTestTSQLQuery.TestCheckSettingsOnlyWhenInactive;
|
||||
begin
|
||||
// Check that we can only set QueryOptions when the query is inactive.
|
||||
with SQLDBConnector do
|
||||
@ -261,7 +262,7 @@ begin
|
||||
AssertTrue('Have modifications in after post',FMyq.UpdateStatus=usModified)
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.TestAutoApplyUpdatesPost;
|
||||
procedure TTestTSQLQuery.TestAutoApplyUpdatesPost;
|
||||
var Q: TSQLQuery;
|
||||
I: Integer;
|
||||
begin
|
||||
@ -296,7 +297,7 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.TestAutoApplyUpdatesDelete;
|
||||
procedure TTestTSQLQuery.TestAutoApplyUpdatesDelete;
|
||||
|
||||
var Q: TSQLQuery;
|
||||
I: Integer;
|
||||
@ -328,13 +329,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.DoApplyUpdates;
|
||||
procedure TTestTSQLQuery.DoApplyUpdates;
|
||||
|
||||
begin
|
||||
FMyQ.ApplyUpdates();
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.TestCheckRowsAffected;
|
||||
procedure TTestTSQLQuery.TestCheckRowsAffected;
|
||||
var Q: TSQLQuery;
|
||||
I: Integer;
|
||||
begin
|
||||
@ -359,7 +360,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.TestAutoCommit;
|
||||
procedure TTestTSQLQuery.TestAutoCommit;
|
||||
var
|
||||
I : Integer;
|
||||
begin
|
||||
@ -389,7 +390,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.TestRefreshSQL;
|
||||
procedure TTestTSQLQuery.TestRefreshSQL;
|
||||
var
|
||||
Q: TSQLQuery;
|
||||
|
||||
@ -424,7 +425,7 @@ begin
|
||||
AssertEquals('Field value has been fetched from the database', 1, Q.FieldByName('b').AsInteger);
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.TestGeneratedRefreshSQL;
|
||||
procedure TTestTSQLQuery.TestGeneratedRefreshSQL;
|
||||
|
||||
var
|
||||
Q: TSQLQuery;
|
||||
@ -456,7 +457,7 @@ begin
|
||||
AssertEquals('Field value has been fetched from the database ','fgh',Q.FieldByName('b').AsString);
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.TestGeneratedRefreshSQL1Field;
|
||||
procedure TTestTSQLQuery.TestGeneratedRefreshSQL1Field;
|
||||
var
|
||||
Q: TSQLQuery;
|
||||
|
||||
@ -485,7 +486,7 @@ begin
|
||||
AssertEquals('Field value b has NOT been fetched from the database ','',Q.FieldByName('b').AsString);
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.TestGeneratedRefreshSQLNoKey;
|
||||
procedure TTestTSQLQuery.TestGeneratedRefreshSQLNoKey;
|
||||
begin
|
||||
with SQLDBConnector do
|
||||
begin
|
||||
@ -507,7 +508,7 @@ begin
|
||||
AssertException('Cannot refresh without primary key',EUpdateError,@DoApplyUpdates);
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.TestRefreshSQLMultipleRecords;
|
||||
procedure TTestTSQLQuery.TestRefreshSQLMultipleRecords;
|
||||
|
||||
begin
|
||||
with SQLDBConnector do
|
||||
@ -534,7 +535,7 @@ begin
|
||||
AssertException('Multiple records returned by RefreshSQL gives an error',EUpdateError,@DoApplyUpdates);
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.TestRefreshSQLNoRecords;
|
||||
procedure TTestTSQLQuery.TestRefreshSQLNoRecords;
|
||||
begin
|
||||
with SQLDBConnector do
|
||||
begin
|
||||
@ -560,7 +561,7 @@ begin
|
||||
AssertException('No records returned by RefreshSQL gives an error',EUpdateError,@DoApplyUpdates);
|
||||
end;
|
||||
|
||||
Procedure TTestTSQLQuery.TestFetchAutoInc;
|
||||
procedure TTestTSQLQuery.TestFetchAutoInc;
|
||||
var datatype: string;
|
||||
id: largeint;
|
||||
begin
|
||||
@ -602,6 +603,50 @@ begin
|
||||
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 }
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user