From 0822a672bdf790a76d73eff2a52f88d0e9923f79 Mon Sep 17 00:00:00 2001
From: marco <marco@freepascal.org>
Date: Fri, 28 Apr 2017 12:46:04 +0000
Subject: [PATCH] --- Merging r34244 into '.': U   
 packages/fcl-db/src/base/dsparams.inc --- Recording mergeinfo for merge of
 r34244 into '.':  U   . --- Merging r34556 into '.': U   
 packages/dblib/src/dblib.pp --- Recording mergeinfo for merge of r34556 into
 '.':  G   . --- Merging r34745 into '.': U   
 packages/fcl-db/tests/testspecifictbufdataset.pas U   
 packages/fcl-db/src/base/dataset.inc --- Recording mergeinfo for merge of
 r34745 into '.':  G   . --- Merging r35465 into '.': U   
 packages/fcl-db/fpmake.pp --- Recording mergeinfo for merge of r35465 into
 '.':  G   . --- Merging r35618 into '.': U   
 packages/fcl-db/src/base/bufdataset.pas --- Recording mergeinfo for merge of
 r35618 into '.':  G   . --- Merging r35628 into '.': G   
 packages/fcl-db/src/base/dataset.inc --- Recording mergeinfo for merge of
 r35628 into '.':  G   . --- Merging r35629 into '.': U   
 packages/fcl-db/tests/testdbbasics.pas --- Recording mergeinfo for merge of
 r35629 into '.':  G   . --- Merging r35630 into '.': U   
 packages/fcl-db/src/Dataset.txt --- Recording mergeinfo for merge of r35630
 into '.':  G   . --- Merging r35690 into '.': U   
 packages/fcl-db/src/sqldb/sqldb.pp --- Recording mergeinfo for merge of
 r35690 into '.':  G   .

# revisions: 34244,34556,34745,35465,35618,35628,35629,35630,35690

git-svn-id: branches/fixes_3_0@35994 -
---
 packages/dblib/src/dblib.pp                   |  5 +++
 packages/fcl-db/fpmake.pp                     | 15 +++----
 packages/fcl-db/src/Dataset.txt               |  4 +-
 packages/fcl-db/src/base/bufdataset.pas       |  2 +-
 packages/fcl-db/src/base/dataset.inc          | 40 +++++++++----------
 packages/fcl-db/src/base/dsparams.inc         |  2 +-
 packages/fcl-db/src/sqldb/sqldb.pp            |  6 +--
 packages/fcl-db/tests/testdbbasics.pas        | 32 +++++++++++++++
 .../fcl-db/tests/testspecifictbufdataset.pas  |  4 ++
 9 files changed, 73 insertions(+), 37 deletions(-)

diff --git a/packages/dblib/src/dblib.pp b/packages/dblib/src/dblib.pp
index 7bffba8b87..39f358dd1b 100644
--- a/packages/dblib/src/dblib.pp
+++ b/packages/dblib/src/dblib.pp
@@ -179,7 +179,9 @@ const
 
   // Error codes:
   SYBEFCON = 20002;      // SQL Server connection failed
+  SYBEWRIT = 20006;      // Write to SQL Server failed.
   SYBESMSG = 20018;      // General SQL Server error: Check messages from the SQL Server.
+  SYBEDDNE = 20047;      // DBPROCESS is dead or not enabled.
 
 type
   PLOGINREC=Pointer;
@@ -361,6 +363,7 @@ var
   function dbiscount(dbproc:PDBPROCESS):BOOL; cdecl; external DBLIBDLL;
   function dbcancel(dbproc:PDBPROCESS):RETCODE; cdecl; external DBLIBDLL;
   function dbcanquery(dbproc:PDBPROCESS):RETCODE; cdecl; external DBLIBDLL;
+  function dbdead(dbproc:PDBPROCESS):DBBOOL; cdecl; external DBLIBDLL;
   function dbhasretstat(dbproc:PDBPROCESS):DBBOOL; cdecl; external DBLIBDLL;
   function dbretstatus(dbproc:PDBPROCESS):DBINT; cdecl; external DBLIBDLL;
   procedure dbfreelogin(login:PLOGINREC); cdecl; external DBLIBDLL {$IFDEF freetds}name 'dbloginfree'{$ENDIF};
@@ -410,6 +413,7 @@ var
   dbiscount: function(dbproc:PDBPROCESS):BOOL; cdecl;
   dbcancel: function(dbproc:PDBPROCESS):RETCODE; cdecl;
   dbcanquery: function(dbproc:PDBPROCESS):RETCODE; cdecl;
+  dbdead: function(dbproc:PDBPROCESS):DBBOOL; cdecl;
   dbhasretstat: function(dbproc:PDBPROCESS):DBBOOL; cdecl;
   dbretstatus: function(dbproc:PDBPROCESS):DBINT; cdecl;
   dbexit: procedure(); cdecl;
@@ -510,6 +514,7 @@ begin
    pointer(dbiscount) := GetProcedureAddress(DBLibLibraryHandle,'dbiscount');
    pointer(dbcancel) := GetProcedureAddress(DBLibLibraryHandle,'dbcancel');
    pointer(dbcanquery) := GetProcedureAddress(DBLibLibraryHandle,'dbcanquery');
+   pointer(dbdead) := GetProcedureAddress(DBLibLibraryHandle,'dbdead');
    pointer(dbhasretstat) := GetProcedureAddress(DBLibLibraryHandle,'dbhasretstat');
    pointer(dbretstatus) := GetProcedureAddress(DBLibLibraryHandle,'dbretstatus');
    pointer(dbexit) := GetProcedureAddress(DBLibLibraryHandle,'dbexit');
diff --git a/packages/fcl-db/fpmake.pp b/packages/fcl-db/fpmake.pp
index c032db8726..cce5dcc81f 100644
--- a/packages/fcl-db/fpmake.pp
+++ b/packages/fcl-db/fpmake.pp
@@ -14,7 +14,6 @@ const
   SqliteOSes          = [aix,beos,haiku,linux,freebsd,darwin,iphonesim,netbsd,openbsd,solaris,win32,win64,wince,android,dragonfly];
   DBaseOSes           = [aix,beos,haiku,linux,freebsd,darwin,iphonesim,netbsd,openbsd,solaris,win32,win64,wince,android,os2,dragonfly];
   MSSQLOSes           = [beos,haiku,linux,freebsd,netbsd,openbsd,solaris,win32,win64,android,dragonfly];
-  SqldbWithoutOracleOSes   = [win64];
 
 
 Var
@@ -47,7 +46,7 @@ begin
     P.SourcePath.Add('src/sqldb/mysql', SqldbConnectionOSes);
     P.SourcePath.Add('src/sqldb/odbc', SqldbConnectionOSes);
     P.SourcePath.Add('src/sqldb/examples', SqldbConnectionOSes);
-    P.SourcePath.Add('src/sqldb/oracle', SqldbConnectionOSes-SqldbWithoutOracleOSes);
+    P.SourcePath.Add('src/sqldb/oracle', SqldbConnectionOSes);
     P.SourcePath.Add('src/sqldb/mssql', MSSQLOSes);
     P.SourcePath.Add('src/sdf');
     P.SourcePath.Add('src/json');
@@ -74,7 +73,7 @@ begin
     P.Dependencies.Add('ibase', SqldbConnectionOSes);
     P.Dependencies.Add('mysql', SqldbConnectionOSes);
     P.Dependencies.Add('odbc', SqldbConnectionOSes);
-    P.Dependencies.Add('oracle', SqldbConnectionOSes-SqldbWithoutOracleOSes);
+    P.Dependencies.Add('oracle', SqldbConnectionOSes);
     P.Dependencies.Add('postgres', SqldbConnectionOSes);
     P.Dependencies.Add('sqlite', SqldbConnectionOSes+SqliteOSes);
     P.Dependencies.Add('dblib', MSSQLOSes);
@@ -450,7 +449,7 @@ begin
           AddUnit('fpddsqldb');
           AddUnit('odbcconn');
         end;
-    T:=P.Targets.AddUnit('fpddoracle.pp', DatadictOSes-SqldbWithoutOracleOSes);
+    T:=P.Targets.AddUnit('fpddoracle.pp', DatadictOSes);
       with T.Dependencies do
         begin
           AddUnit('sqldb');
@@ -474,7 +473,7 @@ begin
           AddUnit('fpddsqldb');
           AddUnit('mssqlconn');
         end;
-    T:=P.Targets.AddUnit('fpddregstd.pp', (DatadictOSes*MSSQLOses)-SqldbWithoutOracleOSes);
+    T:=P.Targets.AddUnit('fpddregstd.pp', (DatadictOSes*MSSQLOses));
       with T.Dependencies do
         begin
           AddUnit('fpdatadict');
@@ -693,7 +692,7 @@ begin
           AddUnit('bufdataset');
           AddUnit('dbconst');
         end;
-    T:=P.Targets.AddUnit('oracleconnection.pp', SqldbConnectionOSes-SqldbWithoutOracleOSes);
+    T:=P.Targets.AddUnit('oracleconnection.pp', SqldbConnectionOSes);
     T.ResourceStrings:=true;
       with T.Dependencies do
         begin
@@ -817,7 +816,3 @@ begin
   Installer.Run;
 end.
 {$endif ALLPACKAGES}
-
-
-
-
diff --git a/packages/fcl-db/src/Dataset.txt b/packages/fcl-db/src/Dataset.txt
index a9058eb124..9d7e3dd862 100644
--- a/packages/fcl-db/src/Dataset.txt
+++ b/packages/fcl-db/src/Dataset.txt
@@ -43,7 +43,7 @@ The following constants are userd when handling this array:
 
 FBufferCount :   The number of buffers allocated, minus one.
 FRecordCount :   The number of buffers that is actually filled in.
-FActiveBuffer :  The index of the active record in TDataset.
+FActiveRecord :  The index of the active record in TDataset.
 FCurrentRecord : The index of the supposedly active record in the underlying
                  dataset (ie. the index in the last call to SetToInternalRecord)
                  Call CursorPosChanged to reset FCurrentRecord if the active
@@ -60,7 +60,7 @@ So the following picture follows from this:
    ...
 |               |
 +---------------+
-| FActivebuffer |
+| FActiveRecord |
 +---------------+
 |               |
     ...
diff --git a/packages/fcl-db/src/base/bufdataset.pas b/packages/fcl-db/src/base/bufdataset.pas
index 3751375cee..8f36e76626 100644
--- a/packages/fcl-db/src/base/bufdataset.pas
+++ b/packages/fcl-db/src/base/bufdataset.pas
@@ -2832,7 +2832,7 @@ begin
     Result := 0
   else
     begin
-    InternalSetToRecord(ActiveBuffer);
+    UpdateCursorPos;
     Result := FCurrentIndex.RecNo;
     end;
 end;
diff --git a/packages/fcl-db/src/base/dataset.inc b/packages/fcl-db/src/base/dataset.inc
index b27fb5cb57..5c66828ed3 100644
--- a/packages/fcl-db/src/base/dataset.inc
+++ b/packages/fcl-db/src/base/dataset.inc
@@ -763,20 +763,20 @@ begin
   If FRecordCount>0 Then SetCurrentRecord(FRecordCount-1);
   Result:=GetRecord(FBuffers[FBufferCount],gmNext,True)=grOK;
 
-  if result then
+  if Result then
     begin
       If FRecordCount=0 then ActivateBuffers;
       if FRecordCount=FBufferCount then
         ShiftBuffersBackward
       else
         begin
-          inc(FRecordCount);
+          Inc(FRecordCount);
           FCurrentRecord:=FRecordCount - 1;
           ExchangeBuffers(FBuffers[FCurrentRecord],FBuffers[FBufferCount]);
         end;
     end
   else
-    cursorposchanged;
+    CursorPosChanged;
 {$ifdef dsdebug}
   Writeln ('Result getting next record : ',Result);
 {$endif}
@@ -805,16 +805,16 @@ begin
   CheckBiDirectional;
   If FRecordCount>0 Then SetCurrentRecord(0);
   Result:=GetRecord(FBuffers[FBufferCount],gmPrior,True)=grOK;
-  if result then
+  if Result then
     begin
       If FRecordCount=0 then ActivateBuffers;
       ShiftBuffersForward;
 
       if FRecordCount<FBufferCount then
-        inc(FRecordCount);
+        Inc(FRecordCount);
     end
   else
-    cursorposchanged;
+    CursorPosChanged;
 {$ifdef dsdebug}
   Writeln ('Result getting prior record : ',Result);
 {$endif}
@@ -894,30 +894,30 @@ begin
   else
     Insert;
 
-  for i := 0 to ValuesSize-1 do with values[i] do
-    fields[i].AssignValue(values[i]);
+  for i := 0 to ValuesSize-1 do
+    Fields[i].AssignValue(Values[i]);
   Post;
 
 end;
 
-procedure TDataSet.InitFieldDefsFromfields;
+procedure TDataSet.InitFieldDefsFromFields;
 var i : integer;
 
 begin
-  if FieldDefs.count = 0 then
+  if FieldDefs.Count = 0 then
     begin
     FieldDefs.BeginUpdate;
     try
-      for i := 0 to Fields.Count-1 do with fields[i] do
+      for i := 0 to Fields.Count-1 do with Fields[i] do
         if not (FieldKind in [fkCalculated,fkLookup]) then // Do not add fielddefs for calculated/lookup fields.
           begin
           FFieldDef:=FieldDefs.FieldDefClass.Create(FieldDefs,FieldName,DataType,Size,Required,FieldDefs.Count+1);
           with FFieldDef do
             begin
-            if Required then Attributes := attributes + [faRequired];
-            if ReadOnly then Attributes := attributes + [faReadOnly];
-            if DataType = ftBCD then precision := (fields[i] as TBCDField).Precision
-            else if DataType = ftFMTBcd then precision := (fields[i] as TFMTBCDField).Precision;
+            if Required then Attributes := Attributes + [faRequired];
+            if ReadOnly then Attributes := Attributes + [faReadOnly];
+            if DataType = ftBCD then Precision := (Fields[i] as TBCDField).Precision
+            else if DataType = ftFMTBcd then Precision := (Fields[i] as TFMTBCDField).Precision;
             end;
           end;
     finally
@@ -1148,7 +1148,7 @@ begin
     for j := 0 to TDataSource(FDataSources[i]).DataLinks.Count - 1 do
       begin
       DataLink:=TDataLink(TDataSource(FDataSources[i]).DataLinks[j]);
-      if DataLink.BufferCount>ABufferCount then
+      if ABufferCount<DataLink.BufferCount then
         ABufferCount:=DataLink.BufferCount;
       end;
 
@@ -1200,11 +1200,11 @@ begin
 {$ifdef dsdebug}
     Writeln ('   Reallocating memory :',(Value+1)*SizeOf(TRecordBuffer));
 {$endif}
-    ReAllocMem(FBuffers,(Value+1)*SizeOf(PChar));
+    ReAllocMem(FBuffers,(Value+1)*SizeOf(TRecordBuffer));
 {$ifdef dsdebug}
     Writeln ('   Filling memory :',(Value+1-FBufferCount)*SizeOf(TRecordBuffer));
 {$endif}
-    inc(FBufferCount); // Cause FBuffers[FBufferCount] is already allocated
+    Inc(FBufferCount); // Cause FBuffers[FBufferCount] is already allocated
     FillChar(FBuffers[FBufferCount],(Value+1-FBufferCount)*SizeOf(TRecordBuffer),#0);
 {$ifdef dsdebug}
     Writeln ('   Filled memory');
@@ -1286,7 +1286,7 @@ begin
       bfBOF : InternalFirst;
       bfEOF : InternalLast;
       end;
-    FCurrentRecord:=index;
+    FCurrentRecord:=Index;
     end;
 end;
 
@@ -2165,7 +2165,7 @@ begin
     inc(i);
   FActiveRecord := i;
 // Fill the rest of the buffer
-  getnextrecords;
+  GetNextRecords;
 // If the buffer is not full yet, try to fetch some more prior records
   if FRecordCount < FBufferCount then inc(FActiveRecord,getpriorrecords);
 // That's all folks!
diff --git a/packages/fcl-db/src/base/dsparams.inc b/packages/fcl-db/src/base/dsparams.inc
index 6fa03b1142..41c57568af 100644
--- a/packages/fcl-db/src/base/dsparams.inc
+++ b/packages/fcl-db/src/base/dsparams.inc
@@ -1076,7 +1076,7 @@ Var
   S : TFileStream;
 
 begin
-  S:=TFileStream.Create(FileName,fmOpenRead);
+  S:=TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
   Try
     LoadFromStream(S,BlobType);
   Finally
diff --git a/packages/fcl-db/src/sqldb/sqldb.pp b/packages/fcl-db/src/sqldb/sqldb.pp
index edc5a53dc4..4a1caaf6d9 100644
--- a/packages/fcl-db/src/sqldb/sqldb.pp
+++ b/packages/fcl-db/src/sqldb/sqldb.pp
@@ -290,7 +290,7 @@ type
     property HostName : string Read FHostName Write FHostName;
     Property OnLog : TDBLogNotifyEvent Read FOnLog Write FOnLog;
     Property LogEvents : TDBEventTypes Read FLogEvents Write FLogEvents Default LogAllEvents;
-    Property Options : TSQLConnectionOptions Read FOptions Write SetOptions;
+    Property Options : TSQLConnectionOptions Read FOptions Write SetOptions default [];
     Property Role :  String read FRole write FRole;
     property Connected;
     property DatabaseName;
@@ -340,7 +340,7 @@ type
     property Action : TCommitRollbackAction read FAction write FAction Default caRollBack;
     property Database;
     property Params : TStringList read FParams write SetParams;
-    Property Options : TSQLTransactionOptions Read FOptions Write SetOptions;
+    Property Options : TSQLTransactionOptions Read FOptions Write SetOptions default [];
   end;
 
 
@@ -598,7 +598,7 @@ type
     property UpdateSQL : TStringList read FUpdateSQL write SetUpdateSQL;
     property DeleteSQL : TStringList read FDeleteSQL write SetDeleteSQL;
     property RefreshSQL : TStringList read FRefreshSQL write SetRefreshSQL;
-    Property Options : TSQLQueryOptions Read FOptions Write SetOptions;
+    Property Options : TSQLQueryOptions Read FOptions Write SetOptions default [];
     property Params : TParams read GetParams Write SetParams;
     Property ParamCheck : Boolean Read GetParamCheck Write SetParamCheck default true;
     property ParseSQL : Boolean read GetParseSQL write SetParseSQL default true;
diff --git a/packages/fcl-db/tests/testdbbasics.pas b/packages/fcl-db/tests/testdbbasics.pas
index 419212d898..28d6cfdbd2 100644
--- a/packages/fcl-db/tests/testdbbasics.pas
+++ b/packages/fcl-db/tests/testdbbasics.pas
@@ -168,6 +168,7 @@ type
     procedure TestBug6893;
     procedure TestRequired;
     procedure TestModified;
+    procedure TestUpdateCursorPos;         // bug 31532
     // fields
     procedure TestFieldOldValueObsolete;
     procedure TestFieldOldValue;
@@ -684,6 +685,37 @@ begin
   end;
 end;
 
+procedure TTestCursorDBBasics.TestUpdateCursorPos;
+var
+  datasource1: TDataSource;
+  datalink1: TDataLink;
+  dataset1: TDataSet;
+  i,r: integer;
+begin
+  // TBufDataset should notify TDataset (TDataset.CurrentRecord) when changes internaly current record
+  // TBufDataset.GetRecNo was synchronizing its internal position with TDataset.ActiveRecord, but TDataset.CurrentRecord remains unchaged
+  // Bug #31532
+  dataset1 := DBConnector.GetNDataset(16);
+  datasource1 := TDataSource.Create(nil);
+  datasource1.DataSet := dataset1;
+  datalink1 := TDataLink.Create;
+  datalink1:= TDataLink.create;
+  datalink1.DataSource:= datasource1;
+  datalink1.BufferCount:= 12;
+
+  dataset1.Open;
+  dataset1.MoveBy(4);
+  CheckEquals(5, dataset1.RecNo);
+  for i:=13 to 15 do begin
+    datalink1.BufferCount := datalink1.BufferCount+1;
+    r := dataset1.RecNo; // syncronizes source dataset to ActiveRecord
+    datalink1.ActiveRecord := datalink1.BufferCount-1;
+    CheckEquals(i, dataset1.FieldByName('ID').AsInteger);
+  end;
+  datasource1.free;
+  datalink1.free;
+end;
+
 procedure TTestDBBasics.TestDetectionNonMatchingDataset;
 var
   F: TField;
diff --git a/packages/fcl-db/tests/testspecifictbufdataset.pas b/packages/fcl-db/tests/testspecifictbufdataset.pas
index 1c4e73cb47..792deb382d 100644
--- a/packages/fcl-db/tests/testspecifictbufdataset.pas
+++ b/packages/fcl-db/tests/testspecifictbufdataset.pas
@@ -195,9 +195,11 @@ begin
   try
     F := TIntegerField.Create(ds);
     F.FieldName:='ID';
+    F.Required:=True;
     F.DataSet:=ds;
     F := TStringField.Create(ds);
     F.FieldName:='NAME';
+    F.Required:=False;
     F.DataSet:=ds;
     F.Size:=50;
 
@@ -221,6 +223,8 @@ begin
 
     TestDataset(ds);
 
+    CheckTrue(ds.FieldDefs[0].Required, 'Required');
+    CheckFalse(ds.FieldDefs[1].Required, 'not Required');
     for i := 0 to ds.FieldDefs.Count-1 do
       begin
       CheckNotEquals(ds.FieldDefs[i].Name,'NAME_CALC');