--- Merging r30610 into '.':

U    packages/fcl-db/src/base/fields.inc
U    packages/fcl-db/src/base/db.pas
--- Recording mergeinfo for merge of r30610 into '.':
 U   .
--- Merging r30627 into '.':
U    packages/fcl-db/src/sqldb/sqldb.pp
U    packages/fcl-db/src/base/database.inc
--- Recording mergeinfo for merge of r30627 into '.':
 G   .
--- Merging r30640 into '.':
G    packages/fcl-db/src/base/fields.inc
--- Recording mergeinfo for merge of r30640 into '.':
 G   .
--- Merging r30684 into '.':
G    packages/fcl-db/src/base/fields.inc
--- Recording mergeinfo for merge of r30684 into '.':
 G   .
--- Merging r30691 into '.':
G    packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r30691 into '.':
 G   .
--- Merging r30702 into '.':
G    packages/fcl-db/src/base/fields.inc
G    packages/fcl-db/src/base/db.pas
--- Recording mergeinfo for merge of r30702 into '.':
 G   .
--- Merging r30703 into '.':
G    packages/fcl-db/src/base/fields.inc
--- Recording mergeinfo for merge of r30703 into '.':
 G   .
--- Merging r30736 into '.':
U    packages/fcl-db/src/sdf/sdfdata.pp
--- Recording mergeinfo for merge of r30736 into '.':
 G   .
--- Merging r30737 into '.':
U    packages/fcl-db/src/memds/memds.pp
--- Recording mergeinfo for merge of r30737 into '.':
 G   .
--- Merging r30740 into '.':
U    packages/fcl-db/src/sqlite/customsqliteds.pas
--- Recording mergeinfo for merge of r30740 into '.':
 G   .
--- Merging r30741 into '.':
U    packages/fcl-db/src/sqlite/sqlite3ds.pas
--- Recording mergeinfo for merge of r30741 into '.':
 G   .
--- Merging r30771 into '.':
G    packages/fcl-db/src/sqlite/customsqliteds.pas
--- Recording mergeinfo for merge of r30771 into '.':
 G   .

# revisions: 30610,30627,30640,30684,30691,30702,30703,30736,30737,30740,30741,30771

git-svn-id: branches/fixes_3_0@31078 -

packages/fcl-db/src/base/database.inc

@@ -95,7 +95,12 @@ begin
   If Assigned(FTransactions) then
     begin
     For I:=FTransactions.Count-1 downto 0 do
-      TDBTransaction(FTransactions[i]).EndTransaction;
+      try
+        TDBTransaction(FTransactions[i]).EndTransaction;
+      except
+        if not ForcedClose then
+          Raise;
+      end;    
     end;
 end;
 

packages/fcl-db/src/base/db.pas

@@ -178,7 +178,7 @@ type
     procedure SetSize(const AValue: Integer);
     procedure SetRequired(const AValue: Boolean);
   public
-    constructor create(ACollection : TCollection); override;
+    constructor Create(ACollection : TCollection); override;
     constructor Create(AOwner: TFieldDefs; const AName: string;
       ADataType: TFieldType; ASize: Integer; ARequired: Boolean; AFieldNo: Longint); overload;
     destructor Destroy; override;
@@ -191,8 +191,8 @@ type
   Published
     property Attributes: TFieldAttributes read FAttributes write SetAttributes default [];
     property DataType: TFieldType read FDataType write SetDataType;
-    property Precision: Longint read FPrecision write SetPrecision;
-    property Size: Integer read FSize write SetSize;
+    property Precision: Longint read FPrecision write SetPrecision default 0;
+    property Size: Integer read FSize write SetSize default 0;
   end;
   TFieldDefClass = Class of TFieldDef;
 
@@ -314,7 +314,7 @@ type
     procedure SetLookup(const AValue: Boolean);
     procedure SetReadOnly(const AValue: Boolean);
     procedure SetVisible(const AValue: Boolean);
-    function IsDisplayStored : Boolean;
+    function IsDisplayLabelStored : Boolean;
     function IsDisplayWidthStored: Boolean;
     function GetLookupList: TLookupList;
     procedure CalcLookupValue;
@@ -429,7 +429,7 @@ type
     property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
     property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
     property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
-    property DisplayLabel : string read GetDisplayName write SetDisplayLabel stored IsDisplayStored;
+    property DisplayLabel : string read GetDisplayName write SetDisplayLabel stored IsDisplayLabelStored;
     property DisplayWidth: Longint read GetDisplayWidth write SetDisplayWidth stored IsDisplayWidthStored;
     property FieldKind: TFieldKind read FFieldKind write FFieldKind;
     property FieldName: string read FFieldName write FFieldName;
@@ -853,7 +853,7 @@ type
     function CheckRange(AValue : TBCD) : Boolean;
     property Value: TBCD read GetAsBCD write SetAsBCD;
   published
-    property Precision: Longint read FPrecision write FPrecision default 15;
+    property Precision: Longint read FPrecision write FPrecision default 18;
     property Currency: Boolean read FCurrency write FCurrency;
     property MaxValue: string read GetMaxValue write SetMaxValue;
     property MinValue: string read GetMinValue write SetMinValue;

packages/fcl-db/src/base/fields.inc

@@ -99,11 +99,9 @@ begin
     Result.FFieldNo:=Self.FieldNo;
     Result.SetFieldType(DataType);
     Result.FReadOnly:=(faReadOnly in Attributes);
-{$ifdef dsdebug}
-    Writeln ('TFieldDef.CreateField : Trying to set dataset');
-{$endif dsdebug}
 {$ifdef dsdebug}
     Writeln ('TFieldDef.CreateField : Result Fieldno : ',Result.FieldNo,'; Self : ',FieldNo);
+    Writeln ('TFieldDef.CreateField : Trying to set dataset');
 {$endif dsdebug}
     Result.Dataset:=TFieldDefs(Collection).Dataset;
     If (Result is TFloatField) then
@@ -418,8 +416,7 @@ end;
 procedure TField.Clear;
 
 begin
-  if FieldKind in [fkData, fkInternalCalc] then
-    SetData(Nil);
+  SetData(Nil);
 end;
 
 procedure TField.DataChanged;
@@ -626,7 +623,7 @@ begin
     Result:=FFieldName;
 end;
 
-function TField.IsDisplayStored: Boolean;
+function TField.IsDisplayLabelStored: Boolean;
 
 begin
   Result:=(DisplayLabel<>FieldName);
@@ -1509,7 +1506,6 @@ begin
 end;
 
 procedure TLongintField.SetAsInteger(AValue: Longint);
-var Min, Max: Longint;
 begin
   If CheckRange(AValue) then
     SetData(@AValue)
@@ -2494,8 +2490,8 @@ end;
 function TBCDField.GetDefaultWidth: Longint;
 
 begin
-  if precision > 0 then result := precision
-    else result := 10;
+  if Precision > 0 then Result := Precision+1
+  else Result := 10;
 end;
 
 procedure TBCDField.GetText(var TheText: string; ADisplayText: Boolean);
@@ -2583,8 +2579,8 @@ begin
   FMinValue := 0;
   FValidChars := [DecimalSeparator, '+', '-', '0'..'9'];
   SetDataType(ftBCD);
-  FPrecision := 15;
-  Size:=4;
+  Precision := 18;
+  Size := 4;
 end;
 
 
@@ -2605,8 +2601,8 @@ begin
   SetDataType(ftFMTBCD);
 // Max.precision for NUMERIC,DECIMAL datatypes supported by some databases:
 //  Firebird-18; Oracle,SqlServer-38; MySQL-65; PostgreSQL-1000
-  Precision := 15; //default number of digits
-  Size:=4; //default number of digits after decimal place
+  Precision := 18; //default number of digits
+  Size := 4; //default number of digits after decimal place
 end;
 
 function TFMTBCDField.GetDataSize: Integer;
@@ -2817,17 +2813,28 @@ function TBlobField.GetAsString: string;
 var
   Stream : TStream;
   Len    : Integer;
+  R : String;
+  
 begin
   Stream := GetBlobStream(bmRead);
   if Stream <> nil then
     with Stream do
       try
         Len := Size;
-        SetLength(Result, Len);
+        SetLength(R, Len);
         if Len > 0 then
-          ReadBuffer(Result[1], Len);
+          begin
+          ReadBuffer(R[1], Len);
+          if not Transliterate then
+            Result:=R
+          else  
+            begin
+            SetLength(Result,Len);
+            DataSet.Translate(@R[1],@Result[1],False);
+            end;
+          end;  
       finally
-        Free
+        Free;    
       end
   else
     Result := '';
@@ -2922,12 +2929,23 @@ end;
 procedure TBlobField.SetAsString(const AValue: string);
 var
   Len : Integer;
+  R : String;
+  
 begin
   with GetBlobStream(bmWrite) do
     try
       Len := Length(AValue);
-      if Len > 0 then
-        WriteBuffer(AValue[1], Len);
+      if (Len>0) then
+        begin
+        if Not Transliterate then
+          R:=AValue
+        else
+          begin
+          SetLength(R,Len);
+          Len:=Dataset.Translate(@AValue[1],@R[1],True);
+          end;  
+        WriteBuffer(R[1], Len);
+        end;
     finally
       Free;
     end;

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

@@ -346,26 +346,22 @@ begin
 end;
 
 function TMemDataset.MDSGetActiveBuffer(out Buffer: TRecordBuffer): Boolean;
-
 begin
- case State of
-   dsBrowse,
-   dsBlockRead:
-     if IsEmpty then
-       Buffer:=nil
-     else
-       Buffer:=ActiveBuffer;
-  dsEdit,
-  dsInsert:
-     Buffer:=ActiveBuffer;
-  dsFilter:
-     Buffer:=FFilterBuffer;
-  dsCalcFields:
-     Buffer:=CalcBuffer;
- else
-   Buffer:=nil;
- end;
- Result:=(Buffer<>nil);
+  case State of
+    dsEdit,
+    dsInsert:
+      Buffer:=ActiveBuffer;
+    dsFilter:
+      Buffer:=FFilterBuffer;
+    dsCalcFields:
+      Buffer:=CalcBuffer;
+    else
+      if IsEmpty then
+        Buffer:=nil
+      else
+        Buffer:=ActiveBuffer;
+  end;
+  Result := Buffer<>nil;
 end;
 
 procedure TMemDataset.MDSReadRecord(Buffer:TRecordBuffer;ARecNo:Integer);   //Reads a Rec from Stream in Buffer

packages/fcl-db/src/sdf/sdfdata.pp

@@ -563,12 +563,9 @@ end;
 function TFixedFormatDataSet.GetActiveRecBuf(var RecBuf: TRecordBuffer): Boolean;
 begin
   case State of
-    dsBrowse: if IsEmpty then RecBuf := nil else RecBuf := ActiveBuffer;
-    dsEdit, dsInsert: RecBuf := ActiveBuffer;
     dsCalcFields: RecBuf := CalcBuffer;
     dsFilter: RecBuf := FFilterBuffer;
-  else
-    RecBuf := nil;
+    else if IsEmpty then RecBuf := nil else RecBuf := ActiveBuffer;
   end;
   Result := RecBuf <> nil;
 end;

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

@@ -163,6 +163,8 @@ type
     function GetPort: cardinal;
     procedure SetOptions(AValue: TSQLConnectionOptions);
     procedure SetPort(const AValue: cardinal);
+    function AttemptCommit(trans : TSQLHandle) : boolean; 
+    function AttemptRollBack(trans : TSQLHandle) : boolean; 
   protected
     FConnOptions         : TConnOptions;
     FSQLFormatSettings   : TFormatSettings;
@@ -402,7 +404,7 @@ type
 
   { TCustomSQLQuery }
 
-  TSQLQueryOption = (sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit, sqoCancelUpdatesOnRefresh, sqoPreferRefresh);
+  TSQLQueryOption = (sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit, sqoCancelUpdatesOnRefresh, sqoRefreshUsingSelect);
   TSQLQueryOptions = Set of TSQLQueryOption;
 
   TCustomSQLQuery = class (TCustomBufDataset)
@@ -1264,6 +1266,30 @@ begin
     Delete(IndexOfName('Port'));
 end;
 
+function TSQLConnection.AttemptCommit(trans: TSQLHandle): boolean;
+begin
+  try
+    Result:=Commit(trans);
+  except
+    if ForcedClose then
+      Result:=True
+    else
+      Raise;
+  end;
+end;
+
+function TSQLConnection.AttemptRollBack(trans: TSQLHandle): boolean;
+begin
+  try
+    Result:=Rollback(trans);
+  except
+    if ForcedClose then
+      Result:=True
+    else
+      Raise;
+  end;
+end;
+
 procedure TSQLConnection.GetDBInfo(const ASchemaType : TSchemaType; const ASchemaObjectName, AReturnField : string; AList: TStrings);
 
 var qry : TCustomSQLQuery;
@@ -1624,7 +1650,8 @@ begin
 end;
 
 
-function TSQLConnection.ConstructInsertSQL(Query : TCustomSQLQuery; Var ReturningClause : Boolean) : string;
+function TSQLConnection.ConstructInsertSQL(Query: TCustomSQLQuery;
+  var ReturningClause: Boolean): string;
 
 var x          : integer;
     sql_fields : string;
@@ -1665,7 +1692,8 @@ begin
 end;
 
 
-function TSQLConnection.ConstructUpdateSQL(Query: TCustomSQLQuery; Var ReturningClause : Boolean): string;
+function TSQLConnection.ConstructUpdateSQL(Query: TCustomSQLQuery;
+  var ReturningClause: Boolean): string;
 
 var x : integer;
     F : TField;
@@ -1776,7 +1804,7 @@ var
 
 begin
   qry:=Nil;
-  ReturningClause:=(sqSupportReturning in Connoptions) and not (sqoPreferRefresh in Query.Options);
+  ReturningClause:=(sqSupportReturning in Connoptions) and not (sqoRefreshUsingSelect in Query.Options);
   case UpdateKind of
     ukInsert : begin
                s := trim(Query.FInsertSQL.Text);
@@ -1983,7 +2011,7 @@ begin
     CloseDataSets;
     If LogEvent(detCommit) then
       Log(detCommit,SCommitting);
-    if (stoUseImplicit in Options) or SQLConnection.Commit(FTrans) then
+    if (stoUseImplicit in Options) or SQLConnection.AttemptCommit(FTrans) then
       begin
       CloseTrans;
       FreeAndNil(FTrans);
@@ -2010,7 +2038,7 @@ begin
     CloseDataSets;
     If LogEvent(detRollback) then
       Log(detRollback,SRollingBack);
-    if SQLConnection.RollBack(FTrans) then
+    if SQLConnection.AttemptRollBack(FTrans) then
       begin
       CloseTrans;
       FreeAndNil(FTrans);
@@ -2352,7 +2380,7 @@ Var
 
 begin
   Result:=(FRefreshSQL.Count<>0);
-  DoReturning:=(sqSupportReturning in SQLConnection.ConnOptions) and not (sqoPreferRefresh in Options);
+  DoReturning:=(sqSupportReturning in SQLConnection.ConnOptions) and not (sqoRefreshUsingSelect in Options);
   if Not (Result or DoReturning) then
     begin
     PF:=RefreshFlags[UpdateKind];

packages/fcl-db/src/sqlite/customsqliteds.pas

@@ -309,6 +309,7 @@ const
   //sqlite2.x.x and sqlite3.x.x define these constants equally
   SQLITE_OK = 0;
   SQLITE_ROW = 100;
+  SQLITE_DONE = 101;
   
   NullString = 'NULL';
   
@@ -756,10 +757,7 @@ begin
   case GetMode of
     gmPrior:
       if (FCurrentItem^.Previous = FBeginItem) or (FCurrentItem = FBeginItem) then
-      begin
-        Result := grBOF;
-        FCurrentItem := FBeginItem;
-      end
+        Result := grBOF
       else
         FCurrentItem:=FCurrentItem^.Previous;
     gmCurrent:
@@ -1783,7 +1781,7 @@ begin
     WriteLn('  SQL: ',SqlTemp);
     {$endif}
     ExecSQL(SQLTemp);
-    Result := FReturnCode = SQLITE_OK;
+    Result := FReturnCode = SQLITE_DONE;
   end
   else
     Result := False;

packages/fcl-db/src/sqlite/sqlite3ds.pas

@@ -141,7 +141,7 @@ begin
   sqlite3_open(PAnsiChar(FFileName), @Result);
   //sqlite3_open returns SQLITE_OK even for invalid files
   //do additional check here
-  FReturnCode := sqlite3_prepare(Result, CheckFileSql, -1, @vm, nil);
+  FReturnCode := sqlite3_prepare_v2(Result, CheckFileSql, -1, @vm, nil);
   if FReturnCode <> SQLITE_OK then
   begin
     ErrorStr := SqliteCode2Str(FReturnCode) + ' - ' + sqlite3_errmsg(Result);
@@ -163,7 +163,7 @@ begin
   {$endif}
   FAutoIncFieldNo := -1;
   FieldDefs.Clear;
-  FReturnCode := sqlite3_prepare(FSqliteHandle, PAnsiChar(FEffectiveSQL), -1, @vm, nil);
+  FReturnCode := sqlite3_prepare_v2(FSqliteHandle, PAnsiChar(FEffectiveSQL), -1, @vm, nil);
   if FReturnCode <> SQLITE_OK then
     DatabaseError(ReturnString, Self);
   sqlite3_step(vm);
@@ -263,7 +263,7 @@ procedure TSqlite3Dataset.ExecuteDirect(const ASQL: String);
 var
   vm: Pointer;
 begin
-  FReturnCode := sqlite3_prepare(FSqliteHandle, PAnsiChar(ASQL), -1, @vm, nil);
+  FReturnCode := sqlite3_prepare_v2(FSqliteHandle, PAnsiChar(ASQL), -1, @vm, nil);
   if FReturnCode <> SQLITE_OK then
     DatabaseError(ReturnString, Self);
   FReturnCode := sqlite3_step(vm);
@@ -281,7 +281,7 @@ begin
     sqlite3_exec(FSqliteHandle, PAnsiChar('Select Max(' + FieldDefs[FAutoIncFieldNo].Name +
       ') from ' + FTableName), @GetAutoIncValue, @FNextAutoInc, nil);
 
-  FReturnCode := sqlite3_prepare(FSqliteHandle, PAnsiChar(FEffectiveSQL), -1, @vm, nil);
+  FReturnCode := sqlite3_prepare_v2(FSqliteHandle, PAnsiChar(FEffectiveSQL), -1, @vm, nil);
   if FReturnCode <> SQLITE_OK then
     DatabaseError(ReturnString, Self);
 
@@ -367,7 +367,7 @@ begin
   if FSqliteHandle = nil then
     GetSqliteHandle;
   Result := '';
-  FReturnCode := sqlite3_prepare(FSqliteHandle,PAnsiChar(ASQL), -1, @vm, nil);
+  FReturnCode := sqlite3_prepare_v2(FSqliteHandle,PAnsiChar(ASQL), -1, @vm, nil);
   if FReturnCode <> SQLITE_OK then
     DatabaseError(ReturnString, Self);