mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-28 21:00:28 +02:00
* Patch from Laco with minor modification from bug ID #27251
git-svn-id: trunk@30291 -
This commit is contained in:
parent
ac3aa6b602
commit
743324f72b
@ -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;
|
||||||
|
@ -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
|
||||||
|
@ -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;
|
||||||
|
@ -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 }
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user