paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 21:19:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

--- Merging r30610 into '.':

Browse Source 
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 -
This commit is contained in:
marco 2015-06-17 08:32:14 +00:00
parent e0f38f1ba9
commit 4a8dcaa476
8 changed files with 107 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
packages/fcl-db/src/base/database.inc
View File

@ -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;

12
packages/fcl-db/src/base/db.pas
View File

@ -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;

54
packages/fcl-db/src/base/fields.inc
View File

@ -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;

34
packages/fcl-db/src/memds/memds.pp
View File

@ -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

5
packages/fcl-db/src/sdf/sdfdata.pp
View File

@ -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;

42
packages/fcl-db/src/sqldb/sqldb.pp
View File

@ -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];

8
packages/fcl-db/src/sqlite/customsqliteds.pas
View File

@ -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;

10
packages/fcl-db/src/sqlite/sqlite3ds.pas
View File

@ -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);