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

Browse Source 
U    packages/fcl-db/src/sqldb/sqldb.pp
U    packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Recording mergeinfo for merge of r33254 into '.':
 U   .
--- Merging r33420 into '.':
U    packages/fcl-db/tests/testdbbasics.pas
U    packages/fcl-db/src/base/bufdataset.pas
--- Recording mergeinfo for merge of r33420 into '.':
 G   .
--- Merging r33421 into '.':
G    packages/fcl-db/src/base/bufdataset.pas
--- Recording mergeinfo for merge of r33421 into '.':
 G   .
--- Merging r33422 into '.':
G    packages/fcl-db/src/base/bufdataset.pas
--- Recording mergeinfo for merge of r33422 into '.':
 G   .
--- Merging r33427 into '.':
G    packages/fcl-db/src/base/bufdataset.pas
--- Recording mergeinfo for merge of r33427 into '.':
 G   .
--- Merging r33570 into '.':
G    packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r33570 into '.':
 G   .
--- Merging r33666 into '.':
U    packages/fcl-db/tests/toolsunit.pas
U    packages/fcl-db/tests/sqldbtoolsunit.pas
--- Recording mergeinfo for merge of r33666 into '.':
 G   .
--- Merging r33905 into '.':
U    packages/fcl-db/src/sqldb/interbase/fbadmin.pp
--- Recording mergeinfo for merge of r33905 into '.':
 G   .
--- Merging r33911 into '.':
G    packages/fcl-db/src/sqldb/interbase/fbadmin.pp
--- Recording mergeinfo for merge of r33911 into '.':
 G   .
--- Merging r33912 into '.':
G    packages/fcl-db/src/sqldb/interbase/fbadmin.pp
--- Recording mergeinfo for merge of r33912 into '.':
 G   .
--- Merging r33913 into '.':
U    packages/fcl-db/src/sqldb/interbase/fbadmin.pp
--- Recording mergeinfo for merge of r33913 into '.':
 G   .
--- Merging r34095 into '.':
U    packages/postgres/src/postgres3dyn.pp
--- Recording mergeinfo for merge of r34095 into '.':
 G   .

# revisions: 33254,33420,33421,33422,33427,33570,33666,33905,33911,33912,33913,34095

git-svn-id: branches/fixes_3_0@35993 -
This commit is contained in:
marco 2017-04-28 12:38:15 +00:00
parent f34993a217
commit c6ad797d22
8 changed files with 313 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -159,7 +159,7 @@ type
procedure GotoBookmark(const ABookmark : PBufBookmark); virtual; abstract;
function BookmarkValid(const ABookmark: PBufBookmark): boolean; virtual;
function CompareBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : integer; virtual;
function SameBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; inline;
function SameBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; virtual;
procedure InitialiseIndex; virtual; abstract;
@ -228,6 +228,7 @@ type
procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark); override;
procedure GotoBookmark(const ABookmark : PBufBookmark); override;
function CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): integer; override;
function SameBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; override;
procedure InitialiseIndex; override;
procedure InitialiseSpareRecord(const ASpareRecord : TRecordBuffer); override;
@ -496,6 +497,7 @@ type
function GetRecordUpdateBuffer(const ABookmark : TBufBookmark; IncludePrior : boolean = false; AFindNext : boolean = false) : boolean;
function GetRecordUpdateBufferCached(const ABookmark : TBufBookmark; IncludePrior : boolean = false) : boolean;
function GetActiveRecordUpdateBuffer : boolean;
procedure CancelRecordUpdateBuffer(AUpdateBufferIndex: integer; var ABookmark: TBufBookmark);
procedure ParseFilter(const AFilter: string);
function GetIndexDefs : TIndexDefs;
@ -575,6 +577,7 @@ type
procedure ApplyUpdates; virtual; overload;
procedure ApplyUpdates(MaxErrors: Integer); virtual; overload;
procedure MergeChangeLog;
procedure RevertRecord;
procedure CancelUpdates; virtual;
destructor Destroy; override;
function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean; override;
@ -1677,6 +1680,11 @@ begin
Result := -Result;
end;
function TDoubleLinkedBufIndex.SameBookmarks(const ABookmark1, ABookmark2: PBufBookmark): boolean;
begin
Result := Assigned(ABookmark1) and Assigned(ABookmark2) and (ABookmark1^.BookmarkData = ABookmark2^.BookmarkData);
end;
procedure TDoubleLinkedBufIndex.InitialiseIndex;
begin
// Do nothing
@ -2401,90 +2409,106 @@ begin
raise EDatabaseError.Create(SApplyRecNotSupported);
end;
procedure TCustomBufDataset.CancelUpdates;
var StoreRecBM : TBufBookmark;
procedure CancelUpdBuffer(var AUpdBuffer : TRecUpdateBuffer);
var
TmpBuf : TRecordBuffer;
StoreUpdBuf : integer;
Bm : TBufBookmark;
begin
with AUpdBuffer do
procedure TCustomBufDataset.CancelRecordUpdateBuffer(AUpdateBufferIndex: integer; var ABookmark: TBufBookmark);
var
ARecordBuffer: TRecordBuffer;
NBookmark : TBufBookmark;
i : integer;
begin
with FUpdateBuffer[AUpdateBufferIndex] do
if Assigned(BookmarkData.BookmarkData) then // this is used to exclude buffers which are already handled
begin
if Not assigned(BookmarkData.BookmarkData) then
exit;// this is used to exclude buffers which are already handled
Case UpdateKind of
ukModify:
begin
FCurrentIndex.GotoBookmark(@BookmarkData);
move(TRecordBuffer(OldValuesBuffer)^,TRecordBuffer(FCurrentIndex.CurrentBuffer)^,FRecordSize);
FreeRecordBuffer(OldValuesBuffer);
end;
ukDelete:
if (assigned(OldValuesBuffer)) then
case UpdateKind of
ukModify:
begin
FCurrentIndex.GotoBookmark(@NextBookmarkData);
FCurrentIndex.InsertRecordBeforeCurrentRecord(TRecordBuffer(BookmarkData.BookmarkData));
FCurrentIndex.ScrollBackward;
move(TRecordBuffer(OldValuesBuffer)^,TRecordBuffer(FCurrentIndex.CurrentBuffer)^,FRecordSize);
{for x := length(FUpdateBuffer)-1 downto 0 do
begin
if (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.SameBookmarks(@FUpdateBuffer[x].NextBookmarkData,@BookmarkData) then
CancelUpdBuffer(FUpdateBuffer[x]);
end;}
FCurrentIndex.GotoBookmark(@BookmarkData);
move(TRecordBuffer(OldValuesBuffer)^, TRecordBuffer(FCurrentIndex.CurrentBuffer)^, FRecordSize);
FreeRecordBuffer(OldValuesBuffer);
inc(FBRecordCount);
end ;
ukInsert:
begin
// Process all update buffers linked to this record before this record is removed
StoreUpdBuf:=FCurrentUpdateBuffer;
Bm := BookmarkData;
BookmarkData.BookmarkData:=nil; // Avoid infinite recursion...
if GetRecordUpdateBuffer(Bm,True,False) then
begin
repeat
if (FCurrentUpdateBuffer<>StoreUpdBuf) then
CancelUpdBuffer(FUpdateBuffer[FCurrentUpdateBuffer]);
until not GetRecordUpdateBuffer(Bm,True,True);
end;
FCurrentUpdateBuffer:=StoreUpdBuf;
ukDelete:
if (assigned(OldValuesBuffer)) then
begin
FCurrentIndex.GotoBookmark(@NextBookmarkData);
FCurrentIndex.InsertRecordBeforeCurrentRecord(TRecordBuffer(BookmarkData.BookmarkData));
FCurrentIndex.ScrollBackward;
move(TRecordBuffer(OldValuesBuffer)^, TRecordBuffer(FCurrentIndex.CurrentBuffer)^, FRecordSize);
FreeRecordBuffer(OldValuesBuffer);
inc(FBRecordCount);
end;
ukInsert:
begin
FCurrentIndex.GotoBookmark(@BookmarkData);
ARecordBuffer := FCurrentIndex.CurrentRecord;
FCurrentIndex.GotoBookmark(@Bm);
TmpBuf:=FCurrentIndex.CurrentRecord;
// resync won't work if the currentbuffer is freed...
if FCurrentIndex.SameBookmarks(@Bm,@StoreRecBM) then with FCurrentIndex do
begin
GotoBookmark(@StoreRecBM);
if ScrollForward = grEOF then
if ScrollBackward = grBOF then
ScrollLast; // last record will be removed from index, so move to spare record
StoreCurrentRecIntoBookmark(@StoreRecBM);
// Find next record's bookmark
FCurrentIndex.DoScrollForward;
FCurrentIndex.StoreCurrentRecIntoBookmark(@NBookmark);
// Process (re-link) all update buffers linked to this record before this record is removed
// Modified record #1, which is later deleted can be linked to another inserted record #2. In this case deleted record #1 precedes inserted #2 in update buffer.
// Deleted records, which are deleted after this record is inserted are in update buffer after this record.
// if we need revert inserted record which is linked from another deleted records, then we must re-link these records
for i:=0 to high(FUpdateBuffer) do
if (FUpdateBuffer[i].UpdateKind = ukDelete) and
(FUpdateBuffer[i].NextBookmarkData.BookmarkData = BookmarkData.BookmarkData) then
FUpdateBuffer[i].NextBookmarkData := NBookmark;
// ReSync won't work if the CurrentBuffer is freed ... so in this case move to next/prior record
if FCurrentIndex.SameBookmarks(@BookmarkData,@ABookmark) then with FCurrentIndex do
begin
GotoBookmark(@ABookmark);
if ScrollForward = grEOF then
if ScrollBackward = grBOF then
ScrollLast; // last record will be removed from index, so move to spare record
StoreCurrentRecIntoBookmark(@ABookmark);
end;
RemoveRecordFromIndexes(BookmarkData);
FreeRecordBuffer(ARecordBuffer);
dec(FBRecordCount);
end;
RemoveRecordFromIndexes(Bm);
FreeRecordBuffer(TmpBuf);
dec(FBRecordCount);
end;
end;
BookmarkData.BookmarkData:=nil;
BookmarkData.BookmarkData := nil;
end;
end;
procedure TCustomBufDataset.RevertRecord;
var
ABookmark : TBufBookmark;
begin
CheckBrowseMode;
if GetActiveRecordUpdateBuffer then
begin
FCurrentIndex.StoreCurrentRecIntoBookmark(@ABookmark);
CancelRecordUpdateBuffer(FCurrentUpdateBuffer, ABookmark);
// remove update record of current record from update-buffer array
Move(FUpdateBuffer[FCurrentUpdateBuffer+1], FUpdateBuffer[FCurrentUpdateBuffer], (High(FUpdateBuffer)-FCurrentUpdateBuffer)*SizeOf(TRecUpdateBuffer));
SetLength(FUpdateBuffer, High(FUpdateBuffer));
FCurrentIndex.GotoBookmark(@ABookmark);
Resync([]);
end;
end;
var r : Integer;
procedure TCustomBufDataset.CancelUpdates;
var
ABookmark : TBufBookmark;
r : Integer;
begin
CheckBrowseMode;
if Length(FUpdateBuffer) > 0 then
begin
FCurrentIndex.StoreCurrentRecIntoBookmark(@StoreRecBM);
for r := Length(FUpdateBuffer) - 1 downto 0 do
CancelUpdBuffer(FUpdateBuffer[r]);
FCurrentIndex.StoreCurrentRecIntoBookmark(@ABookmark);
SetLength(FUpdateBuffer,0);
for r := High(FUpdateBuffer) downto 0 do
CancelRecordUpdateBuffer(r, ABookmark);
SetLength(FUpdateBuffer, 0);
FCurrentIndex.GotoBookmark(@StoreRecBM);
FCurrentIndex.GotoBookmark(@ABookmark);
Resync([]);
end;
@ -2635,7 +2659,7 @@ begin
FAutoIncField.AsInteger := FAutoIncValue;
inc(FAutoIncValue);
end;
// The active buffer is the newly created TDataset record,
// The active buffer is the newly created TDataSet record,
// from which the bookmark is set to the record where the new record should be
// inserted
ABookmark := PBufBookmark(ActiveBuffer + FRecordSize);
@ -2653,12 +2677,13 @@ begin
// insert (before current record)
FIndexes[i].GotoBookmark(ABookmark);
// insert new record before current record
FIndexes[i].InsertRecordBeforeCurrentRecord(ABuff);
// newly inserted record becomes current record
FIndexes[i].ScrollBackward;
end;
// Link the newly created record buffer to the newly created TDataset record
// Link the newly created record buffer to the newly created TDataSet record
FCurrentIndex.StoreCurrentRecIntoBookmark(ABookmark);
ABookmark^.BookmarkFlag := bfInserted;
@ -2679,12 +2704,11 @@ begin
if State = dsEdit then
begin
// Create an oldvalues buffer with the old values of the record
FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := IntAllocRecordBuffer;
with FCurrentIndex do
// Move only the real data
move(CurrentBuffer^,FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer^,FRecordSize);
// Create an OldValues buffer with the old values of the record
FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind := ukModify;
FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := IntAllocRecordBuffer;
// Move only the real data
move(FCurrentIndex.CurrentBuffer^, FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer^, FRecordSize);
end
else
begin
@ -3018,12 +3042,10 @@ procedure TCustomBufDataset.GetDatasetPacket(AWriter: TDataPacketReader);
begin
AStoreUpdBuf:=FCurrentUpdateBuffer;
if GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,False) then
begin
repeat
if FCurrentIndex.SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData, @AUpdBuffer.BookmarkData) then
StoreUpdateBuffer(FUpdateBuffer[FCurrentUpdateBuffer], ARowState);
until not GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,True)
end;
until not GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,True);
FCurrentUpdateBuffer:=AStoreUpdBuf;
AThisRowState := [rsvDeleted];
end
@ -3036,16 +3058,16 @@ procedure TCustomBufDataset.GetDatasetPacket(AWriter: TDataPacketReader);
FDatasetReader.StoreRecord(AThisRowState,FCurrentUpdateBuffer);
end;
procedure HandleUpdateBuffersFromRecord(AFirstCall : boolean;ARecBookmark : TBufBookmark; var ARowState: TRowState);
procedure HandleUpdateBuffersFromRecord(AFindNext : boolean; ARecBookmark : TBufBookmark; var ARowState: TRowState);
var StoreUpdBuf1,StoreUpdBuf2 : Integer;
begin
if AFirstCall then ARowState:=[];
if GetRecordUpdateBuffer(ARecBookmark,True,not AFirstCall) then
if not AFindNext then ARowState:=[];
if GetRecordUpdateBuffer(ARecBookmark,True,AFindNext) then
begin
if FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind=ukDelete then
begin
StoreUpdBuf1:=FCurrentUpdateBuffer;
HandleUpdateBuffersFromRecord(False,ARecBookmark,ARowState);
HandleUpdateBuffersFromRecord(True,ARecBookmark,ARowState);
StoreUpdBuf2:=FCurrentUpdateBuffer;
FCurrentUpdateBuffer:=StoreUpdBuf1;
StoreUpdateBuffer(FUpdateBuffer[StoreUpdBuf1], ARowState);
@ -3054,7 +3076,7 @@ procedure TCustomBufDataset.GetDatasetPacket(AWriter: TDataPacketReader);
else
begin
StoreUpdateBuffer(FUpdateBuffer[FCurrentUpdateBuffer], ARowState);
HandleUpdateBuffersFromRecord(False,ARecBookmark,ARowState);
HandleUpdateBuffersFromRecord(True,ARecBookmark,ARowState);
end;
end
end;
@ -3078,7 +3100,9 @@ begin
begin
RowState:=[];
FCurrentIndex.StoreCurrentRecIntoBookmark(ABookmark);
HandleUpdateBuffersFromRecord(True,ABookmark^,RowState);
// updates related to current record are stored first
HandleUpdateBuffersFromRecord(False,ABookmark^,RowState);
// now store current record
FFilterBuffer:=FCurrentIndex.CurrentBuffer;
if RowState=[] then
FDatasetReader.StoreRecord([])
@ -3094,7 +3118,7 @@ begin
end;
// There could be an update buffer linked to the last (spare) record
FCurrentIndex.StoreSpareRecIntoBookmark(ABookmark);
HandleUpdateBuffersFromRecord(True,ABookmark^,RowState);
HandleUpdateBuffersFromRecord(False,ABookmark^,RowState);
RestoreState(SavedState);
@ -3233,10 +3257,9 @@ end;
procedure TCustomBufDataset.IntLoadRecordsFromFile;
var SavedState : TDataSetState;
AddRecordBuffer : boolean;
ARowState : TRowState;
AUpdOrder : integer;
x : integer;
i : integer;
begin
CheckBiDirectional;
@ -3274,9 +3297,6 @@ begin
FDatasetReader.RestoreRecord;
FIndexes[0].AddRecord;
inc(FBRecordCount);
AddRecordBuffer:=False;
end
else if rsvDeleted in ARowState then
begin
@ -3297,16 +3317,11 @@ begin
FIndexes[0].RemoveRecordFromIndex(FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData);
for x := FCurrentUpdateBuffer+1 to length(FUpdateBuffer)-1 do
if FIndexes[0].SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@FUpdateBuffer[x].NextBookmarkData) then
FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[x].NextBookmarkData);
AddRecordBuffer:=False;
for i := FCurrentUpdateBuffer+1 to high(FUpdateBuffer) do
if FIndexes[0].SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData, @FUpdateBuffer[i].NextBookmarkData) then
FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[i].NextBookmarkData);
end
else
AddRecordBuffer:=True;
if AddRecordBuffer then
begin
FFilterBuffer:=FIndexes[0].SpareBuffer;
fillchar(FFilterBuffer^,FNullmaskSize,0);

70
packages/fcl-db/src/sqldb/interbase/fbadmin.pp
View File

@ -47,11 +47,11 @@ uses
type
TIBBackupOption=(IBBkpVerbose,IBBkpIgnoreChecksums,IBBkpIgnoreLimbo,IBBkpMetadataOnly,
IBBkpNoGarbageCollect,IBBkpOldDescriptions,IBBkpNonTransportable,IBBkpConvert);
IBBkpNoGarbageCollect,IBBkpOldDescriptions,IBBkpNonTransportable,IBBkpConvert,IBBkpWait);
TIBBackupOptions= set of TIBBackupOption;
TIBRestoreOption=(IBResVerbose,IBResDeactivateIdx,IBResNoShadow,IBResNoValidity,
IBResOneAtaTime,IBResReplace,IBResCreate,IBResUseAllSpace,IBResAMReadOnly,IBResAMReadWrite,
IBFixFssData, IBFixFssMeta);
IBFixFssData, IBFixFssMeta,IBResWait);
TIBRestoreOptions= set of TIBRestoreOption;
TServiceProtocol=(IBSPLOCAL,IBSPTCPIP,IBSPNETBEUI,IBSPNAMEDPIPE);
TIBOnOutput= procedure(Sender: TObject; msg: string; IBAdminAction: string) of object;
@ -82,6 +82,7 @@ type
FSvcHandle: isc_svc_handle;
FUseExceptions: boolean;
FUser: string;
FWaitInterval: Integer;
function CheckConnected(ProcName: string):boolean;
procedure CheckError(ProcName : string; Status : PISC_STATUS);
function GetDBInfo:boolean;
@ -94,7 +95,6 @@ type
function IBSPBParamSerialize(isccode:byte;value:longint):string;
function MakeBackupOptions(options:TIBBackupOptions):longint;
function MakeRestoreOptions(options:TIBRestoreOptions):longint;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -140,6 +140,12 @@ type
function GetUsers(Users:TStrings):boolean;
//Get database server log file
function GetDatabaseLog:boolean;
// For Backup, Restore this will check if the service call is still running.
function ServiceRunning: Boolean;
// Wait till the service stops running, or until aTimeout (in milliseconds) is reached.
// Return true if the service stopped, false if timeout reached.
// WaitInterval is the interval (in milliseconds) between ServiceRunning calls.
function WaitForServiceCompletion(aTimeOut: Integer): Boolean;
//Get database statistics
function GetDatabaseStats(Database:string;Options:TIBStatOptions;TableNames:String = ''): boolean;
//Database server version
@ -183,11 +189,15 @@ type
//Event handler for Service output messages
//Used in Backup and Restore operations and GetLog
property OnOutput: TIBOnOutput read FOnOutput write FOnOutput;
// Interval (in milliseconds) to sleep while waiting for the service operation to end.
Property WaitInterval : Integer Read FWaitInterval Write FWaitInterval;
end;
implementation
uses dateutils;
resourcestring
SErrNotConnected = '%s : %s : Not connected.';
SErrError = '%s : %s : %s';
@ -383,6 +393,7 @@ end;
destructor TFBAdmin.Destroy;
begin
if FSvcHandle<>FB_API_NULLHANDLE then
WaitInterval:=100;
DisConnect;
FOutput.Destroy;
inherited Destroy;
@ -454,7 +465,9 @@ begin
exit;
end;
if IBBkpVerbose in Options then
result:=GetOutput('Backup');
result:=GetOutput('Backup')
else if (IBBkpWait in Options) then
WaitForServiceCompletion(0);
end;
function TFBAdmin.BackupMultiFile(Database: string; Filenames: TStrings;
@ -483,9 +496,52 @@ begin
exit;
end;
if IBBkpVerbose in Options then
result:=GetOutput('BackupMultiFile');
result:=GetOutput('BackupMultiFile')
else if (IBBkpWait in Options) then
WaitForServiceCompletion(0);
end;
Function TFBAdmin.ServiceRunning : Boolean;
const
BUFFERSIZE=1000;
var
res:integer;
buffer: string;
spb:string;
begin
FOutput.Clear;
spb:=chr(isc_info_svc_running);
setlength(buffer,BUFFERSIZE);
result:=isc_service_query(@FStatus[0], @FSvcHandle, nil, 0, nil, length(spb),
@spb[1],BUFFERSIZE,@buffer[1])=0;
if Not Result then
CheckError('ServiceRunning',FSTatus);
if (Buffer[1]=Char(isc_info_svc_running)) then
begin
res:=isc_vax_integer(@Buffer[2],4);
Result:=res=1;
end
else
IBRaiseError(0,'%s: Service status detection returned wrong result',[self.Name]);
end;
Function TFBAdmin.WaitForServiceCompletion(aTimeOut : Integer) : Boolean;
Var
N : TDateTime;
begin
N:=Now;
Repeat
Sleep(WaitInterval);
Result:=not ServiceRunning;
until Result or ((aTimeOut<>0) and (MilliSecondsBetween(Now,N)>aTimeOut*WaitInterval));
end;
function TFBAdmin.Restore(Database, Filename: string;
Options: TIBRestoreOptions; RoleName: string): boolean;
var
@ -524,7 +580,9 @@ begin
exit;
end;
if IBResVerbose in Options then
result:=GetOutput('Restore');
result:=GetOutput('Restore')
else if IBResWait in Options then
WaitForServiceCompletion(0);
end;

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

@ -154,8 +154,10 @@ Type
function RefreshLastInsertID(Query : TCustomSQLQuery; Field : TField): Boolean; override;
Public
constructor Create(AOwner : TComponent); override;
{$IFNDEF MYSQL50_UP}
procedure GetFieldNames(const TableName : string; List : TStrings); override;
procedure GetTableNames(List : TStrings; SystemTables : Boolean = false); override;
{$ENDIF}
function GetConnectionInfo(InfoType:TConnInfoType): string; override;
Function GetInsertID: int64;
procedure CreateDB; override;
@ -1199,6 +1201,7 @@ begin
FMySQL := Nil;
end;
{$IFNDEF MYSQL50_UP}
procedure TConnectionName.GetFieldNames(const TableName: string; List: TStrings);
begin
GetDBInfo(stColumns,TableName,'field',List);
@ -1208,6 +1211,7 @@ procedure TConnectionName.GetTableNames(List: TStrings; SystemTables: Boolean);
begin
GetDBInfo(stTables,'','tables_in_'+DatabaseName,List)
end;
{$ENDIF}
function TConnectionName.GetConnectionInfo(InfoType: TConnInfoType): string;
begin
@ -1294,13 +1298,19 @@ function TConnectionName.GetSchemaInfoSQL(SchemaType: TSchemaType;
begin
case SchemaType of
{$IFDEF MYSQL50_UP}
stTables : result := 'SELECT * FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA=SCHEMA() AND TABLE_TYPE IN (''BASE TABLE'',''VIEW'')';
stColumns : result := 'SELECT * FROM INFORMATION_SCHEMA.COLUMNS WHERE TABLE_SCHEMA=SCHEMA() AND TABLE_NAME='+QuotedStr(SchemaObjectName);
{$ELSE}
stTables : result := 'show tables';
stColumns : result := 'show columns from ' + EscapeString(SchemaObjectName);
{$ENDIF}
else
DatabaseError(SMetadataUnavailable)
result := inherited;
end; {case}
end;
{ TMySQLConnectionDef }
class function TMySQLConnectionDef.TypeName: String;

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

@ -578,6 +578,8 @@ type
property AfterCancel;
property BeforeDelete;
property AfterDelete;
property BeforeRefresh;
property AfterRefresh;
property BeforeScroll;
property AfterScroll;
property OnCalcFields;
@ -630,6 +632,7 @@ type
Property AfterInsert;
Property AfterOpen;
Property AfterPost;
Property AfterRefresh;
Property AfterScroll;
Property BeforeCancel;
Property BeforeClose;
@ -638,6 +641,7 @@ type
Property BeforeInsert;
Property BeforeOpen;
Property BeforePost;
Property BeforeRefresh;
Property BeforeScroll;
Property OnCalcFields;
Property OnDeleteError;
@ -1984,6 +1988,8 @@ function TSQLConnection.GetSchemaInfoSQL( SchemaType : TSchemaType; SchemaObject
begin
case SchemaType of
stTables : Result := 'SELECT * FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_TYPE=''BASE TABLE''';
stColumns : Result := 'SELECT * FROM INFORMATION_SCHEMA.COLUMNS WHERE TABLE_NAME='+QuotedStr(SchemaObjectName);
stProcedures: Result := 'SELECT *, ROUTINE_NAME AS PROCEDURE_NAME FROM INFORMATION_SCHEMA.ROUTINES';
stSchemata : Result := 'SELECT * FROM INFORMATION_SCHEMA.SCHEMATA';
stSequences : Result := 'SELECT * FROM INFORMATION_SCHEMA.SEQUENCES';

72
packages/fcl-db/tests/sqldbtoolsunit.pas
View File

@ -358,6 +358,11 @@ begin
testStringValues[i] := TrimRight(testStringValues[i]);
end;
if SQLServerType in [ssMSSQL, ssSQLite, ssSybase] then
// Some DB's do not support sql compliant boolean data type.
for i := 0 to testValuesCount-1 do
testValues[ftBoolean, i] := BoolToStr(testBooleanValues[i], '1', '0');
if SQLServerType in [ssMySQL] then
begin
// Some DB's do not support milliseconds in datetime and time fields.
@ -499,46 +504,35 @@ begin
begin
sql := sql + ',F' + Fieldtypenames[FType];
if testValues[FType,CountID] <> '' then
case FType of
ftBlob, ftBytes, ftGraphic, ftVarBytes:
if SQLServerType in [ssOracle] then
// Oracle does not accept string literals in blob insert statements
// convert 'DEADBEEF' hex literal to binary:
sql1 := sql1 + ', HEXTORAW(' + QuotedStr(String2Hex(testValues[FType,CountID])) + ') '
else // other dbs have no problems with the original string values
sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID]);
ftCurrency:
sql1 := sql1 + ',' + testValues[FType,CountID];
ftDate:
// Oracle requires date conversion; otherwise
// ORA-01861: literal does not match format string
if SQLServerType in [ssOracle] then
// ANSI/ISO date literal:
sql1 := sql1 + ', DATE ' + QuotedStr(testValues[FType,CountID])
else
sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID]);
ftDateTime:
// similar to ftDate handling
if SQLServerType in [ssOracle] then
begin
// Could be a real date+time or only date. Does not consider only time.
if pos(' ',testValues[FType,CountID])>0 then
sql1 := sql1 + ', TIMESTAMP ' + QuotedStr(testValues[FType,CountID])
else
sql1 := sql1 + ', DATE ' + QuotedStr(testValues[FType,CountID]);
end
else
sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID]);
ftTime:
// similar to ftDate handling
if SQLServerType in [ssOracle] then
// More or less arbitrary default time; there is no time-only data type in Oracle.
sql1 := sql1 + ', TIMESTAMP ' + QuotedStr('0001-01-01 '+testValues[FType,CountID])
else
sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID]);
else
sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID])
if FType in [ftBoolean, ftCurrency] then
sql1 := sql1 + ',' + testValues[FType,CountID]
else if (FType in [ftBlob, ftBytes, ftGraphic, ftVarBytes]) and
(SQLServerType = ssOracle) then
// Oracle does not accept string literals in blob insert statements
// convert 'DEADBEEF' hex literal to binary:
sql1 := sql1 + ', HEXTORAW(' + QuotedStr(String2Hex(testValues[FType,CountID])) + ') '
else if (FType = ftDate) and
(SQLServerType = ssOracle) then
// Oracle requires date conversion; otherwise
// ORA-01861: literal does not match format string
// ANSI/ISO date literal:
sql1 := sql1 + ', DATE ' + QuotedStr(testValues[FType,CountID])
else if (FType = ftDateTime) and
(SQLServerType = ssOracle) then begin
// similar to ftDate handling
// Could be a real date+time or only date. Does not consider only time.
if pos(' ',testValues[FType,CountID])>0 then
sql1 := sql1 + ', TIMESTAMP ' + QuotedStr(testValues[FType,CountID])
else
sql1 := sql1 + ', DATE ' + QuotedStr(testValues[FType,CountID]);
end
else if (FType = ftTime) and
(SQLServerType = ssOracle) then
// similar to ftDate handling
// More or less arbitrary default time; there is no time-only data type in Oracle.
sql1 := sql1 + ', TIMESTAMP ' + QuotedStr('0001-01-01 '+testValues[FType,CountID])
else
sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID])
else
sql1 := sql1 + ',NULL';
end;

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

@ -88,6 +88,7 @@ type
procedure TestMultipleDeleteUpdateBuffer;
procedure TestDoubleDelete;
procedure TestMergeChangeLog;
procedure TestRevertRecord;
// index tests
procedure TestAddIndexInteger;
procedure TestAddIndexSmallInt;
@ -1231,6 +1232,7 @@ begin
begin
Open;
// modify records
for i := 0 to 16 do
begin
if i mod 4=0 then
@ -1242,19 +1244,21 @@ begin
next;
end;
for i := 17 to 20 do
// append new records
for i := 18 to 21 do
begin
append;
fieldbyname('id').AsInteger:=i+1;
fieldbyname('name').AsString:='TestName'+inttostr(i+1);
fieldbyname('id').AsInteger:=i;
fieldbyname('name').AsString:='TestName'+inttostr(i);
post;
end;
// delete records #1,5,9,13,17,21 which was modified or appended before
first;
for i := 0 to 20 do if i mod 4=0 then
delete
else
next;
next;
First;
i := 0;
@ -1279,10 +1283,10 @@ begin
CancelUpdates;
First;
for i := 0 to 16 do
for i := 1 to 17 do
begin
CheckEquals(i+1,FieldByName('ID').AsInteger);
CheckEquals('TestName'+inttostr(i+1),FieldByName('NAME').AsString);
CheckEquals(i, FieldByName('ID').AsInteger);
CheckEquals('TestName'+inttostr(i), FieldByName('NAME').AsString);
next;
end;
@ -1785,6 +1789,77 @@ begin
end;
end;
procedure TTestBufDatasetDBBasics.TestRevertRecord;
begin
with DBConnector.GetNDataset(True,1) as TCustomBufDataset do
begin
Open;
// update value in one record and revert them
Edit;
FieldByName('ID').AsInteger := 100;
Post;
CheckEquals(100, FieldByName('ID').AsInteger);
RevertRecord;
CheckEquals(1, FieldByName('ID').AsInteger, 'Revert modified #1');
// append new record and delete prior and revert appended
AppendRecord([3,'']);
InsertRecord([2,'']);
Prior;
Delete; // 1st
Next;
RevertRecord; // 3rd
CheckEquals(2, FieldByName('ID').AsInteger, 'Revert inserted #1a');
RevertRecord; // 2nd
CheckTrue(Eof, 'Revert inserted #1b');
CancelUpdates; // restores 1st deleted record
CheckEquals(1, FieldByName('ID').AsInteger, 'CancelUpdates #1');
Close;
end;
with DBConnector.GetNDataset(False,0) as TCustomBufDataset do
begin
Open;
// insert one record and revert them
InsertRecord([1,'']);
RevertRecord;
CheckTrue(Eof);
CheckEquals(0, ChangeCount);
// insert two records and revert them in inverse order
AppendRecord([2,'']);
InsertRecord([1,'']); // this record in update-buffer is linked to 2
RevertRecord;
CheckEquals(2, FieldByName('ID').AsInteger);
CheckEquals(1, ChangeCount);
RevertRecord;
CheckTrue(Eof);
CheckEquals(0, ChangeCount);
// insert more records and some delete and some revert
AppendRecord([4,'']);
InsertRecord([3,'']);
InsertRecord([2,'']);
InsertRecord([1,'']);
CheckEquals(4, ChangeCount);
Delete; // 1
CheckEquals(4, ChangeCount);
Next; // 3
RevertRecord;
CheckEquals(4, FieldByName('ID').AsInteger);
CheckEquals(3, ChangeCount);
Prior; // 2
RevertRecord;
CheckEquals(4, FieldByName('ID').AsInteger);
CheckEquals(2, ChangeCount);
CancelUpdates;
CheckTrue(Eof);
CheckEquals(0, ChangeCount);
Close;
end;
end;
procedure TTestBufDatasetDBBasics.FTestXMLDatasetDefinition(ADataset: TDataset);
var i : integer;
begin

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

@ -528,8 +528,6 @@ end;
procedure InitialiseDBConnector;
const B: array[boolean] of char=('0','1'); // should be exported from some main db unit, as SQL true/false?
var DBConnectorClass : TPersistentClass;
i : integer;
FormatSettings : TFormatSettings;
@ -550,7 +548,7 @@ begin
testValues[ftFMTBcd] := testFmtBCDValues;
for i := 0 to testValuesCount-1 do
begin
testValues[ftBoolean,i] := B[testBooleanValues[i]];
testValues[ftBoolean,i] := BoolToStr(testBooleanValues[i], True);
testValues[ftFloat,i] := FloatToStr(testFloatValues[i],FormatSettings);
testValues[ftSmallint,i] := IntToStr(testSmallIntValues[i]);
testValues[ftInteger,i] := IntToStr(testIntValues[i]);

3
packages/postgres/src/postgres3dyn.pp
View File

@ -233,6 +233,8 @@ var
{ === in fe-auth.c === }
PQencryptPassword : function (passwd:Pcchar; user:Pcchar):Pcchar;cdecl;
{ === in encnames.c === }
pg_encoding_to_char: function (encoding:cint):Pcchar;cdecl;
Function InitialisePostgres3(Const libpath : ansistring) : integer;
Procedure InitialisePostgres3;
@ -398,6 +400,7 @@ begin
pointer(PQmblen) := GetProcedureAddress(Postgres3LibraryHandle,'PQmblen');
pointer(PQenv2encoding) := GetProcedureAddress(Postgres3LibraryHandle,'PQenv2encoding');
pointer(PQencryptPassword) := GetProcedureAddress(Postgres3LibraryHandle,'PQencryptPassword');
pointer(pg_encoding_to_char) := GetProcedureAddress(Postgres3LibraryHandle,'pg_encoding_to_char');
InitialiseDllist(libpath);
end