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 r32093 into '.':

Browse Source 
U    packages/fcl-db/src/sqlite/customsqliteds.pas
--- Recording mergeinfo for merge of r32093 into '.':
 U   .
--- Merging r32131 into '.':
U    packages/fcl-db/tests/testdbbasics.pas
U    packages/fcl-db/src/base/bufdataset.pas
U    packages/fcl-db/src/sdf/sdfdata.pp
U    packages/fcl-db/src/memds/memds.pp
--- Recording mergeinfo for merge of r32131 into '.':
 G   .
--- Merging r32359 into '.':
U    packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r32359 into '.':
 G   .
--- Merging r32558 into '.':
U    packages/fcl-db/src/base/bufdataset_parser.pp
--- Recording mergeinfo for merge of r32558 into '.':
 G   .
--- Merging r32566 into '.':
G    packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r32566 into '.':
 G   .
--- Merging r32729 into '.':
U    packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Recording mergeinfo for merge of r32729 into '.':
 G   .
--- Merging r32753 into '.':
U    packages/fcl-db/src/sqlite/sqliteds.pas
U    packages/fcl-db/src/sqlite/sqlite3ds.pas
--- Recording mergeinfo for merge of r32753 into '.':
 G   .
--- Merging r32754 into '.':
G    packages/fcl-db/src/sqlite/sqlite3ds.pas
--- Recording mergeinfo for merge of r32754 into '.':
 G   .
--- Merging r32755 into '.':
G    packages/fcl-db/src/sqlite/sqliteds.pas
--- Recording mergeinfo for merge of r32755 into '.':
 G   .
--- Merging r32796 into '.':
U    packages/fcl-db/src/base/dataset.inc
--- Recording mergeinfo for merge of r32796 into '.':
 G   .
--- Merging r32800 into '.':
U    packages/fcl-db/src/base/sqlscript.pp
--- Recording mergeinfo for merge of r32800 into '.':
 G   .
--- Merging r32801 into '.':
U    packages/fcl-db/tests/dbtestframework.pas
U    packages/fcl-db/tests/testsqlscript.pas
--- Recording mergeinfo for merge of r32801 into '.':
 G   .
--- Merging r32807 into '.':
G    packages/fcl-db/src/base/bufdataset.pas
--- Recording mergeinfo for merge of r32807 into '.':
 G   .
--- Merging r32808 into '.':
U    packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Recording mergeinfo for merge of r32808 into '.':
 G   .
--- Merging r32810 into '.':
G    packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r32810 into '.':
 G   .

# revisions: 32093,32131,32359,32558,32566,32729,32753,32754,32755,32796,32800,32801,32807,32808,32810

git-svn-id: branches/fixes_3_0@33368 -
This commit is contained in:
marco 2016-03-28 14:43:12 +00:00
parent 2bd69ff480
commit caf506a7a2
15 changed files with 399 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
packages/fcl-db/src/base/bufdataset.pas
View File

@ -158,7 +158,8 @@ type
procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark); virtual; abstract;
procedure GotoBookmark(const ABookmark : PBufBookmark); virtual; abstract;
function BookmarkValid(const ABookmark: PBufBookmark): boolean; virtual;
function CompareBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; virtual;
function CompareBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : integer; virtual;
function SameBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; inline;
procedure InitialiseIndex; virtual; abstract;
@ -226,7 +227,7 @@ type
procedure StoreCurrentRecIntoBookmark(const ABookmark: PBufBookmark); override;
procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark); override;
procedure GotoBookmark(const ABookmark : PBufBookmark); override;
function CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): integer; override;
procedure InitialiseIndex; override;
procedure InitialiseSpareRecord(const ASpareRecord : TRecordBuffer); override;
@ -1248,15 +1249,17 @@ begin
if Fields.Count = 0 then
DatabaseError(SErrNoDataset);
// If there is a field with FieldNo=0 then the fields are not found to the
// FieldDefs which is a sign that there is no dataset created. (Calculated and
// lookup fields have FieldNo=-1)
// search for autoinc field
FAutoIncField:=nil;
for i := 0 to Fields.Count-1 do
if Fields[i].FieldNo=0 then
DatabaseError(SErrNoDataset)
else if (FAutoIncValue>-1) and (Fields[i] is TAutoIncField) and not assigned(FAutoIncField) then
FAutoIncField := TAutoIncField(Fields[i]);
if FAutoIncValue>-1 then
begin
for i := 0 to Fields.Count-1 do
if Fields[i] is TAutoIncField then
begin
FAutoIncField := TAutoIncField(Fields[i]);
Break;
end;
end;
InitDefaultIndexes;
CalcRecordSize;
@ -1367,12 +1370,14 @@ begin
Result := assigned(ABookmark) and assigned(ABookmark^.BookmarkData);
end;
function TBufIndex.CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): boolean;
function TBufIndex.CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): integer;
begin
if assigned(ABookmark1) and assigned(ABookmark2) then
Result := (ABookmark1^.BookmarkData=ABookmark2^.BookmarkData)
else
Result := False;
Result := 0;
end;
function TBufIndex.SameBookmarks(const ABookmark1, ABookmark2: PBufBookmark): boolean;
begin
Result := Assigned(ABookmark1) and Assigned(ABookmark2) and (CompareBookmarks(ABookmark1, ABookmark2) = 0);
end;
function TBufIndex.GetRecord(ABookmark: PBufBookmark; GetMode: TGetMode): TGetResult;
@ -1537,6 +1542,35 @@ begin
FCurrentRecBuf := ABookmark^.BookmarkData;
end;
function TDoubleLinkedBufIndex.CompareBookmarks(const ABookmark1,ABookmark2: PBufBookmark): integer;
var ARecord1, ARecord2 : PBufRecLinkItem;
begin
// valid bookmarks expected
// estimate result using memory addresses of records
Result := ABookmark1^.BookmarkData - ABookmark2^.BookmarkData;
if Result = 0 then
Exit
else if Result < 0 then
begin
Result := -1;
ARecord1 := ABookmark1^.BookmarkData;
ARecord2 := ABookmark2^.BookmarkData;
end
else
begin
Result := +1;
ARecord1 := ABookmark2^.BookmarkData;
ARecord2 := ABookmark1^.BookmarkData;
end;
// if we need relative position of records with given bookmarks we must
// traverse through index until we reach lower bookmark or 1st record
while assigned(ARecord2) and (ARecord2 <> ARecord1) and (ARecord2 <> FFirstRecBuf) do
ARecord2 := ARecord2[IndNr].prior;
// if we found lower bookmark as first, then estimated position is correct
if ARecord1 <> ARecord2 then
Result := -Result;
end;
procedure TDoubleLinkedBufIndex.InitialiseIndex;
begin
// Do nothing
@ -1564,7 +1598,7 @@ begin
FFirstRecBuf:= nil;
end;
function TDoubleLinkedBufIndex.GetRecNo: integer;
function TDoubleLinkedBufIndex.GetRecNo: Longint;
var ARecord : PBufRecLinkItem;
begin
ARecord := FCurrentRecBuf;
@ -2050,8 +2084,8 @@ begin
StartBuf := 0;
Result := False;
for x := StartBuf to high(FUpdateBuffer) do
if FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].BookmarkData,@ABookmark) or
(IncludePrior and (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].NextBookmarkData,@ABookmark)) then
if FCurrentIndex.SameBookmarks(@FUpdateBuffer[x].BookmarkData,@ABookmark) or
(IncludePrior and (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.SameBookmarks(@FUpdateBuffer[x].NextBookmarkData,@ABookmark)) then
begin
FCurrentUpdateBuffer := x;
Result := True;
@ -2064,10 +2098,10 @@ function TCustomBufDataset.GetRecordUpdateBufferCached(const ABookmark: TBufBook
begin
// if the current update buffer matches, immediately return true
if (FCurrentUpdateBuffer < length(FUpdateBuffer)) and (
FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@ABookmark) or
FCurrentIndex.SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@ABookmark) or
(IncludePrior
and (FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind=ukDelete)
and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData,@ABookmark))) then
and FCurrentIndex.SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData,@ABookmark))) then
begin
Result := True;
end
@ -2290,7 +2324,7 @@ var StoreRecBM : TBufBookmark;
{for x := length(FUpdateBuffer)-1 downto 0 do
begin
if (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].NextBookmarkData,@BookmarkData) then
if (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.SameBookmarks(@FUpdateBuffer[x].NextBookmarkData,@BookmarkData) then
CancelUpdBuffer(FUpdateBuffer[x]);
end;}
FreeRecordBuffer(OldValuesBuffer);
@ -2314,7 +2348,7 @@ var StoreRecBM : TBufBookmark;
FCurrentIndex.GotoBookmark(@Bm);
TmpBuf:=FCurrentIndex.CurrentRecord;
// resync won't work if the currentbuffer is freed...
if FCurrentIndex.CompareBookmarks(@Bm,@StoreRecBM) then with FCurrentIndex do
if FCurrentIndex.SameBookmarks(@Bm,@StoreRecBM) then with FCurrentIndex do
begin
GotoBookmark(@StoreRecBM);
if ScrollForward = grEOF then
@ -2880,7 +2914,7 @@ procedure TCustomBufDataset.GetDatasetPacket(AWriter: TDataPacketReader);
if GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,False) then
begin
repeat
if FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData, @AUpdBuffer.BookmarkData) then
if FCurrentIndex.SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData, @AUpdBuffer.BookmarkData) then
StoreUpdateBuffer(FUpdateBuffer[FCurrentUpdateBuffer], ARowState);
until not GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,True)
end;
@ -3051,13 +3085,16 @@ begin
Result:=assigned(FCurrentIndex) and FCurrentIndex.BookmarkValid(pointer(ABookmark));
end;
function TCustomBufDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark
): Longint;
function TCustomBufDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint;
begin
if not assigned(Bookmark1) or not assigned(Bookmark2) then
Result := 0
else if Assigned(FCurrentIndex) and FCurrentIndex.CompareBookmarks(pointer(Bookmark1),pointer(Bookmark2)) then
if Bookmark1 = Bookmark2 then
Result := 0
else if not assigned(Bookmark1) then
Result := 1
else if not assigned(Bookmark2) then
Result := -1
else if assigned(FCurrentIndex) then
Result := FCurrentIndex.CompareBookmarks(pointer(Bookmark1),pointer(Bookmark2))
else
Result := -1;
end;
@ -3148,7 +3185,7 @@ begin
FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData);
for x := FCurrentUpdateBuffer+1 to length(FUpdateBuffer)-1 do
if Findexes[0].CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@FUpdateBuffer[x].NextBookmarkData) then
if FIndexes[0].SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@FUpdateBuffer[x].NextBookmarkData) then
FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[x].NextBookmarkData);
AddRecordBuffer:=False;

23
packages/fcl-db/src/base/bufdataset_parser.pp
View File

@ -143,6 +143,12 @@ type
procedure Refresh(Buffer: TRecordBuffer); override;
end;
TBCDFieldVar = class(TFloatFieldVar)
public
procedure Refresh(Buffer: TRecordBuffer); override;
end;
//--TFieldVar----------------------------------------------------------------
constructor TFieldVar.Create(UseField: TField);
begin
@ -273,6 +279,16 @@ begin
FFieldVal := False;
end;
procedure TBCDFieldVar.Refresh(Buffer: TRecordBuffer);
var c: currency;
begin
if FField.DataSet.GetFieldData(FField,@c) then
FFieldVal := c
else
FFieldVal := 0;
end;
//--TBufDatasetParser---------------------------------------------------------------
constructor TBufDatasetParser.Create(Adataset: TDataSet);
@ -387,7 +403,7 @@ begin
TempFieldVar := TFloatFieldVar.Create(FieldInfo);
TempFieldVar.FExprWord := DefineFloatVariable(VarName, TempFieldVar.FieldVal);
end;
ftAutoInc, ftInteger, ftSmallInt:
ftAutoInc, ftInteger, ftSmallInt, ftWord:
begin
TempFieldVar := TIntegerFieldVar.Create(FieldInfo);
TempFieldVar.FExprWord := DefineIntegerVariable(VarName, TempFieldVar.FieldVal);
@ -402,6 +418,11 @@ begin
TempFieldVar := TDateTimeFieldVar.Create(FieldInfo);
TempFieldVar.FExprWord := DefineDateTimeVariable(VarName, TempFieldVar.FieldVal);
end;
ftBCD:
begin
TempFieldVar := TBCDFieldVar.Create(FieldInfo);
TempFieldVar.FExprWord := DefineFloatVariable(VarName, TempFieldVar.FieldVal);
end;
else
raise EDatabaseError.CreateFmt(SErrIndexBasedOnInvField, [VarName,Fieldtypenames[FieldInfo.DataType]]);
end;

4
packages/fcl-db/src/base/dataset.inc
View File

@ -105,7 +105,9 @@ begin
begin
FFieldDef := nil;
FieldIndex := FieldDefs.IndexOf(Fields[i].FieldName);
if FieldIndex <> -1 then
if FieldIndex = -1 then
DatabaseErrorFmt(SFieldNotFound,[Fields[i].FieldName],Self)
else
begin
FFieldDef := FieldDefs[FieldIndex];
FFieldNo := FFieldDef.FieldNo;

17
packages/fcl-db/src/base/sqlscript.pp
View File

@ -278,7 +278,11 @@ function TCustomSQLScript.Available: Boolean;
begin
With FSQL do
Result:=(FLine<Count) or (FCol<Length(Strings[Count-1]))
Result:=(FLine<Count) or
(
( FLine = Count ) and
( FCol < Length(Strings[Count-1] ) )
);
end;
procedure TCustomSQLScript.InternalStatement(Statement: TStrings; var StopExecution: Boolean);
@ -442,12 +446,11 @@ function TCustomSQLScript.NextStatement: AnsiString;
var
pnt: AnsiString;
addnewline,terminator_found: Boolean;
terminator_found: Boolean;
begin
terminator_found:=False;
ClearStatement;
addnewline:=false;
while FLine <= FSQL.Count do
begin
pnt:=FindNextSeparator([FTerminator, '/*', '"', '''', '--']);
@ -477,12 +480,9 @@ begin
begin
FComment:=True;
if FCommentsInSQL then
begin
AddToStatement(Copy(FSQL[FLine-1],FCol,Length(FSQL[FLine-1])-FCol+1),False);
AddNewLine:=true;
end;
Inc(Fline);
FCol:=0;
FCol:=1;
FComment:=False;
end
else if pnt = '"' then
@ -498,8 +498,7 @@ begin
AddToStatement(pnt,False);
FCol:=FCol + length(pnt);
pnt:=FindNextSeparator(['''']);
AddToStatement(pnt,addnewline);
addnewline:=False;
AddToStatement(pnt,false);
FCol:=FCol + length(pnt);
end;
end;

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

@ -132,6 +132,7 @@ type
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
function BookmarkValid(ABookmark: TBookmark): Boolean; override;
function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): boolean; override;
function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override;
@ -418,6 +419,14 @@ begin
Result := (ReqBookmark>=0) and (ReqBookmark<FRecCount);
end;
function TMemDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint;
const r: array[Boolean, Boolean] of ShortInt = ((2,-1),(1,0));
begin
Result := r[Bookmark1=nil, Bookmark2=nil];
if Result = 2 then
Result := PInteger(Bookmark1)^ - PInteger(Bookmark2)^;
end;
function TMemDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode
): TStream;
begin

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

@ -209,8 +209,8 @@ type
procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
procedure SetFieldData(Field: TField; Buffer: Pointer); override;
procedure ClearCalcFields(Buffer: TRecordBuffer); override;
function GetRecordCount: Integer; override;
function GetRecNo: Integer; override;
function GetRecordCount: Longint; override;
function GetRecNo: Longint; override;
procedure SetRecNo(Value: Integer); override;
function GetCanModify: boolean; override;
function RecordFilter(RecBuf: TRecordBuffer): Boolean;
@ -222,6 +222,7 @@ type
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function BookmarkValid(ABookmark: TBookmark): Boolean; override;
function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
procedure RemoveBlankRecords; dynamic;
procedure RemoveExtraColumns; dynamic;
@ -780,6 +781,14 @@ begin
Result := Assigned(ABookmark) and (FData.IndexOfObject(TObject(PPtrInt(ABookmark)^)) <> -1);
end;
function TFixedFormatDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint;
const r: array[Boolean, Boolean] of ShortInt = ((2,-1),(1,0));
begin
Result := r[Bookmark1=nil, Bookmark2=nil];
if Result = 2 then
Result := PPtrInt(Bookmark1)^ - PPtrInt(Bookmark2)^;
end;
procedure TFixedFormatDataSet.InternalGotoBookmark(ABookmark: Pointer);
var
Index: Integer;

19
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
View File

@ -106,6 +106,7 @@ Type
TConnectionName = class (TSQLConnection)
private
FSkipLibrarVersionCheck : Boolean;
FHostInfo: String;
FServerInfo: String;
FMySQL : PMySQL;
@ -164,6 +165,7 @@ Type
property ClientInfo: string read GetClientInfo;
property ServerStatus : String read GetServerStatus;
published
Property SkipLibrarVersionCheck : Boolean Read FSkipLibrarVersionCheck Write FSkipLibrarVersionCheck;
property DatabaseName;
property HostName;
property KeepConnection;
@ -495,13 +497,16 @@ var
FullVersion: string;
begin
InitialiseMysql;
FullVersion:=strpas(mysql_get_client_info());
// Version string should start with version number:
// Note: in case of MariaDB version mismatch: tough luck, we report MySQL
// version only.
if (pos(MySQLVersion, FullVersion) <> 1) and
(pos(MariaDBVersion, FullVersion) <> 1) then
Raise EInOutError.CreateFmt(SErrVersionMisMatch,[ClassName,MySQLVersion,FullVersion]);
if not SkipLibrarVersionCheck then
begin
FullVersion:=strpas(mysql_get_client_info());
// Version string should start with version number:
// Note: in case of MariaDB version mismatch: tough luck, we report MySQL
// version only.
if (pos(MySQLVersion, FullVersion) <> 1) and
(pos(MariaDBVersion, FullVersion) <> 1) then
Raise EInOutError.CreateFmt(SErrVersionMisMatch,[ClassName,MySQLVersion,FullVersion]);
end;
inherited DoInternalConnect;
ConnectToServer;
SelectDatabase;

4
packages/fcl-db/src/sqldb/postgres/pqconnection.pp
View File

@ -1006,9 +1006,9 @@ begin
begin
case AParams[i].DataType of
ftDateTime:
s := FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', AParams[i].AsDateTime);
s := FormatDateTime('yyyy"-"mm"-"dd hh":"nn":"ss.zzz', AParams[i].AsDateTime);
ftDate:
s := FormatDateTime('yyyy-mm-dd', AParams[i].AsDateTime);
s := FormatDateTime('yyyy"-"mm"-"dd', AParams[i].AsDateTime);
ftTime:
s := FormatTimeInterval(AParams[i].AsDateTime);
ftFloat, ftBCD:

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

@ -25,6 +25,13 @@ uses SysUtils, Classes, DB, bufdataset, sqlscript;
type
TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages, stSchemata, stSequences);
const
TSchemaObjectNames: array[TSchemaType] of String = ('???', 'table_name',
'???', 'procedure_name', 'column_name', 'param_name',
'index_name', 'package_name', 'schema_name','sequence');
type
TStatementType = (stUnknown, stSelect, stInsert, stUpdate, stDelete,
stDDL, stGetSegment, stPutSegment, stExecProcedure,
stStartTrans, stCommit, stRollback, stSelectForUpd);
@ -135,6 +142,33 @@ type
procedure Update; override;
end;
TSqlObjectIdentifierList = class;
{ TSqlObjectIdenfier }
TSqlObjectIdenfier = class(TCollectionItem)
private
FObjectName: String;
FSchemaName: String;
public
constructor Create(ACollection: TSqlObjectIdentifierList; Const AObjectName: String; Const ASchemaName: String = '');
property SchemaName: String read FSchemaName write FSchemaName;
property ObjectName: String read FObjectName write FObjectName;
end;
{ TSqlObjectIdentifierList }
TSqlObjectIdentifierList = class(TCollection)
private
function GetIdentifier(Index: integer): TSqlObjectIdenfier;
procedure SetIdentifier(Index: integer; AValue: TSqlObjectIdenfier);
public
function AddIdentifier: TSqlObjectIdenfier; overload;
function AddIdentifier(Const AObjectName: String; Const ASchemaName: String = ''): TSqlObjectIdenfier; overload;
property Identifiers[Index: integer]: TSqlObjectIdenfier read GetIdentifier write SetIdentifier; default;
end;
type
{ TSQLConnection }
@ -221,6 +255,7 @@ type
function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; virtual;
function GetObjectNames(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList): Integer; virtual;
Procedure MaybeConnect;
Property Statements : TFPList Read FStatements;
@ -784,6 +819,31 @@ begin
end;
{ TSqlObjectIdentifierList }
function TSqlObjectIdentifierList.GetIdentifier(Index: integer): TSqlObjectIdenfier;
begin
Result := Items[Index] as TSqlObjectIdenfier;
end;
procedure TSqlObjectIdentifierList.SetIdentifier(Index: integer; AValue: TSqlObjectIdenfier);
begin
Items[Index] := AValue;
end;
function TSqlObjectIdentifierList.AddIdentifier: TSqlObjectIdenfier;
begin
Result:=Add as TSqlObjectIdenfier;
end;
function TSqlObjectIdentifierList.AddIdentifier(Const AObjectName: String;
Const ASchemaName: String = ''): TSqlObjectIdenfier;
begin
Result:=AddIdentifier();
Result.SchemaName:=ASchemaName;
Result.ObjectName:=AObjectName;
end;
{ TSQLDBFieldDefs }
class function TSQLDBFieldDefs.FieldDefClass: TFieldDefClass;
@ -1228,11 +1288,11 @@ begin
if not ATransaction.Active then
ATransaction.MaybeStartTransaction;
try
SQL := TrimRight(SQL);
if SQL = '' then
DatabaseError(SErrNoStatement);
SQL := TrimRight(SQL);
if SQL = '' then
DatabaseError(SErrNoStatement);
try
Cursor := AllocateCursorHandle;
Cursor.FStatementType := stUnknown;
If LogEvent(detPrepare) then
@ -1354,6 +1414,43 @@ begin
GetDBInfo(stSequences,'','SEQUENCE_NAME',List);
end;
Function TSQLConnection.GetObjectNames(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList) : Integer;
var
qry : TCustomSQLQuery;
vSchemaName, vObjectName: String;
f: TField;
begin
Result:=0;
if not assigned(Transaction) then
DatabaseError(SErrConnTransactionnSet);
qry := TCustomSQLQuery.Create(nil);
try
qry.transaction := Transaction;
qry.database := Self;
with qry do
begin
ParseSQL := False;
SetSchemaInfo(ASchemaType,TSchemaObjectNames[ASchemaType],'');
open;
f:=FindField(TSchemaObjectNames[stSchemata]);
while not eof do
begin
vSchemaName:='';
if Assigned(f) then
vSchemaName:=f.AsString;
vObjectName:=FieldByName(FSchemaObjectName).AsString;
AList.AddIdentifier(vObjectName, vSchemaName);
Next;
Inc(Result);
end;
end;
finally
qry.free;
end;
end;
function TSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
var i: TConnInfoType;
begin
@ -3270,6 +3367,7 @@ begin
If Assigned(FProxy) then
FreeProxy;
FConnectorType:=AValue;
CreateProxy;
end;
end;
@ -3287,7 +3385,7 @@ Var
begin
inherited DoInternalConnect;
CreateProxy;
CheckProxy;
FProxy.CharSet:=Self.CharSet;
FProxy.DatabaseName:=Self.DatabaseName;
FProxy.HostName:=Self.HostName;
@ -3327,6 +3425,7 @@ begin
DatabaseErrorFmt(SErrUnknownConnectorType,[ConnectorType],Self);
FProxy:=D.ConnectionClass.Create(Self);
FFieldNameQuoteChars := FProxy.FieldNameQuoteChars;
FConnOptions := FProxy.ConnOptions;
end;
procedure TSQLConnector.FreeProxy;
@ -3548,6 +3647,16 @@ begin
end;
end;
{ TSqlObjectIdenfier }
constructor TSqlObjectIdenfier.Create(ACollection: TSqlObjectIdentifierList;
const AObjectName: String; Const ASchemaName: String = '');
begin
inherited Create(ACollection);
FSchemaName:=ASchemaName;
FObjectName:=AObjectName;
end;
Initialization
Finalization

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

@ -109,6 +109,7 @@ type
{$endif}
FInternalActiveBuffer: PDataRecord;
FInsertBookmark: PDataRecord;
FFilterBuffer: TRecordBuffer;
FOnCallback: TSqliteCallback;
FMasterLink: TMasterDataLink;
FIndexFieldNames: String;
@ -176,6 +177,7 @@ type
procedure DoBeforeClose; override;
procedure DoAfterInsert; override;
procedure DoBeforeInsert; override;
procedure DoFilterRecord(var Acceptable: Boolean); virtual;
procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
@ -578,6 +580,13 @@ begin
inherited DoBeforeInsert;
end;
procedure TCustomSqliteDataset.DoFilterRecord(var Acceptable: Boolean);
begin
Acceptable := True;
if Assigned(OnFilterRecord) then
OnFilterRecord(Self, Acceptable);
end;
destructor TCustomSqliteDataset.Destroy;
begin
inherited Destroy;
@ -746,10 +755,14 @@ begin
else
FieldOffset := FieldDefs.Count + FCalcFieldList.IndexOf(Field);
if not (State in [dsCalcFields, dsInternalCalc]) then
FieldRow := PPDataRecord(ActiveBuffer)^^.Row[FieldOffset]
else
FieldRow := PPDataRecord(CalcBuffer)^^.Row[FieldOffset];
case State of
dsCalcFields, dsInternalCalc:
FieldRow := PPDataRecord(CalcBuffer)^^.Row[FieldOffset];
dsFilter:
FieldRow := PPDataRecord(FFilterBuffer)^^.Row[FieldOffset];
else
FieldRow := PPDataRecord(ActiveBuffer)^^.Row[FieldOffset];
end;
Result := FieldRow <> nil;
if Result and (Buffer <> nil) then //supports GetIsNull
@ -789,31 +802,46 @@ begin
end;
function TCustomSqliteDataset.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
var
Acceptable: Boolean;
SaveState: TDataSetState;
begin
Result := grOk;
case GetMode of
gmPrior:
if (FCurrentItem^.Previous = FBeginItem) or (FCurrentItem = FBeginItem) then
Result := grBOF
else
FCurrentItem:=FCurrentItem^.Previous;
gmCurrent:
if (FCurrentItem = FBeginItem) or (FCurrentItem = FEndItem) then
Result := grError;
gmNext:
if (FCurrentItem = FEndItem) or (FCurrentItem^.Next = FEndItem) then
Result := grEOF
else
FCurrentItem := FCurrentItem^.Next;
end; //case
if Result = grOk then
begin
PDataRecord(Pointer(Buffer)^) := FCurrentItem;
FCurrentItem^.BookmarkFlag := bfCurrent;
GetCalcFields(Buffer);
end
else if (Result = grError) and DoCheck then
DatabaseError('No records found', Self);
repeat
Acceptable := True;
case GetMode of
gmPrior:
if (FCurrentItem^.Previous = FBeginItem) or (FCurrentItem = FBeginItem) then
Result := grBOF
else
FCurrentItem:=FCurrentItem^.Previous;
gmCurrent:
if (FCurrentItem = FBeginItem) or (FCurrentItem = FEndItem) then
Result := grError;
gmNext:
if (FCurrentItem = FEndItem) or (FCurrentItem^.Next = FEndItem) then
Result := grEOF
else
FCurrentItem := FCurrentItem^.Next;
end; //case
if Result = grOk then
begin
PDataRecord(Pointer(Buffer)^) := FCurrentItem;
FCurrentItem^.BookmarkFlag := bfCurrent;
GetCalcFields(Buffer);
if Filtered then
begin
FFilterBuffer := Buffer;
SaveState := SetTempState(dsFilter);
DoFilterRecord(Acceptable);
if (GetMode = gmCurrent) and not Acceptable then
Result := grError;
RestoreState(SaveState);
end;
end
else if (Result = grError) and DoCheck then
DatabaseError('No records found', Self);
until (Result <> grOK) or Acceptable;
end;
function TCustomSqliteDataset.GetRecordCount: Integer;
@ -1573,7 +1601,7 @@ begin
FMasterLink.DataSource := Value;
end;
procedure TCustomSqliteDataset.ExecSQL(const ASQL: String);
procedure TCustomSqliteDataset.ExecSQL(const ASql: String);
begin
if FSqliteHandle = nil then
GetSqliteHandle;
@ -1831,7 +1859,8 @@ begin
Result := False;
end;
procedure TCustomSqliteDataset.ExecCallback(const ASQL: String; UserData: Pointer = nil);
procedure TCustomSqliteDataset.ExecCallback(const ASql: String;
UserData: Pointer);
var
CallbackInfo: TCallbackInfo;
begin
@ -1913,12 +1942,13 @@ begin
(FAddedItems.Count > 0) or (FDeletedItems.Count > 0);
end;
function TCustomSqliteDataset.QuickQuery(const ASQL: String): String;
function TCustomSqliteDataset.QuickQuery(const ASql: String): String;
begin
Result := QuickQuery(ASQL, nil, False);
end;
function TCustomSqliteDataset.QuickQuery(const ASQL: String; const AStrList: TStrings): String;
function TCustomSqliteDataset.QuickQuery(const ASql: String;
const AStrList: TStrings): String;
begin
Result := QuickQuery(ASQL, AStrList, False)
end;

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

@ -227,17 +227,17 @@ begin
SQLITE_FLOAT:
AType := ftFloat;
else
begin
begin
AType := ftString;
DataSize := DefaultStringSize;
end;
DataSize := DefaultStringSize;
end;
end;
end else
begin
AType := ftString;
DataSize := DefaultStringSize;
DataSize := DefaultStringSize;
end;
FieldDefs.Add(String(sqlite3_column_name(vm, i)), AType, DataSize);
FieldDefs.Add(FieldDefs.MakeNameUnique(String(sqlite3_column_name(vm, i))), AType, DataSize);
//Set the pchar2sql function
case AType of
ftString:

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

@ -184,12 +184,16 @@ begin
begin
AType := ftString;
end;
FieldDefs.Add(String(ColumnNames[i]), AType, DataSize);
FieldDefs.Add(FieldDefs.MakeNameUnique(String(ColumnNames[i])), AType, DataSize);
//Set the pchar2sql function
if AType in [ftString, ftMemo] then
FGetSqlStr[i] := @Char2SQLStr
case AType of
ftString:
FGetSqlStr[i] := @Char2SQLStr;
ftMemo:
FGetSqlStr[i] := @Memo2SQLStr;
else
FGetSqlStr[i] := @Num2SQLStr;
end;
end;
sqlite_finalize(vm, nil);
{

4
packages/fcl-db/tests/dbtestframework.pas
View File

@ -28,7 +28,9 @@ uses
TestSpecificTBufDataset,
TestSpecificTDBF,
TestSpecificTMemDataset,
TestDBExport, tccsvdataset,
TestDBExport,
tccsvdataset,
testsqlscript,
consoletestrunner;
Procedure LegacyOutput;

48
packages/fcl-db/tests/testdbbasics.pas
View File

@ -8,7 +8,7 @@ interface
uses
{$IFDEF FPC}
fpcunit, testregistry,
testregistry,
{$ELSE FPC}
TestFramework,
{$ENDIF FPC}
@ -58,6 +58,7 @@ type
procedure TestAssignFieldftFixedChar;
procedure TestSelectQueryBasics;
procedure TestPostOnlyInEditState;
procedure TestCancel;
procedure TestMove; // bug 5048
procedure TestActiveBufferWhenClosed;
procedure TestEOFBOFClosedDataset;
@ -138,6 +139,7 @@ type
procedure TestBookmarks;
procedure TestBookmarkValid;
procedure TestCompareBookmarks;
procedure TestDelete1;
procedure TestDelete2;
@ -274,6 +276,18 @@ begin
end;
end;
procedure TTestDBBasics.TestCancel;
begin
with DBConnector.GetNDataset(1) do
begin
Open;
Edit;
FieldByName('name').AsString := 'EditName1';
Cancel;
CheckEquals('TestName1', FieldByName('name').AsString, 'Cancel did not restored previous value');
end;
end;
procedure TTestDBBasics.TestMove;
var i,count : integer;
aDatasource : TDataSource;
@ -802,7 +816,7 @@ begin
end;
procedure TTestCursorDBBasics.TestBookmarkValid;
var BM1,BM2,BM3,BM4,BM5 : TBookmark;
var BM1,BM2,BM3,BM4,BM5,BM6 : TBookmark;
begin
with DBConnector.GetNDataset(true,14) do
begin
@ -834,9 +848,39 @@ begin
CheckTrue(BookmarkValid(BM3));
CheckTrue(BookmarkValid(BM2));
CheckTrue(BookmarkValid(BM1));
Append;
BM6 := GetBookmark;
CheckFalse(BookmarkValid(BM6));
end;
end;
procedure TTestCursorDBBasics.TestCompareBookmarks;
var
FirstBookmark, LastBookmark, EditBookmark, PostEditBookmark: TBookmark;
begin
with DBConnector.GetNDataset(true,14) do
begin
Open;
FirstBookmark := GetBookmark;
Edit;
EditBookmark := GetBookmark;
Post;
PostEditBookmark := GetBookmark;
Last;
LastBookmark := GetBookmark;
CheckEquals(0, CompareBookmarks(FirstBookmark, EditBookmark));
CheckEquals(0, CompareBookmarks(EditBookmark, PostEditBookmark));
CheckTrue(CompareBookmarks(FirstBookmark, LastBookmark) < 0, 'b1<b2');
CheckTrue(CompareBookmarks(LastBookmark, FirstBookmark) > 0, 'b1>b2');
CheckEquals(0, CompareBookmarks(nil, nil), '(nil,nil)');
CheckEquals(-1, CompareBookmarks(FirstBookmark, nil), '(b1,nil)');
CheckEquals(+1, CompareBookmarks(nil, FirstBookmark), '(nil,b2)');
end;
end;
procedure TTestCursorDBBasics.TestLocate;
begin
with DBConnector.GetNDataset(true,13) do

34
packages/fcl-db/tests/testsqlscript.pas
View File

@ -12,7 +12,7 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit testcsqlscript;
unit testsqlscript;
{$mode objfpc}{$H+}
@ -34,7 +34,7 @@ type
protected
procedure ExecuteStatement (SQLStatement: TStrings; var StopExecution: Boolean); override;
procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); override;
procedure ExecuteCommit; override;
procedure ExecuteCommit(CommitRetaining: boolean=true); override;
procedure DefaultDirectives; override;
public
constructor create (AnOwner: TComponent); override;
@ -98,6 +98,7 @@ type
procedure TestCommentInComment;
procedure TestCommentInQuotes1;
procedure TestCommentInQuotes2;
Procedure TestDashDashComment;
procedure TestQuote1InComment;
procedure TestQuote2InComment;
procedure TestQuoteInQuotes1;
@ -174,7 +175,7 @@ begin
raise exception.create(DoException);
end;
procedure TMyScript.ExecuteCommit;
procedure TMyScript.ExecuteCommit(CommitRetaining: boolean=true);
begin
inc (FCommits);
if DoException <> '' then
@ -270,7 +271,20 @@ begin
AssertFalse ('Aborted', Aborted);
AssertEquals ('Line', 0, Line);
AssertEquals ('Defines', 0, Defines.count);
AssertEquals ('Directives', 10, Directives.count);
AssertEquals ('Directives', 12, Directives.count);
AssertTrue('Have SET TERM',Directives.IndexOf('SET TERM')<>-1);
AssertTrue('Have COMMIT WORK',Directives.IndexOf('COMMIT WORK')<>-1);
AssertTrue('Have COMMIT RETAIN',Directives.IndexOf('COMMIT RETAIN')<>-1);
AssertTrue('Have COMMIT',Directives.IndexOf('COMMIT')<>-1);
AssertTrue('Have #IFDEF',Directives.IndexOf('#IFDEF')<>-1);
AssertTrue('Have #IFNDEF',Directives.IndexOf('#IFNDEF')<>-1);
AssertTrue('Have #ELSE',Directives.IndexOf('#ELSE')<>-1);
AssertTrue('Have #ENDIF',Directives.IndexOf('#ENDIF')<>-1);
AssertTrue('Have #DEFINE',Directives.IndexOf('#DEFINE')<>-1);
AssertTrue('Have #UNDEF',Directives.IndexOf('#UNDEF')<>-1);
AssertTrue('Have #UNDEFINE',Directives.IndexOf('#UNDEFINE')<>-1);
// This is defined in our test class.
AssertTrue('Have STOP',Directives.IndexOf('STOP')<>-1);
end;
end;
@ -513,6 +527,18 @@ begin
AssertStatDir('"iets ""/* meer */"""', '');
end;
procedure TTestSQLScript.TestDashDashComment;
begin
script.CommentsInSQL := false;
Add('-- my comment');
Add('CREATE TABLE "tPatients" (');
Add(' "BloodGroup" character(2),');
Add(' CONSTRAINT "ck_tPatients_BloodGroup" CHECK (("BloodGroup" = ANY (ARRAY[''A''::bpchar, ''B''::bpchar, ''AB''::bpchar, ''0''::bpchar]))),');
Add(');');
script.execute;
AssertStatDir('"CREATE TABLE ""tPatients"" ( ""BloodGroup"" character(2), CONSTRAINT ""ck_tPatients_BloodGroup"" CHECK ((""BloodGroup"" = ANY (ARRAY[''A''::bpchar, ''B''::bpchar, ''AB''::bpchar, ''0''::bpchar]))), )"', '');
end;
procedure TTestSQLScript.TestQuote1InComment;
begin
script.CommentsInSQL := false;