summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormarco <marco@3ad0048d-3df7-0310-abae-a5850022a9f2>2017-04-28 12:38:15 +0000
committermarco <marco@3ad0048d-3df7-0310-abae-a5850022a9f2>2017-04-28 12:38:15 +0000
commitf3b1493106e66b5e2fbcb247618bb5c0a1e3bb80 (patch)
treec39b597284db1e45ac684baab50f8f190e93e20d
parent22a1a570c6a3e1d9d8dd974c5a5ee39bdf2872e0 (diff)
downloadfpc-f3b1493106e66b5e2fbcb247618bb5c0a1e3bb80.tar.gz
--- Merging r33254 into '.':
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: http://svn.freepascal.org/svn/fpc/branches/fixes_3_0@35993 3ad0048d-3df7-0310-abae-a5850022a9f2
-rw-r--r--packages/fcl-db/src/base/bufdataset.pas211
-rw-r--r--packages/fcl-db/src/sqldb/interbase/fbadmin.pp70
-rw-r--r--packages/fcl-db/src/sqldb/mysql/mysqlconn.inc12
-rw-r--r--packages/fcl-db/src/sqldb/sqldb.pp6
-rw-r--r--packages/fcl-db/tests/sqldbtoolsunit.pas72
-rw-r--r--packages/fcl-db/tests/testdbbasics.pas89
-rw-r--r--packages/fcl-db/tests/toolsunit.pas4
-rw-r--r--packages/postgres/src/postgres3dyn.pp3
8 files changed, 313 insertions, 154 deletions
diff --git a/packages/fcl-db/src/base/bufdataset.pas b/packages/fcl-db/src/base/bufdataset.pas
index ff34c5259c..3751375cee 100644
--- a/packages/fcl-db/src/base/bufdataset.pas
+++ b/packages/fcl-db/src/base/bufdataset.pas
@@ -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;
-
- FCurrentIndex.GotoBookmark(@Bm);
- TmpBuf:=FCurrentIndex.CurrentRecord;
- // resync won't work if the currentbuffer is freed...
- if FCurrentIndex.SameBookmarks(@Bm,@StoreRecBM) then with FCurrentIndex do
+ 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
- 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);
+ FCurrentIndex.GotoBookmark(@BookmarkData);
+ ARecordBuffer := FCurrentIndex.CurrentRecord;
+
+ // 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;
+end;
-var r : Integer;
+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;
+
+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);
diff --git a/packages/fcl-db/src/sqldb/interbase/fbadmin.pp b/packages/fcl-db/src/sqldb/interbase/fbadmin.pp
index e1d2d667af..1088319170 100644
--- a/packages/fcl-db/src/sqldb/interbase/fbadmin.pp
+++ b/packages/fcl-db/src/sqldb/interbase/fbadmin.pp
@@ -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;
diff --git a/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc b/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
index 2c1964c827..9081a278e4 100644
--- a/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
+++ b/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
@@ -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;
diff --git a/packages/fcl-db/src/sqldb/sqldb.pp b/packages/fcl-db/src/sqldb/sqldb.pp
index 484e18c614..edc5a53dc4 100644
--- a/packages/fcl-db/src/sqldb/sqldb.pp
+++ b/packages/fcl-db/src/sqldb/sqldb.pp
@@ -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';
diff --git a/packages/fcl-db/tests/sqldbtoolsunit.pas b/packages/fcl-db/tests/sqldbtoolsunit.pas
index e9ad6d59db..7d125dc4ed 100644
--- a/packages/fcl-db/tests/sqldbtoolsunit.pas
+++ b/packages/fcl-db/tests/sqldbtoolsunit.pas
@@ -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;
diff --git a/packages/fcl-db/tests/testdbbasics.pas b/packages/fcl-db/tests/testdbbasics.pas
index 64ba6ff1e7..419212d898 100644
--- a/packages/fcl-db/tests/testdbbasics.pas
+++ b/packages/fcl-db/tests/testdbbasics.pas
@@ -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
diff --git a/packages/fcl-db/tests/toolsunit.pas b/packages/fcl-db/tests/toolsunit.pas
index e85194194a..89a9941173 100644
--- a/packages/fcl-db/tests/toolsunit.pas
+++ b/packages/fcl-db/tests/toolsunit.pas
@@ -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]);
diff --git a/packages/postgres/src/postgres3dyn.pp b/packages/postgres/src/postgres3dyn.pp
index b434ef7a61..8c4e4e9867 100644
--- a/packages/postgres/src/postgres3dyn.pp
+++ b/packages/postgres/src/postgres3dyn.pp
@@ -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