From 6d5622aca362842ebfae3de79d25bcc4d49764f9 Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 29 Nov 2014 20:29:52 +0000 Subject: [PATCH] * Implemented RefreshSQL and fetching value for AutoInc fields git-svn-id: trunk@29183 - --- packages/fcl-db/src/base/bufdataset.pas | 10 +- packages/fcl-db/src/base/db.pas | 17 +- packages/fcl-db/src/base/dbconst.pas | 5 +- packages/fcl-db/src/base/dsparams.inc | 73 +++++-- packages/fcl-db/src/sqldb/mysql/mysqlconn.inc | 21 +- packages/fcl-db/src/sqldb/sqldb.pp | 190 +++++++++++++++- .../fcl-db/src/sqldb/sqlite/sqlite3conn.pp | 24 +- packages/fcl-db/tests/testsqldb.pas | 205 +++++++++++++++++- 8 files changed, 502 insertions(+), 43 deletions(-) diff --git a/packages/fcl-db/src/base/bufdataset.pas b/packages/fcl-db/src/base/bufdataset.pas index 40680a4860..66ed008c7f 100644 --- a/packages/fcl-db/src/base/bufdataset.pas +++ b/packages/fcl-db/src/base/bufdataset.pas @@ -512,6 +512,7 @@ type procedure RemoveRecordFromIndexes(const ABookmark : TBufBookmark); protected // abstract & virtual methods of TDataset + procedure ActiveBufferToRecord; procedure SetPacketRecords(aValue : integer); virtual; procedure UpdateIndexDefs; override; procedure SetRecNo(Value: Longint); override; @@ -2540,8 +2541,7 @@ begin FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := nil; end; end; - - move(ActiveBuffer^,FCurrentIndex.CurrentBuffer^,FRecordSize); + ActiveBufferToRecord; // new data are now in current record so reorder current record if needed for i := 1 to FIndexesCount-1 do @@ -2549,6 +2549,12 @@ begin FIndexes[i].OrderCurrentRecord; end; +procedure TCustomBufDataset.ActiveBufferToRecord; + +begin + move(ActiveBuffer^,FCurrentIndex.CurrentBuffer^,FRecordSize); +end; + procedure TCustomBufDataset.CalcRecordSize; var x : longint; diff --git a/packages/fcl-db/src/base/db.pas b/packages/fcl-db/src/base/db.pas index 8c4dc54d6a..8369fc2c7b 100644 --- a/packages/fcl-db/src/base/db.pas +++ b/packages/fcl-db/src/base/db.pas @@ -61,7 +61,7 @@ type TUpdateMode = (upWhereAll, upWhereChanged, upWhereKeyOnly); TResolverResponse = (rrSkip, rrAbort, rrMerge, rrApply, rrIgnore); - TProviderFlag = (pfInUpdate, pfInWhere, pfInKey, pfHidden); + TProviderFlag = (pfInUpdate, pfInWhere, pfInKey, pfHidden, pfRefreshOnInsert,pfRefreshOnUpdate); TProviderFlags = set of TProviderFlag; { Forward declarations } @@ -1232,6 +1232,19 @@ type end; TParamClass = Class of TParam; + { TParamsEnumerator } + + TParamsEnumerator = class + private + FPosition: Integer; + FParams: TParams; + function GetCurrent: TParam; + public + constructor Create(AParams: TParams); + function MoveNext: Boolean; + property Current: TParam read GetCurrent; + end; + { TParams } TParams = class(TCollection) @@ -1256,6 +1269,7 @@ type Function FindParam(const Value: string): TParam; Procedure GetParamList(List: TList; const ParamNames: string); Function IsEqual(Value: TParams): Boolean; + Function GetEnumerator: TParamsEnumerator; Function ParamByName(const Value: string): TParam; Function ParseSQL(SQL: String; DoCreate: Boolean): String; overload; Function ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle): String; overload; @@ -2216,6 +2230,7 @@ begin Pos:=i; end; + { EUpdateError } constructor EUpdateError.Create(NativeError, Context : String; ErrCode, PrevError : integer; E: Exception); diff --git a/packages/fcl-db/src/base/dbconst.pas b/packages/fcl-db/src/base/dbconst.pas index 86b360f032..35d129a314 100644 --- a/packages/fcl-db/src/base/dbconst.pas +++ b/packages/fcl-db/src/base/dbconst.pas @@ -117,7 +117,10 @@ Resourcestring SErrNoImplicitTransaction = 'Connection %s does not allow implicit transactions.'; SErrImplictTransactionStart = 'Error: attempt to implicitly start a transaction on Connection "%s", transaction "%s".'; SErrImplicitConnect = 'Error: attempt to implicitly activate connection "%s".'; - SErrFailedToUpdateRecord = '%q: Failed to apply record updates: %d rows updated.'; + SErrFailedToUpdateRecord = 'Failed to apply record updates: %d rows updated.'; + SErrRefreshNotSingleton = 'Refresh SQL resulted in multiple records: %d.'; + SErrRefreshEmptyResult = 'Refresh SQL resulted in empty result set.'; + SErrNoKeyFieldForRefreshClause = 'No key field found to construct refresh SQL WHERE clause'; Implementation diff --git a/packages/fcl-db/src/base/dsparams.inc b/packages/fcl-db/src/base/dsparams.inc index e261c0b7cb..54654a1449 100644 --- a/packages/fcl-db/src/base/dsparams.inc +++ b/packages/fcl-db/src/base/dsparams.inc @@ -22,29 +22,49 @@ begin until notRepeatEscaped; end; +{ TParamsEnumerator } + +function TParamsEnumerator.GetCurrent: TParam; +begin + Result := FParams[FPosition]; +end; + +constructor TParamsEnumerator.Create(AParams: TParams); +begin + inherited Create; + FParams := AParams; + FPosition := -1; +end; + +function TParamsEnumerator.MoveNext: Boolean; +begin + inc(FPosition); + Result := FPosition < FParams.Count; +end; + { TParams } -function TParams.GetItem(Index: Integer): TParam; +Function TParams.GetItem(Index: Integer): TParam; begin Result:=(Inherited GetItem(Index)) as TParam; end; -function TParams.GetParamValue(const ParamName: string): Variant; +Function TParams.GetParamValue(const ParamName: string): Variant; begin Result:=ParamByName(ParamName).Value; end; -procedure TParams.SetItem(Index: Integer; Value: TParam); +Procedure TParams.SetItem(Index: Integer; Value: TParam); begin Inherited SetItem(Index,Value); end; -procedure TParams.SetParamValue(const ParamName: string; const Value: Variant); +Procedure TParams.SetParamValue(const ParamName: string; const Value: Variant); begin ParamByName(ParamName).Value:=Value; end; -procedure TParams.AssignTo(Dest: TPersistent); +Procedure TParams.AssignTo(Dest: TPersistent); begin if (Dest is TParams) then TParams(Dest).Assign(Self) @@ -52,7 +72,7 @@ begin inherited AssignTo(Dest); end; -function TParams.GetDataSet: TDataSet; +Function TParams.GetDataSet: TDataSet; begin If (FOwner is TDataset) Then Result:=TDataset(FOwner) @@ -60,17 +80,17 @@ begin Result:=Nil; end; -function TParams.GetOwner: TPersistent; +Function TParams.GetOwner: TPersistent; begin Result:=FOwner; end; -class function TParams.ParamClass: TParamClass; +Class Function TParams.ParamClass: TParamClass; begin Result:=TParam; end; -constructor TParams.Create(AOwner: TPersistent; AItemClass: TCollectionItemClass +Constructor TParams.Create(AOwner: TPersistent; AItemClass: TCollectionItemClass ); begin Inherited Create(AItemClass); @@ -78,22 +98,22 @@ begin end; -constructor TParams.Create(AOwner: TPersistent); +Constructor TParams.Create(AOwner: TPersistent); begin Create(AOwner,ParamClass); end; -constructor TParams.Create; +Constructor TParams.Create; begin Create(TPersistent(Nil)); end; -procedure TParams.AddParam(Value: TParam); +Procedure TParams.AddParam(Value: TParam); begin Value.Collection:=Self; end; -procedure TParams.AssignValues(Value: TParams); +Procedure TParams.AssignValues(Value: TParams); Var I : Integer; @@ -109,7 +129,7 @@ begin end; end; -function TParams.CreateParam(FldType: TFieldType; const ParamName: string; +Function TParams.CreateParam(FldType: TFieldType; const ParamName: string; ParamType: TParamType): TParam; begin @@ -119,7 +139,7 @@ begin Result.ParamType:=ParamType; end; -function TParams.FindParam(const Value: string): TParam; +Function TParams.FindParam(const Value: string): TParam; Var I : Integer; @@ -134,7 +154,7 @@ begin Dec(i); end; -procedure TParams.GetParamList(List: TList; const ParamNames: string); +Procedure TParams.GetParamList(List: TList; const ParamNames: string); Var P: TParam; @@ -152,7 +172,7 @@ begin until StrPos > Length(ParamNames); end; -function TParams.IsEqual(Value: TParams): Boolean; +Function TParams.IsEqual(Value: TParams): Boolean; Var I : Integer; @@ -167,14 +187,19 @@ begin end; end; -function TParams.ParamByName(const Value: string): TParam; +Function TParams.GetEnumerator: TParamsEnumerator; +begin + Result:=TParamsEnumerator.Create(Self); +end; + +Function TParams.ParamByName(const Value: string): TParam; begin Result:=FindParam(Value); If (Result=Nil) then DatabaseErrorFmt(SParameterNotFound,[Value],Dataset); end; -function TParams.ParseSQL(SQL: String; DoCreate: Boolean): String; +Function TParams.ParseSQL(SQL: String; DoCreate: Boolean): String; var pb : TParamBinding; rs : string; @@ -183,7 +208,7 @@ begin Result := ParseSQL(SQL,DoCreate,True,True,psInterbase, pb, rs); end; -function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash, +Function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat: Boolean; ParameterStyle: TParamStyle): String; var pb : TParamBinding; @@ -193,7 +218,7 @@ begin Result := ParseSQL(SQL,DoCreate,EscapeSlash,EscapeRepeat,ParameterStyle,pb, rs); end; -function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash, +Function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat: Boolean; ParameterStyle: TParamStyle; out ParamBinding: TParambinding): String; @@ -246,7 +271,7 @@ begin end; {case} end; -function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash, +Function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat: Boolean; ParameterStyle: TParamStyle; out ParamBinding: TParambinding; out ReplaceString: string): String; @@ -435,7 +460,7 @@ begin end; -procedure TParams.RemoveParam(Value: TParam); +Procedure TParams.RemoveParam(Value: TParam); begin Value.Collection:=Nil; end; @@ -1123,7 +1148,7 @@ begin end; -procedure TParams.CopyParamValuesFromDataset(ADataset: TDataset; +Procedure TParams.CopyParamValuesFromDataset(ADataset: TDataset; CopyBound: Boolean); Var diff --git a/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc b/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc index 646569b061..d0613faf21 100644 --- a/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc +++ b/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc @@ -99,6 +99,7 @@ Type procedure ExecuteDirectMySQL(const query : string); function EscapeString(const Str : string) : string; protected + function GetLastInsertIDForField(Query : TCustomSQLQuery; AField : TField): Boolean; override; function StrToStatementType(s : string) : TStatementType; override; Procedure ConnectToServer; virtual; Procedure SelectDatabase; virtual; @@ -329,7 +330,7 @@ begin Result := mysql_stat(FMYSQL); end; -function TConnectionName.GetInsertID: Int64; +Function TConnectionName.GetInsertID: int64; begin CheckConnected; Result:=mysql_insert_id(GetHandle); @@ -404,14 +405,14 @@ begin end; -procedure TConnectionName.ConnectToServer; +Procedure TConnectionName.ConnectToServer; begin ConnectMySQL(FMySQL); FServerInfo := strpas(mysql_get_server_info(FMYSQL)); FHostInfo := strpas(mysql_get_host_info(FMYSQL)); end; -procedure TConnectionName.SelectDatabase; +Procedure TConnectionName.SelectDatabase; begin if mysql_select_db(FMySQL,pchar(DatabaseName))<>0 then MySQLError(FMySQL,SErrDatabaseSelectFailed,Self); @@ -463,6 +464,14 @@ begin SetLength(result,Len); end; +function TConnectionName.GetLastInsertIDForField(Query: TCustomSQLQuery; + AField: TField): Boolean; +begin + Result:=inherited GetLastInsertIDForField(Query, AField); + if Result then + AField.AsLargeInt:=GetInsertID; +end; + procedure TConnectionName.DoInternalConnect; var FullVersion: string; @@ -493,7 +502,7 @@ begin Result:=FMySQL; end; -function TConnectionName.AllocateCursorHandle: TSQLCursor; +Function TConnectionName.AllocateCursorHandle: TSQLCursor; begin {$IFDEF mysql56} Result:=TMySQL56Cursor.Create; @@ -524,7 +533,7 @@ begin FreeAndNil(cursor); end; -function TConnectionName.AllocateTransactionHandle: TSQLHandle; +Function TConnectionName.AllocateTransactionHandle: TSQLHandle; begin // Result:=TTransactionName.Create; Result := nil; @@ -1122,7 +1131,7 @@ constructor TConnectionName.Create(AOwner: TComponent); const SingleBackQoutes: TQuoteChars = ('`','`'); begin inherited Create(AOwner); - FConnOptions := FConnOptions + [sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction]; + FConnOptions := FConnOptions + [sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction, sqLastInsertID]; FieldNameQuoteChars:=SingleBackQoutes; FMySQL := Nil; end; diff --git a/packages/fcl-db/src/sqldb/sqldb.pp b/packages/fcl-db/src/sqldb/sqldb.pp index 76ee1911e5..40bd0eb768 100644 --- a/packages/fcl-db/src/sqldb/sqldb.pp +++ b/packages/fcl-db/src/sqldb/sqldb.pp @@ -138,7 +138,7 @@ type { TSQLConnection } - TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction); + TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID); TConnOptions= set of TConnOption; TSQLConnectionOption = (scoExplicitConnect, scoApplyUpdatesChecksRowsAffected); @@ -172,12 +172,14 @@ type // One day, this may be factored out to a TSQLResolver class. // The following allow construction of update queries. They can be adapted as needed by descendents to fit the DB engine. procedure AddFieldToUpdateWherePart(var sql_where: string; UpdateMode : TUpdateMode; F: TField); virtual; + function ConstructRefreshSQL(Query: TCustomSQLQuery; UpdateKind : TUpdateKind): string; virtual; function ConstructDeleteSQL(Query: TCustomSQLQuery): string; virtual; function ConstructInsertSQL(Query: TCustomSQLQuery): string; virtual; function ConstructUpdateSQL(Query: TCustomSQLQuery): string; virtual; function InitialiseUpdateStatement(Query: TCustomSQLQuery; var qry: TCustomSQLStatement): TCustomSQLStatement; procedure ApplyFieldUpdate(C : TSQLCursor; P: TSQLDBParam; F: TField; UseOldValue: Boolean); virtual; // This is the call that updates a record, it used to be in TSQLQuery. + function GetLastInsertIDForField(Query : TCustomSQLQuery; AField : TField): Boolean; virtual; procedure ApplyRecUpdate(Query : TCustomSQLQuery; UpdateKind : TUpdateKind); virtual; procedure GetDBInfo(const ASchemaType : TSchemaType; const ASchemaObjectName, AReturnField : string; AList: TStrings); procedure SetTransaction(Value : TSQLTransaction); virtual; @@ -382,6 +384,7 @@ type FUpdateable : boolean; FTableName : string; FStatement : TCustomSQLStatement; + FRefreshSQL, FUpdateSQL, FInsertSQL, FDeleteSQL : TStringList; @@ -412,8 +415,10 @@ type function GetSQLConnection: TSQLConnection; function GetSQLTransaction: TSQLTransaction; function GetStatementType : TStatementType; + Function NeedLastinsertID: TField; procedure SetOptions(AValue: TSQLQueryOptions); procedure SetParamCheck(AValue: Boolean); + procedure SetRefreshSQL(AValue: TStringlist); procedure SetSQLConnection(AValue: TSQLConnection); procedure SetSQLTransaction(AValue: TSQLTransaction); procedure SetUpdateSQL(const AValue: TStringlist); @@ -429,6 +434,9 @@ type procedure ApplyFilter; Function AddFilter(SQLstr : string) : string; protected + Function UpdateLastInsertIDField(F: TField): Boolean; virtual; + Function NeedRefreshRecord (UpdateKind: TUpdateKind): Boolean; virtual; + Function RefreshRecord (UpdateKind: TUpdateKind) : Boolean; virtual; procedure SetPacketRecords(aValue : integer); override; Function Cursor : TSQLCursor; Function LogEvent(EventType : TDBEventType) : Boolean; @@ -512,6 +520,7 @@ type property UpdateSQL : TStringlist read FUpdateSQL write SetUpdateSQL; property InsertSQL : TStringlist read FInsertSQL write SetInsertSQL; property DeleteSQL : TStringlist read FDeleteSQL write SetDeleteSQL; + property RefreshSQL : TStringlist read FRefreshSQL write SetRefreshSQL; Property Options : TSQLQueryOptions Read FOptions Write SetOptions; property Params : TParams read GetParams Write SetParams; Property ParamCheck : Boolean Read GetParamCheck Write SetParamCheck default true; @@ -568,6 +577,7 @@ type property SQL; property UpdateSQL; property InsertSQL; + property RefreshSQL; property DeleteSQL; property IndexDefs; Property Options; @@ -716,6 +726,10 @@ implementation uses dbconst, strutils; +Const + // Flags to check which fields must be refreshed. Index is false for update, true for insert + RefreshFlags : Array [Boolean] of TProviderFlag = (pfRefreshOnUpdate,pfRefreshOnUpdate); + function TimeIntervalToString(Time: TDateTime): string; var @@ -1563,6 +1577,45 @@ begin end; end; +function TSQLConnection.ConstructRefreshSQL(Query: TCustomSQLQuery; + UpdateKind: TUpdateKind): string; + +Var + F : TField; + PF : TProviderFlag; + Where : String; + +begin + Where:=''; + Result:=Query.RefreshSQL.Text; + if (Result='') then + begin + PF:=RefreshFlags[UpdateKind=ukInsert]; + For F in Query.Fields do + begin + if PF in F.ProviderFlags then + begin + if (Result<>'') then + Result:=Result+', '; + if (F.Origin<>'') and (F.Origin<>F.FieldName) then + Result:=Result+F.Origin+' as '+F.FieldName + else + Result:=Result+FieldNameQuoteChars[0]+F.FieldName+FieldNameQuoteChars[1] + end; + if pfInkey in F.ProviderFlags then + begin + if (Where<>'') then + Where:=Where+' AND '; + Where:=Where+'('+FieldNameQuoteChars[0]+F.FieldName+FieldNameQuoteChars[0]+' = :'+F.FieldName+')'; + end; + end; + if (Where='') then + DatabaseError(SErrNoKeyFieldForRefreshClause,Query); + Result:='SELECT '+Result+' FROM '+Query.FTableName+' WHERE '+Where; + end; + +end; + function TSQLConnection.ConstructUpdateSQL(Query: TCustomSQLQuery): string; var x : integer; @@ -1639,6 +1692,11 @@ begin P.FFieldDef:=F.FieldDef; end; +function TSQLConnection.GetLastInsertIDForField(Query: TCustomSQLQuery; AField: TField): Boolean; +begin + Result:=sqLastInsertID in ConnOptions; +end; + procedure TSQLConnection.ApplyRecUpdate(Query: TCustomSQLQuery; UpdateKind: TUpdateKind); var @@ -2033,6 +2091,8 @@ begin FInsertSQL.OnChange := @OnChangeModifySQL; FDeleteSQL := TStringList.Create; FDeleteSQL.OnChange := @OnChangeModifySQL; + FRefreshSQL := TStringList.Create; + FRefreshSQL.OnChange := @OnChangeModifySQL; FServerIndexDefs := TServerIndexDefs.Create(Self); @@ -2141,6 +2201,77 @@ begin Result := SQLstr; end; +Function TCustomSQLQuery.NeedRefreshRecord(UpdateKind: TUpdateKind): Boolean; + + +Var + F : TProviderFlag; + I : Integer; +begin + Result:=(FRefreshSQL.Count<>0); + if Not Result then + begin + F:=RefreshFlags[UpdateKind=ukInsert]; + I:=0; + While (Not Result) and (I1 then + DatabaseErrorFmt(SErrRefreshNotSingleton,[Q.RecordCount],Self); + For F in Q.Fields do + begin + FD:=Fields.FindField(F.FieldName); + if Assigned(FD) then + begin + FD.Assign(F); + Result:=True; // We could check if the new value differs from the old, but we won't. + end; + end; + end + finally + Q.Close; + end; + finally + Q.Free; + end; +end; + procedure TCustomSQLQuery.ApplyFilter; begin @@ -2479,12 +2610,63 @@ begin SQLConnection.UpdateIndexDefs(ServerIndexDefs,FTableName); end; +Function TCustomSQLQuery.NeedLastinsertID : TField; + +Var + I : Integer; + +begin + Result:=Nil; + if sqLastInsertID in SQLConnection.ConnOptions then + begin + I:=0; + While (Result=Nil) and (IftAutoInc then + Result:=Nil; + Inc(I); + end; + end +end; + +Function TCustomSQLQuery.UpdateLastInsertIDField(F : TField) : Boolean; + +begin + Result:=SQLConnection.GetLastInsertIDForField(Self,F); +end; + procedure TCustomSQLQuery.ApplyRecUpdate(UpdateKind: TUpdateKind); +Var + DoRefresh,RecordRefreshed : Boolean; + LastIDField : TField; + S : TDatasetState; + begin // Moved to connection: the SQLConnection always has more information about types etc. // than SQLQuery itself. SQLConnection.ApplyRecupdate(Self,UpdateKind); + if (UpdateKind=ukInsert) then + LastIDField:=NeedLastInsertID; + DoRefresh:=(UpdateKind in [ukModify,ukInsert]) and NeedRefreshRecord(UpdateKind); + if ((LastIDField<>Nil) or DoRefresh) then + begin + S:=State; + try + RecordRefreshed:=False; + SetState(dsNewValue); + if LastIDField<>Nil then + RecordRefreshed:=UpdateLastInsertIDField(LastIDField); + if DoRefresh then + RecordRefreshed:=RefreshRecord(UpdateKind) or RecordRefreshed; + finally + SetState(S); + end; + if RecordRefreshed then + // Active buffer is updated, move to record. + ActiveBufferToRecord; + end; end; @@ -2570,6 +2752,12 @@ begin PacketRecords:=-1; end; +procedure TCustomSQLQuery.SetRefreshSQL(AValue: TStringlist); +begin + if FRefreshSQL=AValue then Exit; + FRefreshSQL.Assign(AValue); +end; + procedure TCustomSQLQuery.SetSQLConnection(AValue: TSQLConnection); begin Database:=AValue; diff --git a/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp b/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp index a7b24dcbf4..cc7f2e29a5 100644 --- a/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp +++ b/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp @@ -55,6 +55,7 @@ type foptions: TSQLiteOptions; procedure setoptions(const avalue: tsqliteoptions); protected + function GetLastInsertIDForField(Query : TCustomSQLQuery; AField : TField): Boolean; override; function stringsquery(const asql: string): TArrayStringArray; procedure checkerror(const aerror: integer); @@ -334,12 +335,12 @@ begin ABlobBuf^.BlobBuffer^.Size := int1; end; -function TSQLite3Connection.AllocateTransactionHandle: TSQLHandle; +Function TSQLite3Connection.AllocateTransactionHandle: TSQLHandle; begin result:= tsqlhandle.create; end; -function TSQLite3Connection.AllocateCursorHandle: TSQLCursor; +Function TSQLite3Connection.AllocateCursorHandle: TSQLCursor; Var Res : TSQLite3Cursor; @@ -350,7 +351,7 @@ begin Result:=Res; end; -procedure TSQLite3Connection.DeAllocateCursorHandle(var cursor: TSQLCursor); +Procedure TSQLite3Connection.DeAllocateCursorHandle(var cursor: TSQLCursor); begin freeandnil(cursor); end; @@ -499,7 +500,8 @@ begin end; end; -procedure TSQLite3Connection.Execute(cursor: TSQLCursor; atransaction: tsqltransaction; AParams: TParams); +procedure TSQLite3Connection.Execute(cursor: TSQLCursor; + atransaction: tSQLtransaction; AParams: TParams); var SC : TSQLite3Cursor; @@ -886,7 +888,7 @@ end; constructor TSQLite3Connection.Create(AOwner: TComponent); begin inherited Create(AOwner); - FConnOptions := FConnOptions + [sqEscapeRepeat] + [sqEscapeSlash]; + FConnOptions := FConnOptions + [sqEscapeRepeat,sqEscapeSlash,sqLastInsertID]; FieldNameQuoteChars:=DoubleQuotes; end; @@ -948,7 +950,7 @@ begin IXFields.Free; end; -function TSQLite3Connection.getinsertid: int64; +function TSQLite3Connection.GetInsertID: int64; begin result:= sqlite3_last_insert_rowid(fhandle); end; @@ -1002,7 +1004,7 @@ begin CheckError(sqlite3_create_collation(fhandle, PChar(CollationName), eTextRep, Arg, Compare)); end; -procedure TSQLite3Connection.LoadExtension(LibraryFile: String); +procedure TSQLite3Connection.LoadExtension(LibraryFile: string); var LoadResult: integer; begin @@ -1036,6 +1038,14 @@ begin end; end; +function TSQLite3Connection.GetLastInsertIDForField(Query: TCustomSQLQuery; + AField: TField): Boolean; +begin + Result:=inherited GetLastInsertIDForField(Query, AField); + if Result then + AField.AsLargeInt:=GetInsertID; +end; + { TSQLite3ConnectionDef } class function TSQLite3ConnectionDef.TypeName: string; diff --git a/packages/fcl-db/tests/testsqldb.pas b/packages/fcl-db/tests/testsqldb.pas index 533a9bca01..4434e39f3b 100644 --- a/packages/fcl-db/tests/testsqldb.pas +++ b/packages/fcl-db/tests/testsqldb.pas @@ -47,6 +47,13 @@ type Procedure TestAutoApplyUpdatesDelete; Procedure TestCheckRowsAffected; Procedure TestAutoCommit; + Procedure TestRefreshSQL; + Procedure TestGeneratedRefreshSQL; + Procedure TestGeneratedRefreshSQL1Field; + Procedure TestGeneratedRefreshSQLNoKey; + Procedure TestRefreshSQLMultipleRecords; + Procedure TestRefreshSQLNoRecords; + Procedure TestFetchAutoInc; end; { TTestTSQLConnection } @@ -236,7 +243,7 @@ begin end; end; -Procedure TTestTSQLQuery.SetQueryOptions; +Procedure TTestTSQLQuery.SetQueryOPtions; begin FMyQ.Options:=[sqoKeepOpenOnCommit]; @@ -400,6 +407,202 @@ begin end; end; +Procedure TTestTSQLQuery.TestRefreshSQL; +var + Q: TSQLQuery; + T : TSQLTransaction; + I, J : Integer; +begin + with SQLDBConnector do + begin + TryDropIfExist('testdefval'); + ExecuteDirect('create table testdefval (id integer not null, a varchar(10) default ''abcde'', constraint pk_testdefval primary key(id))'); + if Transaction.Active then + Transaction.Commit; + end; + Q:=SQLDBConnector.Query; + Q.SQL.Text:='select * from testdefval'; + Q.InsertSQL.Text:='insert into testdefval (id) values (:id)'; + Q.RefreshSQL.Text:='SELECT a FROM testdefval WHERE (id=:id)'; + Q.Open; + Q.Insert; + Q.FieldByName('id').AsInteger:=1; + Q.Post; + AssertTrue('field value has not been fetched after post',Q.FieldByName('a').IsNull); + Q.ApplyUpdates(0); + AssertEquals('Still on correc field',1,Q.FieldByName('id').AsInteger); + AssertEquals('field value has been fetched from the database ','abcde',Q.FieldByName('a').AsString); +end; + +Procedure TTestTSQLQuery.TestGeneratedRefreshSQL; + +var + Q: TSQLQuery; + T : TSQLTransaction; + I, J : Integer; + +begin + with SQLDBConnector do + begin + TryDropIfExist('testdefval'); + ExecuteDirect('create table testdefval (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint pk_testdefval primary key(id))'); + if Transaction.Active then + Transaction.Commit; + end; + Q:=SQLDBConnector.Query; + Q.SQL.Text:='select * from testdefval'; + Q.InsertSQL.Text:='insert into testdefval (id) values (:id)'; + Q.Open; + With Q.FieldByName('id') do + ProviderFlags:=ProviderFlags+[pfInKey]; + With Q.FieldByName('a') do + ProviderFlags:=ProviderFlags+[pfRefreshOnInsert,pfRefreshOnUpdate]; + With Q.FieldByName('b') do + ProviderFlags:=ProviderFlags+[pfRefreshOnInsert,pfRefreshOnUpdate]; + Q.Insert; + Q.FieldByName('id').AsInteger:=1; + Q.Post; + AssertTrue('field value has not been fetched after post',Q.FieldByName('a').IsNull); + Q.ApplyUpdates(0); + AssertEquals('Still on correc field',1,Q.FieldByName('id').AsInteger); + AssertEquals('field value has been fetched from the database ','abcde',Q.FieldByName('a').AsString); + AssertEquals('field value has been fetched from the database ','fgh',Q.FieldByName('b').AsString); +end; + +Procedure TTestTSQLQuery.TestGeneratedRefreshSQL1Field; +var + Q: TSQLQuery; + T : TSQLTransaction; + I, J : Integer; + +begin + with SQLDBConnector do + begin + TryDropIfExist('testdefval'); + ExecuteDirect('create table testdefval (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint pk_testdefval primary key(id))'); + if Transaction.Active then + Transaction.Commit; + end; + Q:=SQLDBConnector.Query; + Q.SQL.Text:='select * from testdefval'; + Q.InsertSQL.Text:='insert into testdefval (id) values (:id)'; + Q.Open; + With Q.FieldByName('id') do + ProviderFlags:=ProviderFlags+[pfInKey]; + With Q.FieldByName('a') do + ProviderFlags:=ProviderFlags+[pfRefreshOnInsert,pfRefreshOnUpdate]; + Q.Insert; + Q.FieldByName('id').AsInteger:=1; + Q.Post; + AssertTrue('field value has not been fetched after post',Q.FieldByName('a').IsNull); + Q.ApplyUpdates(0); + AssertEquals('Still on correc field',1,Q.FieldByName('id').AsInteger); + AssertEquals('field value a has been fetched from the database ','abcde',Q.FieldByName('a').AsString); + AssertEquals('field value b has NOT been fetched from the database ','',Q.FieldByName('b').AsString); +end; + +Procedure TTestTSQLQuery.TestGeneratedRefreshSQLNoKey; +begin + with SQLDBConnector do + begin + TryDropIfExist('testdefval'); + ExecuteDirect('create table testdefval (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint pk_testdefval primary key(id))'); + if Transaction.Active then + Transaction.Commit; + end; + FMyQ:=SQLDBConnector.Query; + FMyQ.SQL.Text:='select * from testdefval'; + FMyQ.InsertSQL.Text:='insert into testdefval (id) values (:id)'; + FMyQ.Open; + With FMyQ.FieldByName('id') do + ProviderFlags:=ProviderFlags-[pfInKey]; + With FMyQ.FieldByName('a') do + ProviderFlags:=ProviderFlags+[pfRefreshOnInsert,pfRefreshOnUpdate]; + FMyQ.Insert; + FMyQ.FieldByName('id').AsInteger:=1; + FMyQ.Post; + AssertException('Cannot refresh without primary key',EUpdateError,@DoApplyUpdates); +end; + +Procedure TTestTSQLQuery.TestRefreshSQLMultipleRecords; + +begin + with SQLDBConnector do + begin + TryDropIfExist('testdefval'); + ExecuteDirect('create table testdefval (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint pk_testdefval primary key(id))'); + if Transaction.Active then + Transaction.Commit; + ExecuteDirect('insert into testdefval (id) values (123)'); + if Transaction.Active then + Transaction.Commit; + end; + FMyQ:=SQLDBConnector.Query; + FMyQ.SQL.Text:='select * from testdefval'; + FMyQ.InsertSQL.Text:='insert into testdefval (id) values (:id)'; + FMyQ.RefreshSQL.Text:='select * from testdefval'; + FMyQ.Open; + With FMyQ.FieldByName('id') do + ProviderFlags:=ProviderFlags+[pfInKey]; + With FMyQ.FieldByName('a') do + ProviderFlags:=ProviderFlags+[pfRefreshOnInsert,pfRefreshOnUpdate]; + FMyQ.Insert; + FMyQ.FieldByName('id').AsInteger:=1; + FMyQ.Post; + AssertException('Multiple records returned by RefreshSQL gives an error',EUpdateError,@DoApplyUpdates); +end; + +Procedure TTestTSQLQuery.TestRefreshSQLNoRecords; +begin + with SQLDBConnector do + begin + TryDropIfExist('testdefval'); + ExecuteDirect('create table testdefval (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint pk_testdefval primary key(id))'); + if Transaction.Active then + Transaction.Commit; + ExecuteDirect('insert into testdefval (id) values (123)'); + if Transaction.Active then + Transaction.Commit; + end; + FMyQ:=SQLDBConnector.Query; + FMyQ.SQL.Text:='select * from testdefval'; + FMyQ.InsertSQL.Text:='insert into testdefval (id) values (:id)'; + FMyQ.RefreshSQL.Text:='select * from testdefval where 1=2'; + FMyQ.Open; + With FMyQ.FieldByName('id') do + ProviderFlags:=ProviderFlags+[pfInKey]; + With FMyQ.FieldByName('a') do + ProviderFlags:=ProviderFlags+[pfRefreshOnInsert,pfRefreshOnUpdate]; + FMyQ.Insert; + FMyQ.FieldByName('id').AsInteger:=1; + FMyQ.Post; + AssertException('Multiple records returned by RefreshSQL gives an error',EUpdateError,@DoApplyUpdates); +end; + +Procedure TTestTSQLQuery.TestFetchAutoInc; +begin + with SQLDBConnector do + begin + if not (sqLastInsertID in Connection.ConnOptions) then + Ignore(STestNotApplicable); + TryDropIfExist('testautoinc'); + // Syntax may vary. This works for MySQL. + ExecuteDirect('create table testautoinc (id integer auto_increment, a varchar(5), constraint PK_AUTOINC primary key(id))'); + CommitDDL; + end; + FMyQ:=SQLDBConnector.Query; + FMyQ.SQL.Text:='select * from testautoinc'; + FMyQ.Open; + FMyQ.Insert; + FMyQ.FieldByName('a').AsString:='b'; + FMyQ.Post; + AssertTrue('ID field null after post',FMyQ.FieldByname('id').IsNull); + FMyQ.ApplyUpdates(0); + AssertTrue('ID field no longer null after applyupdates',Not FMyQ.FieldByname('id').IsNull); + // Should be 1 after the table was created, but this is not guaranteed... So we just test positive values. + AssertTrue('ID field has positive value',FMyQ.FieldByname('id').AsLargeInt>0); +end; + { TTestTSQLConnection }