--- ibx/trunk/runtime/nongui/IBCustomDataSet.pas 2018/10/25 13:57:12 241 +++ ibx/trunk/runtime/nongui/IBCustomDataSet.pas 2018/12/06 15:55:01 263 @@ -54,11 +54,7 @@ uses unix, {$ENDIF} SysUtils, Classes, IBDatabase, IBExternals, IB, IBSQL, Db, - IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo, fpTimer; - -const - BufferCacheSize = 1000; { Allocate cache in this many record chunks} - UniCache = 2; { Uni-directional cache is 2 records big } + IBUtils, IBBlob, IBSQLParser, IBDatabaseInfo, IBTypes; type TIBCustomDataSet = class; @@ -88,8 +84,6 @@ type property RefreshSQL: TStrings read FRefreshSQL write SetRefreshSQL; end; - TBlobDataArray = array[0..0] of TIBBlobStream; - PBlobDataArray = ^TBlobDataArray; TIBArrayField = class; { TIBArray } @@ -108,51 +102,6 @@ type property ArrayIntf: IArray read FArray; end; - TArrayDataArray = array [0..0] of TIBArray; - PArrayDataArray = ^TArrayDataArray; - - { TIBCustomDataSet } - - TCachedUpdateStatus = ( - cusUnmodified, cusModified, cusInserted, - cusDeleted, cusUninserted - ); - TIBDBKey = record - DBKey: array[0..7] of Byte; - end; - PIBDBKey = ^TIBDBKey; - - PFieldData = ^TFieldData; - TFieldData = record - fdIsNull: Boolean; - fdDataLength: Short; - end; - - PColumnData = ^TColumnData; - TColumnData = record - fdDataType: Short; - fdDataScale: Short; - fdNullable: Boolean; - fdDataSize: Short; - fdDataOfs: Integer; - fdCodePage: TSystemCodePage; - end; - - PFieldColumns = ^TFieldColumns; - TFieldColumns = array[1..1] of TColumnData; - - TRecordData = record - rdBookmarkFlag: TBookmarkFlag; - rdFieldCount: Short; - rdRecordNumber: Integer; - rdCachedUpdateStatus: TCachedUpdateStatus; - rdUpdateStatus: TUpdateStatus; - rdSavedOffset: DWORD; - rdDBKey: TIBDBKey; - rdFields: array[1..1] of TFieldData; - end; - PRecordData = ^TRecordData; - { TIBArrayField } TIBArrayField = class(TField) @@ -300,7 +249,7 @@ type private FDataSet: TIBCustomDataSet; FDelayTimerValue: integer; - FTimer: TFPTimer; + FTimer: TIBTimerInf; procedure HandleRefreshTimer(Sender: TObject); procedure SetDelayTimerValue(AValue: integer); protected @@ -366,8 +315,6 @@ type TIBAutoCommit = (acDisabled, acCommitRetaining); - { TIBCustomDataSet } - TIBUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApply, uaApplied); TIBUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError; @@ -376,16 +323,78 @@ type TIBUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind; var UpdateAction: TIBUpdateAction) of object; - TIBUpdateRecordTypes = set of TCachedUpdateStatus; - TDataSetCloseAction = (dcDiscardChanges, dcSaveChanges); TOnValidatePost = procedure (Sender: TObject; var CancelPost: boolean) of object; TOnDeleteReturning = procedure (Sender: TObject; QryResults: IResults) of object; + { TIBCustomDataSet } + TIBCustomDataSet = class(TDataset) private + const + BufferCacheSize = 1000; { Allocate cache in this many record chunks} + UniCache = 2; { Uni-directional cache is 2 records big } + + {Buffer cache constants for record selection} + FILE_BEGIN = 0; + FILE_CURRENT = 1; + FILE_END = 2; + + {internal type declarations} + type + TArrayDataArray = array [0..0] of TIBArray; + PArrayDataArray = ^TArrayDataArray; + + TBlobDataArray = array[0..0] of TIBBlobStream; + PBlobDataArray = ^TBlobDataArray; + + TCachedUpdateStatus = ( + cusUnmodified, cusModified, cusInserted, + cusDeleted, cusUninserted + ); + TIBUpdateRecordTypes = set of TCachedUpdateStatus; + + PFieldData = ^TFieldData; + TFieldData = record + fdIsNull: Boolean; + fdDataLength: Short; + end; + + PColumnData = ^TColumnData; + TColumnData = record + fdDataType: Short; + fdDataScale: Short; + fdNullable: Boolean; + fdDataSize: Short; + fdDataOfs: Integer; + fdCodePage: TSystemCodePage; + end; + + PFieldColumns = ^TFieldColumns; + TFieldColumns = array[1..1] of TColumnData; + + protected + type + TIBDBKey = record + DBKey: array[0..7] of Byte; + end; + PIBDBKey = ^TIBDBKey; + + TRecordData = record + rdBookmarkFlag: TBookmarkFlag; + rdFieldCount: Short; + rdRecordNumber: Integer; + rdCachedUpdateStatus: TCachedUpdateStatus; + rdUpdateStatus: TUpdateStatus; + rdSavedOffset: DWORD; + rdDBKey: TIBDBKey; + rdFields: array[1..1] of TFieldData; + end; + PRecordData = ^TRecordData; + + private FAllowAutoActivateTransaction: Boolean; FArrayFieldCount: integer; FArrayCacheOffset: integer; @@ -897,7 +906,7 @@ type end; const -DefaultFieldClasses: array[TFieldType] of TFieldClass = ( + DefaultFieldClasses: array[TFieldType] of TFieldClass = ( nil, { ftUnknown } TIBStringField, { ftString } TIBSmallintField, { ftSmallint } @@ -956,10 +965,6 @@ implementation uses Variants, FmtBCD, LazUTF8, FBMessages, IBQuery; -const FILE_BEGIN = 0; - FILE_CURRENT = 1; - FILE_END = 2; - type TFieldNode = class(TObject) @@ -1158,14 +1163,14 @@ begin 3, {Assume UNICODE_FSS is really UTF8} 4: {Include GB18030 - assuming UTF8 routines work for this codeset} if DisplayWidth = 0 then - {$if not defined(ValidUTF8String)} + {$if declared(Utf8EscapeControlChars)} Result := Utf8EscapeControlChars(TextToSingleLine(Result)) {$else} Result := ValidUTF8String(TextToSingleLine(Result)) {$endif} else if UTF8Length(Result) > DisplayWidth then {Show truncation with elipses} - {$if not defined(ValidUTF8String)} + {$if declared(Utf8EscapeControlChars)} Result := Utf8EscapeControlChars(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...'; {$else} Result := ValidUTF8String(TextToSingleLine(UTF8Copy(Result,1,DisplayWidth-3))) + '...'; @@ -1419,17 +1424,22 @@ constructor TIBDataLink.Create(ADataSet: begin inherited Create; FDataSet := ADataSet; - FTimer := TFPTimer.Create(nil); - FTimer.Enabled := false; - FTimer.Interval := 0; - FTimer.OnTimer := HandleRefreshTimer; + if assigned(IBGUIInterface) then + begin + FTimer := IBGUIInterface.CreateTimer; + if FTimer <> nil then + begin + FTimer.Enabled := false; + FTimer.Interval := 0; + FTimer.OnTimer := HandleRefreshTimer; + end; + end; FDelayTimerValue := 0; end; destructor TIBDataLink.Destroy; begin FDataSet.FDataLink := nil; - if assigned(FTimer) then FTimer.Free; inherited Destroy; end; @@ -1443,12 +1453,9 @@ end; procedure TIBDataLink.SetDelayTimerValue(AValue: integer); begin if FDelayTimerValue = AValue then Exit; + if assigned(FTimer) then + FTimer.Enabled := false; FDelayTimerValue := AValue; - {$IF FPC_FULLVERSION >= 30002} - if (AValue > 0) and not IsMultiThread then - IBError(ibxeMultiThreadRequired,['TIBQuery/TIBDataset MasterDetailDelay']); - FTimer.Interval := FDelayTimerValue; - {$IFEND} end; procedure TIBDataLink.ActiveChanged; @@ -1467,21 +1474,14 @@ procedure TIBDataLink.RecordChanged(Fiel begin if (Field = nil) and FDataSet.Active then begin - {$IF FPC_FULLVERSION >= 30002} - if FDelayTimerValue > 0 then + if assigned(FTimer) and (FDelayTimerValue > 0) then with FTimer do begin - CheckSynchronize; {Ensure not waiting on Synchronize} - if Enabled then - begin - StopTimer; - StartTimer; - end - else - Enabled := true; + FTimer.Enabled := false; + FTimer.Interval := FDelayTimerValue; + FTimer.Enabled := true; end else - {$IFEND} FDataSet.RefreshParams; end; end; @@ -2707,7 +2707,7 @@ begin ActivateTransaction; FBase.CheckDatabase; FBase.CheckTransaction; - if HasParser and (FParser.SQLText <> FQSelect.SQL.Text) then + if HasParser and not FParser.NotaSelectStmt and (FParser.SQLText <> FQSelect.SQL.Text) then begin FQSelect.OnSQLChanged := nil; {Do not react to change} try @@ -3454,7 +3454,7 @@ procedure TIBCustomDataSet.DoBeforeOpen; var i: integer; begin if assigned(FParser) then - FParser.Reset; + FParser.RestoreClauseValues; for i := 0 to FIBLinks.Count - 1 do TIBControlLink(FIBLinks[i]).UpdateSQL(self); inherited DoBeforeOpen;