From c6ad797d22e5542093e7e60bfe4dc55fe0d73187 Mon Sep 17 00:00:00 2001 From: marco Date: Fri, 28 Apr 2017 12:38:15 +0000 Subject: [PATCH] --- 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: branches/fixes_3_0@35993 - --- packages/fcl-db/src/base/bufdataset.pas | 211 ++++++++++-------- .../fcl-db/src/sqldb/interbase/fbadmin.pp | 70 +++++- packages/fcl-db/src/sqldb/mysql/mysqlconn.inc | 12 +- packages/fcl-db/src/sqldb/sqldb.pp | 6 + packages/fcl-db/tests/sqldbtoolsunit.pas | 72 +++--- packages/fcl-db/tests/testdbbasics.pas | 89 +++++++- packages/fcl-db/tests/toolsunit.pas | 4 +- packages/postgres/src/postgres3dyn.pp | 3 + 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; + 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); 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