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

git-svn-id: trunk@30291 -
This commit is contained in:
michael 2015-03-23 16:37:51 +00:00
parent ac3aa6b602
commit 743324f72b
4 changed files with 235 additions and 43 deletions

View File

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

View File

@ -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; function TPQConnection.StartdbTransaction(trans: TSQLHandle; AParams: string
AParams: string): boolean; ): 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

View File

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

View File

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