* Merging revisions 43655 from trunk:

    ------------------------------------------------------------------------
    r43655 | michael | 2019-12-06 10:57:10 +0100 (Fri, 06 Dec 2019) | 1 line
    
    * Indicate and use sqSequences connection info, fix bug #0035241 (statement for sqlite next sequence value)
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@43657 -

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -189,7 +189,7 @@ constructor TIBConnection.Create(AOwner : TComponent);
 
 begin
   inherited;
-  FConnOptions := FConnOptions + [sqSupportParams, sqEscapeRepeat, sqSupportReturning];
+  FConnOptions := FConnOptions + [sqSupportParams, sqEscapeRepeat, sqSupportReturning, sqSequences];
   FBlobSegmentSize := 65535; //Shows we're using the maximum segment size
   FDialect := INVALID_DATA;
   FWireCompression := False;

packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

@@ -317,7 +317,7 @@ end;
 constructor TMSSQLConnection.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
-  FConnOptions := [sqSupportEmptyDatabaseName, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID];
+  FConnOptions := [sqSupportEmptyDatabaseName, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID, sqSequences];
   //FieldNameQuoteChars:=DoubleQuotes; //default
   Ftds := DBTDS_UNKNOWN;
 end;

packages/fcl-db/src/sqldb/oracle/oracleconnection.pp

@@ -1263,7 +1263,7 @@ end;
 constructor TOracleConnection.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
-  FConnOptions := FConnOptions + [sqEscapeRepeat];
+  FConnOptions := FConnOptions + [sqEscapeRepeat,sqSequences];
   FOciEnvironment := nil;
   FOciError := nil;
   FOciServer := nil;

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -276,7 +276,7 @@ constructor TPQConnection.Create(AOwner : TComponent);
 
 begin
   inherited;
-  FConnOptions := FConnOptions + [sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction,sqSupportReturning];
+  FConnOptions := FConnOptions + [sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction,sqSupportReturning,sqSequences];
   FieldNameQuoteChars:=DoubleQuotes;
   VerboseErrors:=True;
   FConnectionPool:=TThreadlist.Create;

packages/fcl-db/src/sqldb/sqldb.pp

@@ -173,7 +173,7 @@ type
   
   TDBLogNotifyEvent = Procedure (Sender : TSQLConnection; EventType : TDBEventType; Const Msg : String) of object;
 
-  TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID, sqSupportReturning);
+  TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID, sqSupportReturning,sqSequences);
   TConnOptions= set of TConnOption;
 
   TSQLConnectionOption = (scoExplicitConnect, scoApplyUpdatesChecksRowsAffected);

packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -107,6 +107,7 @@ Type
     procedure checkerror(const aerror: integer);
     function stringsquery(const asql: string): TArrayStringArray;
     procedure execsql(const asql: string);
+    function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; override;
   public
     constructor Create(AOwner : TComponent); override;
     procedure GetFieldNames(const TableName : string; List :  TStrings); override;
@@ -296,7 +297,7 @@ end;
 constructor TSQLite3Connection.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
-  FConnOptions := [sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction, sqLastInsertID];
+  FConnOptions := [sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction, sqLastInsertID, sqSequences];
   FieldNameQuoteChars:=DoubleQuotes;
   FOpenFlags:=DefaultOpenFlags;
 end;
@@ -893,6 +894,11 @@ begin
    databaseerror(str1);
 end;
 
+function TSQLite3Connection.GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
+begin
+  Result:=Format('SELECT seq+%d FROM sqlite_sequence WHERE (name=''%s'')',[IncrementBy,SequenceName]);
+end;
+
 function execcallback(adata: pointer; ncols: longint; //adata = PStringArray
                 avalues: PPchar; anames: PPchar):longint; cdecl;
 var
@@ -939,6 +945,14 @@ begin
     stTables     : result := 'select name as table_name from sqlite_master where type = ''table'' order by 1';
     stSysTables  : result := 'select ''sqlite_master'' as table_name';
     stColumns    : result := 'pragma table_info(''' + (SchemaObjectName) + ''')';
+    stSequences  : Result := 'SELECT 1 as recno, '+
+                          '''' + DatabaseName + ''' as sequence_catalog,' +
+                          '''''                     as sequence_schema,' +
+                          'name as sequence_name ' +
+                        'FROM ' +
+                          'sqlite_sequence ' +
+                        'ORDER BY ' +
+                          'name';
   else
     DatabaseError(SMetadataUnavailable)
   end; {case}

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -56,6 +56,8 @@ type
     Function InternalGetFieldDataset : TDataSet; override;
   public
     procedure TryDropIfExist(ATableName : String);
+    procedure TryCreateSequence(ASequenceName : String);
+    procedure TryDropSequence(ASequenceName: String);
     destructor Destroy; override;
     constructor Create; override;
     procedure ExecuteDirect(const SQL: string);
@@ -684,6 +686,53 @@ begin
   end;
 end;
 
+procedure TSQLDBConnector.TryDropSequence(ASequenceName: String);
+
+var
+  NoSeq : Boolean;
+
+begin
+  NoSeq:=False;
+  try
+    case SQLServerType of
+      ssInterbase,
+      ssFirebird: FConnection.ExecuteDirect('DROP GENERATOR '+ASequenceName);
+      ssOracle,
+      ssPostgreSQL,
+      ssSybase,
+      ssMSSQL : FConnection.ExecuteDirect('DROP SEQUENCE '+ASequenceName+' START WITH 1 INCREMENT BY 1');
+      ssSQLite : FConnection.ExecuteDirect('delete from sqlite_sequence where (name='''+ASequenceName+''')');
+    else
+      NoSeq:=True;
+    end;
+  except
+    FTransaction.RollbackRetaining;
+  end;
+  if NoSeq then
+    Raise EDatabaseError.Create('Engine does not support sequences');
+end;
+
+procedure TSQLDBConnector.TryCreateSequence(ASequenceName: String);
+
+var
+  NoSeq : Boolean;
+
+begin
+  NoSeq:=False;
+  case SQLServerType of
+    ssInterbase,
+    ssFirebird: FConnection.ExecuteDirect('CREATE GENERATOR '+ASequenceName);
+    ssOracle,
+    ssPostgreSQL,
+    ssSybase,
+    ssMSSQL : FConnection.ExecuteDirect('CREATE SEQUENCE '+ASequenceName+' START WITH 1 INCREMENT BY 1');
+    ssSQLite : FConnection.ExecuteDirect('insert into sqlite_sequence (name,seq) values ('''+ASequenceName+''',1)');
+  else
+    Raise EDatabaseError.Create('Engine does not support sequences');
+  end;
+end;
+
+
 procedure TSQLDBConnector.ExecuteDirect(const SQL: string);
 begin
   Connection.ExecuteDirect(SQL);

packages/fcl-db/tests/testsqldb.pas

@@ -73,6 +73,7 @@ type
     procedure TestUseExplicitTransaction;
     procedure TestExplicitConnect;
     procedure TestGetStatementInfo;
+    procedure TestGetNextValue;
   end;
 
   { TTestTSQLScript }
@@ -871,6 +872,22 @@ begin
   AssertEquals('Updateable', False, StmtInfo.Updateable);
 end;
 
+procedure TTestTSQLConnection.TestGetNextValue;
+begin
+  if not (sqSequences in SQLDBConnector.Connection.ConnOptions) then
+    Ignore('Connector '+SQLDBConnector.Connection.ClassName+' does not support sequences');
+  if SQLServerType=ssSQLite then
+    begin
+    SQLDBConnector.TryDropIfExist('me');
+    SQLDBConnector.ExecuteDirect('create table me (a integer primary key autoincrement,b int)');
+    SQLDBConnector.ExecuteDirect('insert into me (b) values (1)');// Will create table sqlite_sequence if it didn't exist yet
+    SQLDBConnector.ExecuteDirect('drop table me');
+    end;
+  SQLDBConnector.TryDropSequence('me');
+  SQLDBConnector.TryCreateSequence('me');
+  AssertTrue('Get value',SQLDBConnector.Connection.GetNextValue('me',1)>0);
+end;
+
 
 { TTestTSQLScript }