Browse Source

--- Merging r20483 into '.':
U packages/fcl-db/tests/testfieldtypes.pas
U packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Merging r20529 into '.':
U packages/fcl-db/src/export/fpsqlexport.pp
--- Merging r20530 into '.':
U packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r20531 into '.':
U packages/fcl-db/src/base/bufdataset.pas
--- Merging r20532 into '.':
U packages/fcl-db/src/base/db.pas
--- Merging r20533 into '.':
U packages/fcl-db/src/base/dataset.inc
G packages/fcl-db/src/base/db.pas
--- Merging r20535 into '.':
U packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

# revisions: 20483,20529,20530,20531,20532,20533,20535
------------------------------------------------------------------------
r20483 | marco | 2012-03-08 20:57:20 +0100 (Thu, 08 Mar 2012) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
M /trunk/packages/fcl-db/tests/testfieldtypes.pas

* Patch + test to map integer field with auto_increment property to ftautoinc
Mantis #21438, patch by Lacak2.

------------------------------------------------------------------------
------------------------------------------------------------------------
r20529 | michael | 2012-03-17 11:06:04 +0100 (Sat, 17 Mar 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/export/fpsqlexport.pp

* Patch from Reinier Olislagers to fix quoting for memo fields (bug 19937)
------------------------------------------------------------------------
------------------------------------------------------------------------
r20530 | marco | 2012-03-17 12:56:29 +0100 (Sat, 17 Mar 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas

* Patch from Mantis #14944 implementing odbc transactions. Also fixes related #19902

------------------------------------------------------------------------
------------------------------------------------------------------------
r20531 | marco | 2012-03-17 13:21:45 +0100 (Sat, 17 Mar 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas

* Patch from Mek to kill memleak while inserting, Mantis #18004

------------------------------------------------------------------------
------------------------------------------------------------------------
r20532 | marco | 2012-03-17 13:40:23 +0100 (Sat, 17 Mar 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/db.pas

* setblockreadsize virtual, noticed when cleaning out old bugreport #8203.

------------------------------------------------------------------------
------------------------------------------------------------------------
r20533 | marco | 2012-03-17 15:07:46 +0100 (Sat, 17 Mar 2012) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/dataset.inc
M /trunk/packages/fcl-db/src/base/db.pas

* add blockreadnext (same implementation as next for now), and change
.next to call it. Mantis #8203

------------------------------------------------------------------------
------------------------------------------------------------------------
r20535 | marco | 2012-03-17 18:23:51 +0100 (Sat, 17 Mar 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

* Password check for sqlite3 functionality, Mantis #18774

------------------------------------------------------------------------

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

marco 13 years ago
parent
commit
6213067470

+ 5 - 1
packages/fcl-db/src/base/bufdataset.pas

@@ -1899,7 +1899,9 @@ var i         : Integer;
     StartInd  : Integer;
     StartInd  : Integer;
     RemRec    : pointer;
     RemRec    : pointer;
     RemRecBookmrk : TBufBookmark;
     RemRecBookmrk : TBufBookmark;
+    free_rec: Boolean;
 begin
 begin
+  free_rec := False;
   InternalSetToRecord(ActiveBuffer);
   InternalSetToRecord(ActiveBuffer);
   // Remove the record from all active indexes
   // Remove the record from all active indexes
   FCurrentIndex.StoreCurrentRecIntoBookmark(@RemRecBookmrk);
   FCurrentIndex.StoreCurrentRecIntoBookmark(@RemRecBookmrk);
@@ -1921,11 +1923,13 @@ begin
     begin
     begin
     if FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind <> ukModify then
     if FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind <> ukModify then
       FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := nil;  //this 'disables' the updatebuffer
       FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := nil;  //this 'disables' the updatebuffer
+    free_rec := FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind = ukInsert; // mantis #18004
     end;
     end;
   FCurrentIndex.StoreCurrentRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData);
   FCurrentIndex.StoreCurrentRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData);
   FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData := RemRecBookmrk;
   FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData := RemRecBookmrk;
   FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind := ukDelete;
   FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind := ukDelete;
-
+  if free_rec then
+    FreeRecordBuffer(TRecordBuffer(RemRecBookmrk.BookmarkData));
   dec(FBRecordCount);
   dec(FBRecordCount);
 end;
 end;
 
 

+ 8 - 0
packages/fcl-db/src/base/dataset.inc

@@ -2026,6 +2026,14 @@ end;
 
 
 Procedure TDataset.Next;
 Procedure TDataset.Next;
 
 
+begin
+  if BlockReadSize>0 then
+    BlockReadNext
+  else
+    MoveBy(1);
+end;
+
+Procedure TDataset.BlockReadNext;
 begin
 begin
   MoveBy(1);
   MoveBy(1);
 end;
 end;

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

@@ -1406,13 +1406,14 @@ type
     Function GetActive : boolean;
     Function GetActive : boolean;
     Procedure UnRegisterDataSource(ADatasource : TDatasource);
     Procedure UnRegisterDataSource(ADatasource : TDatasource);
     Procedure UpdateFieldDefs;
     Procedure UpdateFieldDefs;
-    procedure SetBlockReadSize(AValue: Integer);
+    procedure SetBlockReadSize(AValue: Integer); virtual;
     Procedure SetFieldDefs(AFieldDefs: TFieldDefs);
     Procedure SetFieldDefs(AFieldDefs: TFieldDefs);
     procedure DoInsertAppendRecord(const Values: array of const; DoAppend : boolean);
     procedure DoInsertAppendRecord(const Values: array of const; DoAppend : boolean);
   protected
   protected
     procedure RecalcBufListSize;
     procedure RecalcBufListSize;
     procedure ActivateBuffers; virtual;
     procedure ActivateBuffers; virtual;
     procedure BindFields(Binding: Boolean);
     procedure BindFields(Binding: Boolean);
+    procedure BlockReadNext; virtual;
     function  BookmarkAvailable: Boolean;
     function  BookmarkAvailable: Boolean;
     procedure CalculateFields(Buffer: TRecordBuffer); virtual;
     procedure CalculateFields(Buffer: TRecordBuffer); virtual;
     procedure CheckActive; virtual;
     procedure CheckActive; virtual;

+ 1 - 1
packages/fcl-db/src/export/fpsqlexport.pp

@@ -191,7 +191,7 @@ Function TCustomSQLExporter.SQLValue(F : TField) : String;
 
 
 begin
 begin
   Result:=FormatField(F);
   Result:=FormatField(F);
-  If (F.DataType in StringFieldTypes+DateFieldTypes) then
+  If (F.DataType in BlobFieldTypes+StringFieldTypes+MemoFieldTypes+DateFieldTypes) then
     Result:=''''+QuoteFIeld(Result)+'''';
     Result:=''''+QuoteFIeld(Result)+'''';
 end;
 end;
 
 

+ 4 - 1
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -567,7 +567,10 @@ begin
       end;
       end;
     FIELD_TYPE_LONG, FIELD_TYPE_INT24:
     FIELD_TYPE_LONG, FIELD_TYPE_INT24:
       begin
       begin
-      NewType := ftInteger;
+      if AField^.flags and AUTO_INCREMENT_FLAG <> 0 then
+        NewType := ftAutoInc
+      else
+        NewType := ftInteger;
       NewSize := 0;
       NewSize := 0;
       end;
       end;
 {$ifdef mysql50_up}
 {$ifdef mysql50_up}

+ 26 - 6
packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -687,32 +687,52 @@ end;
 
 
 function TODBCConnection.GetTransactionHandle(trans: TSQLHandle): pointer;
 function TODBCConnection.GetTransactionHandle(trans: TSQLHandle): pointer;
 begin
 begin
-  // Tranactions not implemented yet
+  Result := nil;
 end;
 end;
 
 
 function TODBCConnection.StartDBTransaction(trans: TSQLHandle; AParams:string): boolean;
 function TODBCConnection.StartDBTransaction(trans: TSQLHandle; AParams:string): boolean;
+var AutoCommit: SQLINTEGER;
 begin
 begin
-  // Tranactions not implemented yet
+  // set some connection attributes
+  if StrToBoolDef(Params.Values['AUTOCOMMIT'], True) then
+    AutoCommit := SQL_AUTOCOMMIT_ON
+  else
+    AutoCommit := SQL_AUTOCOMMIT_OFF;
+
+  ODBCCheckResult(
+    SQLSetConnectAttr(FDBCHandle, SQL_ATTR_AUTOCOMMIT, SQLPOINTER(AutoCommit), SQL_IS_UINTEGER),
+    SQL_HANDLE_DBC,FDBCHandle,'Could not start transaction!'
+  );
+
+  Result := AutoCommit=SQL_AUTOCOMMIT_OFF;
 end;
 end;
 
 
 function TODBCConnection.Commit(trans: TSQLHandle): boolean;
 function TODBCConnection.Commit(trans: TSQLHandle): boolean;
 begin
 begin
-  // Tranactions not implemented yet
+  ODBCCheckResult(
+    SQLEndTran(SQL_HANDLE_DBC, FDBCHandle, SQL_COMMIT),
+    SQL_HANDLE_DBC, FDBCHandle, 'Could not commit!'
+  );
+  Result := True;
 end;
 end;
 
 
 function TODBCConnection.Rollback(trans: TSQLHandle): boolean;
 function TODBCConnection.Rollback(trans: TSQLHandle): boolean;
 begin
 begin
-  // Tranactions not implemented yet
+  ODBCCheckResult(
+    SQLEndTran(SQL_HANDLE_DBC, FDBCHandle, SQL_ROLLBACK),
+    SQL_HANDLE_DBC, FDBCHandle, 'Could not rollback!'
+  );
+  Result := True;
 end;
 end;
 
 
 procedure TODBCConnection.CommitRetaining(trans: TSQLHandle);
 procedure TODBCConnection.CommitRetaining(trans: TSQLHandle);
 begin
 begin
-  // Tranactions not implemented yet
+  Commit(trans);
 end;
 end;
 
 
 procedure TODBCConnection.RollbackRetaining(trans: TSQLHandle);
 procedure TODBCConnection.RollbackRetaining(trans: TSQLHandle);
 begin
 begin
-  // Tranactions not implemented yet
+  Rollback(trans);
 end;
 end;
 
 
 procedure TODBCConnection.Execute(cursor: TSQLCursor; ATransaction: TSQLTransaction; AParams: TParams);
 procedure TODBCConnection.Execute(cursor: TSQLCursor; ATransaction: TSQLTransaction; AParams: TParams);

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

@@ -719,6 +719,8 @@ begin
   InitializeSqlite(SQLiteLibraryName);
   InitializeSqlite(SQLiteLibraryName);
   str1:= databasename;
   str1:= databasename;
   checkerror(sqlite3_open(pchar(str1),@fhandle));
   checkerror(sqlite3_open(pchar(str1),@fhandle));
+  if (Length(Password)>0) and assigned(sqlite3_key) then
+    checkerror(sqlite3_key(fhandle,PChar(Password),StrLen(PChar(Password))));
   if Params.IndexOfName('foreign_keys') <> -1 then
   if Params.IndexOfName('foreign_keys') <> -1 then
     execsql('PRAGMA foreign_keys =  '+Params.Values['foreign_keys']);
     execsql('PRAGMA foreign_keys =  '+Params.Values['foreign_keys']);
 end;
 end;

+ 43 - 1
packages/fcl-db/tests/testfieldtypes.pas

@@ -111,6 +111,7 @@ type
     procedure TestSQLClob;
     procedure TestSQLClob;
     procedure TestSQLLargeint;
     procedure TestSQLLargeint;
     procedure TestSQLInterval;
     procedure TestSQLInterval;
+    procedure TestSQLIdentity;
   end;
   end;
 
 
 implementation
 implementation
@@ -158,6 +159,8 @@ const
     '', #0, #0#1#2#3#4#5#6#7#8#9
     '', #0, #0#1#2#3#4#5#6#7#8#9
   );
   );
 
 
+  STestNotApplicable = 'This test does not apply to this sqldb-connection type';
+
 
 
 procedure TTestFieldTypes.TestpfInUpdateFlag;
 procedure TTestFieldTypes.TestpfInUpdateFlag;
 var ds   : TCustomBufDataset;
 var ds   : TCustomBufDataset;
@@ -1216,7 +1219,7 @@ end;
 
 
 procedure TTestFieldTypes.TestInsertReturningQuery;
 procedure TTestFieldTypes.TestInsertReturningQuery;
 begin
 begin
-  if not(SQLDbType in [postgresql,interbase,oracle]) then Ignore('This test does not apply to this db-engine');
+  if not(SQLDbType in [postgresql,interbase,oracle]) then Ignore(STestNotApplicable);
   with TSQLDBConnector(DBConnector) do
   with TSQLDBConnector(DBConnector) do
     begin
     begin
     // This only works with databases that supports 'insert into .. returning'
     // This only works with databases that supports 'insert into .. returning'
@@ -1833,6 +1836,45 @@ begin
   TestSQLFieldType(ftTime, datatype, sizeof(TDateTime), @TestSQLInterval_GetSQLText, @CheckFieldValue);
   TestSQLFieldType(ftTime, datatype, sizeof(TDateTime), @TestSQLInterval_GetSQLText, @CheckFieldValue);
 end;
 end;
 
 
+procedure TTestFieldTypes.TestSQLIdentity;
+var datatype, values: string;
+    fieldtype: TFieldType;
+    i: integer;
+begin
+  if sqlDBType in MySQLdbTypes then
+  begin
+    datatype:='INT AUTO_INCREMENT PRIMARY KEY';
+    values:='VALUES(DEFAULT)';
+    fieldtype:=ftAutoInc;
+  end
+  else if sqlDBType = sqlite3 then
+  begin
+    datatype:='INTEGER PRIMARY KEY';
+    values:='DEFAULT VALUES';
+    fieldtype:=ftInteger;
+  end
+  else
+    Ignore(STestNotApplicable);
+
+  CreateTableWithFieldType(fieldtype, datatype);
+  TestFieldDeclaration(fieldtype, sizeof(longint));
+
+  for i := 1 to 3 do
+    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 '+values);
+
+  with TSQLDBConnector(DBConnector).Query do
+  begin
+    Open;
+    AssertTrue(Locate('FT',1,[])); // bug 17624
+    for i := 1 to 3 do
+    begin
+      AssertEquals(Fields[0].AsInteger, i);
+      Next;
+    end;
+    Close;
+  end;
+end;
+
 procedure TTestFieldTypes.TestUpdateIndexDefs;
 procedure TTestFieldTypes.TestUpdateIndexDefs;
 var ds : TSQLQuery;
 var ds : TSQLQuery;
 begin
 begin