Browse Source

--- Merging r23071 into '.':
U packages/fcl-db/src/base/db.pas
U packages/fcl-db/src/base/fields.inc
--- Merging r23072 into '.':
U packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r23111 into '.':
U packages/fcl-db/src/base/dataset.inc
--- Merging r23113 into '.':
U packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r23114 into '.':
G packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r23120 into '.':
G packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r23123 into '.':
U packages/fcl-db/src/sqldb/readme.txt
--- Merging r23136 into '.':
U packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
U packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
U packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
U packages/fcl-db/src/sqldb/postgres/pqconnection.pp
G packages/fcl-db/src/sqldb/odbc/odbcconn.pas
G packages/fcl-db/src/sqldb/interbase/ibconnection.pp
U packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r23137 into '.':
G packages/fcl-db/src/sqldb/sqldb.pp

# revisions: 23071,23072,23111,23113,23114,23120,23123,23136,23137
r23071 | lacak | 2012-11-28 07:47:33 +0100 (Wed, 28 Nov 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/db.pas
M /trunk/packages/fcl-db/src/base/fields.inc

fcl-db: base: add AsLargeInt for TFloatField
r23072 | lacak | 2012-11-28 08:33:54 +0100 (Wed, 28 Nov 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp

fcl-db: ibconnection: small cleanup
r23111 | ludob | 2012-12-04 11:00:43 +0100 (Tue, 04 Dec 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/dataset.inc

TDataset: fixed daAbort TDataAction behavior (was not aborting). Fixed TDataset.Delete calling OnDeleteError instead of OnPostError.
r23113 | michael | 2012-12-04 20:54:03 +0100 (Tue, 04 Dec 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas

* Autocommit OFF by default, bug ID #23429
r23114 | lacak | 2012-12-05 09:17:01 +0100 (Wed, 05 Dec 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas

fcl-db: odbc: map MONEY columns to TCurrencyField instead of TFloatField (test TestSupportCurrencyFields)
r23120 | lacak | 2012-12-07 08:58:45 +0100 (Fri, 07 Dec 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas

fcl-db: odbc: map 'call' to stExecProcedure.
(revealed by test TestOpenStoredProc for MySQL ODBC)
r23123 | reiniero | 2012-12-07 16:26:17 +0100 (Fri, 07 Dec 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/readme.txt

* fcl-db sqldb: cosmetic; added info to readme.txt
r23136 | lacak | 2012-12-13 12:16:25 +0100 (Thu, 13 Dec 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp
M /trunk/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas
M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

fcl-db: introduce FSelectable as new TSQLCursor class field. Update sql connectors to set it after Preparation or Execution of sql statement to signal if there will be or is result set. This change is neutral. In next commit I will use FSelectable to determine if allow Open or raise SErrNoSelectStatement.
(motivation is that there are many various statements, that are not stSelect nor stExecProcedure, which also return result set)
r23137 | lacak | 2012-12-13 12:26:45 +0100 (Thu, 13 Dec 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

fcl-db: switch from usage of [stSelect, stExecProcedure] to FSelectable to determine if there is result set.
(see also previous commit)

git-svn-id: branches/fixes_2_6@23946 -

marco 12 years ago
parent
commit
dc626fb17a

+ 2 - 2
packages/fcl-db/src/base/dataset.inc

@@ -1543,7 +1543,7 @@ begin
 {$endif}
     DoBeforeDelete;
     DoBeforeScroll;
-    If Not TryDoing(@InternalDelete,OnPostError) then exit;
+    If Not TryDoing(@InternalDelete,OnDeleteError) then exit;
 {$ifdef dsdebug}
     writeln ('Delete: Internaldelete succeeded');
 {$endif}
@@ -2188,7 +2188,7 @@ begin
           Ev(Self,E,Retry);
         Case Retry of
           daFail : Raise;
-          daAbort : Result:=False;
+          daAbort : Abort;
         end;
         end;
     else

+ 2 - 0
packages/fcl-db/src/base/db.pas

@@ -633,12 +633,14 @@ type
     procedure SetPrecision(const AValue: Longint);
   protected
     function GetAsFloat: Double; override;
+    function GetAsLargeInt: LargeInt; override;
     function GetAsLongint: Longint; override;
     function GetAsVariant: variant; override;
     function GetAsString: string; override;
     function GetDataSize: Integer; override;
     procedure GetText(var theText: string; ADisplayText: Boolean); override;
     procedure SetAsFloat(AValue: Double); override;
+    procedure SetAsLargeInt(AValue: LargeInt); override;
     procedure SetAsLongint(AValue: Longint); override;
     procedure SetAsString(const AValue: string); override;
     procedure SetVarValue(const AValue: Variant); override;

+ 10 - 0
packages/fcl-db/src/base/fields.inc

@@ -1797,6 +1797,11 @@ begin
     Result:=Null;
 end;
 
+function TFloatField.GetAsLargeInt: LargeInt;
+begin
+  Result:=Round(GetAsFloat);
+end;
+
 function TFloatField.GetAsLongint: Longint;
 
 begin
@@ -1864,6 +1869,11 @@ begin
     RangeError(AValue,FMinValue,FMaxValue);
 end;
 
+procedure TFloatField.SetAsLargeInt(AValue: LargeInt);
+begin
+  SetAsFloat(AValue);
+end;
+
 procedure TFloatField.SetAsLongint(AValue: Longint);
 
 begin

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

@@ -113,8 +113,8 @@ type
     function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
   public
     constructor Create(AOwner : TComponent); override;
-    procedure CreateDB; override;
     function GetConnectionInfo(InfoType:TConnInfoType): string; override;
+    procedure CreateDB; override;
     procedure DropDB; override;
     //Segment size is not used in the code; property kept for backward compatibility
     property BlobSegmentSize : word read FBlobSegmentSize write FBlobSegmentSize; deprecated;
@@ -381,7 +381,7 @@ begin
     case InfoType of
       citServerType:
         // Firebird returns own name in ServerVersion; Interbase 7.5 doesn't.
-        if pos('FIREBIRD',UpperCase(FDatabaseInfo.ServerVersionString))=0 then
+        if Pos('Firebird', FDatabaseInfo.ServerVersionString)=0 then
           result := 'Interbase'
         else
           result := 'Firebird';
@@ -483,7 +483,6 @@ const
 var
   BeginPos,EndPos,StartLook,i: integer;
   NumericPart: string;
-  Version: integer;
 begin
   result := '';
   // Ignore 6.x version number in front of "Firebird"
@@ -742,8 +741,9 @@ begin
       isc_info_sql_stmt_delete: FStatementType := stDelete;
       isc_info_sql_stmt_exec_procedure: FStatementType := stExecProcedure;
     end;
+    FSelectable := FStatementType in [stSelect,stExecProcedure];
 
-    if FStatementType in [stSelect,stExecProcedure] then
+    if FSelectable then
       begin
       if isc_dsql_describe(@Status[0], @Statement, 1, SQLDA) <> 0 then
         CheckError('PrepareSelect', Status);

+ 3 - 4
packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

@@ -178,7 +178,6 @@ type
     FQuery: string;                                   // :ParamNames converted to $1,$2,..,$n
     FParamReplaceString: string;
   protected
-    FCanOpen: boolean;                                // can return rows?
     FRowsAffected: integer;
     function ReplaceParams(AParams: TParams): string; // replaces parameters placeholders $1,$2,..$n in FQuery with supplied values in AParams
     procedure Prepare(Buf: string; AParams: TParams);
@@ -608,17 +607,17 @@ begin
 
   res := SUCCEED;
   repeat
-    c.FCanOpen := dbcmdrow(FDBProc)=SUCCEED;
+    c.FSelectable := dbcmdrow(FDBProc)=SUCCEED;
     c.FRowsAffected := dbcount(FDBProc);
     if assigned(dbiscount) and not dbiscount(FDBProc) then
       c.FRowsAffected := -1;
 
-    if not c.FCanOpen then  //Sybase stored proc.
+    if not c.FSelectable then  //Sybase stored proc.
     begin
       repeat until dbnextrow(FDBProc) = NO_MORE_ROWS;
       res := CheckError( dbresults(FDBProc) );
     end;
-  until c.FCanOpen or (res = NO_MORE_RESULTS) or (res = FAIL);
+  until c.FSelectable or (res = NO_MORE_RESULTS) or (res = FAIL);
 
   if res = NO_MORE_RESULTS then
     Fstatus := NO_MORE_ROWS

+ 7 - 9
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -59,7 +59,6 @@ Type
   TCursorName = Class(TSQLCursor)
   protected
     FRes: PMYSQL_RES;                   { Record pointer }
-    FNeedData : Boolean;
     FStatement : String;
     Row : MYSQL_ROW;
     Lengths : pculong;                  { Lengths of the columns of the current row }
@@ -515,8 +514,6 @@ begin
     FStatement:=Buf;
     if assigned(AParams) and (AParams.count > 0) then
       FStatement := AParams.ParseSQL(FStatement,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psSimulated,paramBinding,ParamReplaceString);
-    if FStatementType in [stSelect,stExecProcedure] then
-      FNeedData:=True;
     end
 end;
 
@@ -540,8 +537,6 @@ Var
 
 begin
   C:=Cursor as TCursorName;
-  if c.FStatementType in [stSelect,stExecProcedure] then
-    c.FNeedData:=False;
   if assigned(C.FRes) then
     begin
     mysql_free_result(C.FRes);
@@ -582,15 +577,18 @@ begin
       begin
       C.RowsAffected := mysql_affected_rows(FMYSQL);
       C.LastInsertID := mysql_insert_id(FMYSQL);
-      if C.FNeedData then
-        repeat
-        Res:=mysql_store_result(FMySQL); //returns a null pointer if the statement didn't return a result set
+      C.FSelectable  := False;
+      repeat
+        Res:=mysql_store_result(FMySQL); //returns a null pointer also if the statement didn't return a result set
+        if mysql_errno(FMySQL)<>0 then
+          MySQLError(FMySQL, SErrGettingResult, Self);
         if Res<>nil then
           begin
           mysql_free_result(C.FRes);
           C.FRes:=Res;
+          C.FSelectable:=True;
           end;
-        until mysql_next_result(FMySQL)<>0;
+      until mysql_next_result(FMySQL)<>0;
       end;
     end;
 end;

+ 34 - 8
packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -303,10 +303,14 @@ end;
 
 function TODBCConnection.StrToStatementType(s : string) : TStatementType;
 begin
-  S:=Lowercase(s);
-  if s = 'transform' then Result:=stSelect //MS Access
-  else if s = 'exec' then Result:=stExecProcedure
-  else Result := inherited StrToStatementType(s);
+  case Lowercase(s) of
+    'transform': // MS Access
+      Result := stSelect;
+    'exec', 'call':
+      Result := stExecProcedure;
+    else
+      Result := inherited StrToStatementType(s);
+  end;
 end;
 
 procedure TODBCConnection.SetParameters(ODBCCursor: TODBCCursor; AParams: TParams);
@@ -695,7 +699,7 @@ function TODBCConnection.StartDBTransaction(trans: TSQLHandle; AParams:string):
 var AutoCommit: SQLINTEGER;
 begin
   // set some connection attributes
-  if StrToBoolDef(Params.Values['AUTOCOMMIT'], True) then
+  if StrToBoolDef(Params.Values['AUTOCOMMIT'], False) then
     AutoCommit := SQL_AUTOCOMMIT_ON
   else
     AutoCommit := SQL_AUTOCOMMIT_OFF;
@@ -743,6 +747,7 @@ const
 var
   ODBCCursor:TODBCCursor;
   Res:SQLRETURN;
+  ColumnCount:SQLSMALLINT;
 begin
   ODBCCursor:=cursor as TODBCCursor;
 
@@ -761,6 +766,11 @@ begin
 
     if (Res<>SQL_NO_DATA) then ODBCCheckResult( Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not execute statement.' );
 
+    if ODBCSucces(SQLNumResultCols(ODBCCursor.FSTMTHandle, ColumnCount)) then
+      ODBCCursor.FSelectable:=ColumnCount>0
+    else
+      ODBCCursor.FSelectable:=False;
+
   finally
     // free parameter buffers
     FreeParamBuffers(ODBCCursor);
@@ -833,11 +843,11 @@ begin
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_CHAR, buffer, FieldDef.Size+1, @StrLenOrInd);
     ftSmallint:           // mapped to TSmallintField
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SSHORT, buffer, SizeOf(Smallint), @StrLenOrInd);
-    ftInteger,ftWord,ftAutoInc:     // mapped to TLongintField
+    ftInteger,ftWord,ftAutoInc:   // mapped to TLongintField
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SLONG, buffer, SizeOf(Longint), @StrLenOrInd);
     ftLargeint:           // mapped to TLargeintField
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SBIGINT, buffer, SizeOf(Largeint), @StrLenOrInd);
-    ftFloat:              // mapped to TFloatField
+    ftFloat,ftCurrency:   // mapped to TFloatField
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_DOUBLE, buffer, SizeOf(Double), @StrLenOrInd);
     ftTime:               // mapped to TTimeField
     begin
@@ -1078,7 +1088,7 @@ var
   ColName,TypeName:string;
   FieldType:TFieldType;
   FieldSize:word;
-  AutoIncAttr, Updatable: SQLINTEGER;
+  AutoIncAttr, Updatable, FixedPrecScale: SQLINTEGER;
 begin
   ODBCCursor:=cursor as TODBCCursor;
 
@@ -1211,6 +1221,22 @@ begin
       SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get updatable attribute for column %d.',[i]
     );
 
+    if FieldType in [ftFloat] then
+    begin
+      ODBCCheckResult(
+        SQLColAttribute(ODBCCursor.FSTMTHandle,
+                        i,
+                        SQL_DESC_FIXED_PREC_SCALE,
+                        nil,
+                        0,
+                        nil,
+                        @FixedPrecScale),
+        SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get money attribute for column %d.',[i]
+      );
+      if FixedPrecScale=SQL_TRUE then
+        FieldType:=ftCurrency;
+    end;
+
     if FieldType=ftUnknown then // if unknown field type encountered, try finding more specific information about the ODBC SQL DataType
     begin
       SetLength(TypeName,TypeNameDefaultLength); // also garantuees uniqueness

+ 1 - 0
packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -711,6 +711,7 @@ begin
 //      atransaction.Rollback;
       raise E;
       end;
+    FSelectable := assigned(res) and (PQresultStatus(res)=PGRES_TUPLES_OK);
     end;
 end;
 

+ 81 - 24
packages/fcl-db/src/sqldb/readme.txt

@@ -1,11 +1,14 @@
-SQLDB readme file, 20 Aug 2005, Joost van der Sluis
+SQLDB readme file, initially by Joost van der Sluis
 
-since there is no real documentation about sqldb yet, this should be regarded as
-a small reminder to myself, and to others who want to write their own
-connections.
+Since there is no real documentation about sqldb yet, this should be regarded as
+the beginning of documentation for writing your own connections as well as modifying the code.
 
-From the TSQLConnection point-of-view the following methods are called if a
-select-statement is used:
+Code flow
+=========
+
+** Select statement
+From the TSQLConnection point of view the following methods are called if a
+select statement is used:
 
 OPEN:
   Prepare: (is only called when prepared is false)
@@ -15,7 +18,7 @@ OPEN:
             - Execute
             - AddFieldDefs (only if called for the first time after a prepare)
 
-GETNEXTPAKCET: (probably called several times, offcourse)
+GETNEXTPACKET: (probably called several times, of course)
             - Fetch
             - Loadfield
 
@@ -23,6 +26,7 @@ CLOSE:
             - FreeFieldBuffers
             - UnPrepareStatement (Only if prepare is False, thus if prepared queries
                          were not supported)
+												 
 UnPrepare:
             - UnPrepareStatement
             
@@ -30,8 +34,9 @@ DESTROY:
             - DeAllocateCursorHandle (Also called if the Connection is changed)
             
 
-From the TSQLConnection point-of-view the following methods are called if a non-
-select-statement is used (execsql):
+** Non select statement (execsql)
+From the TSQLConnection point of view the following methods are called if a non-
+select statement is used (execsql):
 
 Prepare: (is only called when prepared is false)
             - AllocateCursorHandle (only if the cursor <> nil)
@@ -42,7 +47,6 @@ Execute:
             - UnPrepareStatement (Only if prepare is False, thus if prepared queries
                          were not supported)
 
-
 UNPREPARE:
             - UnPrepareStatement
 
@@ -50,32 +54,85 @@ DESTROY:
             - DeAllocateCursorHandle (Also called if the Connection is changed)
 
 
-A short description of what each method in a TSQLConnection should do:
+Writing your own T*Connection
+=============================
 
-* Function AllocateCursorHandle : TSQLCursor; override;
+** Required methods
+A short description of what some methods in a TSQLConnection must do:
 
+* Function AllocateCursorHandle : TSQLCursor; override;
 This function creates and returns a TSQLcursor which can be used by any query
-for the used type of database. The cursor is only database-dependent, it is
-deallocated when the connection of the query changes, or if the query is
-destroyed.
+for the used type of database. The cursor is strictly database-dependent
+It is deallocated:
+- when the connection of the query changes, or
+- if the query is destroyed.
 
 * Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); override;
-
 This function deallocates the TSQLCursor, and sets its value to nil.
 
-* procedure PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams); override;
+* Function AllocateTransactionHandle : TSQLHandle; virtual; abstract;
+*** to do ***
+
+* function GetTransactionHandle(trans : TSQLHandle): pointer; virtual; abstract;
+*** to do ***
+
+* function Commit(trans : TSQLHandle) : boolean; virtual; abstract;
+This function commits the statement in the context of 
+transaction trans.
+
+* function RollBack(trans : TSQLHandle) : boolean; virtual; abstract;
+This function rolls back/reverts the statement in the context of 
+transaction trans
+
+* function StartdbTransaction(trans : TSQLHandle; aParams : string) : boolean; virtual; abstract;
+This function starts the transaction trans.
 
+* procedure CommitRetaining(trans : TSQLHandle); virtual; abstract;
+This procedure commits the transaction tran and immediately starts the transaction again 
+(or opens a new transaction with the same parameters/settings as tran).
+
+* procedure RollBackRetaining(trans : TSQLHandle); virtual; abstract;
+This procedure rolls back the transaction tran and immediately opens a
+new transaction with the same parameters/settings as the original transaction.
+
+* procedure UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string); virtual;
+*** to do ***
+
+* procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TfieldDefs); virtual; abstract;
+*** to do ***
+
+* function LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; virtual; abstract;
+*** to do ***
+
+* procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); virtual; abstract;
+*** to do ***
+
+* procedure PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams); override;
 This functions prepares the query which is given in buf.
+It's only called if Prepared is True (and cursor FPrepared is False).
 
-It's only called if Prepared is True.
-If the database supports prepared queries for the kind of sql-statement (in
-cursor.FStatementType) and the prepare was successfully, then cursor.FPrepared
-is set to True, so that prepare will not be called again, until UnPrepared
-is called. (which sets FPrepared to False)
+If the database supports prepared queries for the kind of SQL statement indicated 
+in cursor.FStatementType and the prepare was successful, then cursor.FPrepared
+is set to True. This keeps Prepare from being called again until UnPrepared
+is called (which sets FPrepared to False).
+
+* procedure UnPrepareStatement(cursor : TSQLCursor); virtual; abstract;
+This procedure sets cursor.FPrepared to false and performs cleanup tasks to
+unprepare the query statement.
 
 * procedure FreeFldBuffers(cursor : TSQLCursor); override;
+This procedure is called if a Select query is closed. This procedure is used to
+handle all actions which are needed to close a select statement.
+
+* procedure Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams); virtual; abstract;
+Tells the database to execute the statement. No data are loaded from the database client library into the sqldb data set buffers.
 
-This procedure is called if a Select-query is closed. This procedure is used to
-handle all actions which are needed to close a select-statement.
+* function Fetch(cursor : TSQLCursor) : boolean; virtual; abstract;
+Retrieves some resultset data from the database client library and stores them in sqldb dataset buffers.
 
+** Optional (but recommended) methods
+* function GetConnectionInfo(InfoType:TConnInfoType): string; virtual;
+Returns metadata information about server and client/driver type, version.
 
+* function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
+Returns an SQL string that retrieves metadata about tables, columns, etc.

+ 49 - 42
packages/fcl-db/src/sqldb/sqldb.pp

@@ -53,6 +53,7 @@ type
   TSQLCursor = Class(TSQLHandle)
   public
     FPrepared      : Boolean;
+    FSelectable    : Boolean;
     FInitFieldDef  : Boolean;
     FStatementType : TStatementType;
     FSchemaType    : TSchemaType;
@@ -1124,6 +1125,7 @@ begin
     // unpredictable results.
     if not assigned(fcursor) then
       FCursor := Db.AllocateCursorHandle;
+    FCursor.FSelectable:=True; // let PrepareStatement and/or Execute alter it
     FCursor.FStatementType:=StmType;
     FCursor.FSchemaType := FSchemaType;
     if ServerFiltered then
@@ -1138,8 +1140,7 @@ begin
         Log(detPrepare,FSQLBuf);
       Db.PrepareStatement(Fcursor,sqltr,FSQLBuf,FParams);
       end;
-    if (FCursor.FStatementType in [stSelect,stExecProcedure]) then
-      FCursor.FInitFieldDef := True;
+    FCursor.FInitFieldDef := FCursor.FSelectable;
     end;
 end;
 
@@ -1163,7 +1164,7 @@ end;
 
 function TCustomSQLQuery.Fetch : boolean;
 begin
-  if not (Fcursor.FStatementType in [stSelect,stExecProcedure]) then
+  if not FCursor.FSelectable then
     Exit;
 
   if not FIsEof then FIsEOF := not TSQLConnection(Database).Fetch(Fcursor);
@@ -1202,7 +1203,7 @@ procedure TCustomSQLQuery.InternalClose;
 begin
   if not IsReadFromPacket then
     begin
-    if StatementType in [stSelect,stExecProcedure] then FreeFldBuffers;
+    if assigned(FCursor) and FCursor.FSelectable then FreeFldBuffers;
     // Database and FCursor could be nil, for example if the database is not assigned, and .open is called
     if (not IsPrepared) and (assigned(database)) and (assigned(FCursor)) then TSQLConnection(database).UnPrepareStatement(FCursor);
     end;
@@ -1422,63 +1423,69 @@ begin
     begin
     if not assigned(fcursor) then
       FCursor := TSQLConnection(Database).AllocateCursorHandle;
+    FCursor.FSelectable:=True;
     FCursor.FStatementType:=stSelect;
     FUpdateable:=True;
     end
   else
     Prepare;
-  if FCursor.FStatementType in [stSelect,stExecProcedure] then
+
+  if not FCursor.FSelectable then
+    DatabaseError(SErrNoSelectStatement,Self);
+
+  if not ReadFromFile then
     begin
-    if not ReadFromFile then
+    // Call UpdateServerIndexDefs before Execute, to avoid problems with connections
+    // which do not allow processing multiple recordsets at a time. (Microsoft
+    // calls this MARS, see bug 13241)
+    if DefaultFields and FUpdateable and FusePrimaryKeyAsKey and (not IsUniDirectional) then
+      UpdateServerIndexDefs;
+
+    Execute;
+    if not FCursor.FSelectable then
+      DatabaseError(SErrNoSelectStatement,Self);
+
+    // InternalInitFieldDef is only called after a prepare. i.e. not twice if
+    // a dataset is opened - closed - opened.
+    if FCursor.FInitFieldDef then InternalInitFieldDefs;
+    if DefaultFields then
       begin
-      // Call UpdateServerIndexDefs before Execute, to avoid problems with connections
-      // which do not allow processing multiple recordsets at a time. (Microsoft
-      // calls this MARS, see bug 13241)
-      if DefaultFields and FUpdateable and FusePrimaryKeyAsKey and (not IsUniDirectional) then
-        UpdateServerIndexDefs;
-      Execute;
-      // InternalInitFieldDef is only called after a prepare. i.e. not twice if
-      // a dataset is opened - closed - opened.
-      if FCursor.FInitFieldDef then InternalInitFieldDefs;
-      if DefaultFields then
-        begin
-        CreateFields;
+      CreateFields;
 
-        if FUpdateable and (not IsUniDirectional) then
+      if FUpdateable and (not IsUniDirectional) then
+        begin
+        if FusePrimaryKeyAsKey then
           begin
-          if FusePrimaryKeyAsKey then
+          for tel := 0 to ServerIndexDefs.count-1 do
             begin
-            for tel := 0 to ServerIndexDefs.count-1 do
+            if ixPrimary in ServerIndexDefs[tel].options then
               begin
-              if ixPrimary in ServerIndexDefs[tel].options then
-                begin
-                  IndexFields := TStringList.Create;
-                  ExtractStrings([';'],[' '],pchar(ServerIndexDefs[tel].fields),IndexFields);
-                  for fieldc := 0 to IndexFields.Count-1 do
-                    begin
-                    F := Findfield(IndexFields[fieldc]);
-                    if F <> nil then
-                      F.ProviderFlags := F.ProviderFlags + [pfInKey];
-                    end;
-                  IndexFields.Free;
-                end;
+                IndexFields := TStringList.Create;
+                ExtractStrings([';'],[' '],pchar(ServerIndexDefs[tel].fields),IndexFields);
+                for fieldc := 0 to IndexFields.Count-1 do
+                  begin
+                  F := Findfield(IndexFields[fieldc]);
+                  if F <> nil then
+                    F.ProviderFlags := F.ProviderFlags + [pfInKey];
+                  end;
+                IndexFields.Free;
               end;
             end;
           end;
-        end
-      else
-        BindFields(True);
+        end;
       end
     else
       BindFields(True);
-    if not ReadOnly and not FUpdateable and (FSchemaType=stNoSchema) then
-      begin
-      if (trim(FDeleteSQL.Text) <> '') or (trim(FUpdateSQL.Text) <> '') or
-         (trim(FInsertSQL.Text) <> '') then FUpdateable := True;
-      end
     end
   else
-    DatabaseError(SErrNoSelectStatement,Self);
+    BindFields(True);
+
+  if not ReadOnly and not FUpdateable and (FSchemaType=stNoSchema) then
+    begin
+    if (trim(FDeleteSQL.Text) <> '') or (trim(FUpdateSQL.Text) <> '') or
+       (trim(FInsertSQL.Text) <> '') then FUpdateable := True;
+    end;
+
   inherited InternalOpen;
 end;
 

+ 2 - 1
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -273,8 +273,9 @@ begin
 {$endif}
   if (fstate<=sqliteerrormax) then
     checkerror(sqlite3_reset(fstatement));
+  FSelectable :=sqlite3_column_count(fstatement)>0;
   RowsAffected:=sqlite3_changes(fhandle);
-  if (fstate=sqlite_row) then 
+  if (fstate=sqlite_row) then
     fstate:= sqliteerrormax; //first row
 end;