--- ibx/trunk/fbintf/client/3.0/FB30Statement.pas 2021/10/18 08:39:40 349 +++ ibx/trunk/fbintf/client/3.0/FB30Statement.pas 2021/10/20 14:58:56 350 @@ -232,13 +232,20 @@ type private FResults: TIBXOUTPUTSQLDA; FCursorSeqNo: integer; + procedure RowChange; public constructor Create(aResults: TIBXOUTPUTSQLDA); destructor Destroy; override; {IResultSet} - function FetchNext: boolean; + function FetchNext: boolean; {fetch next record} + function FetchPrior: boolean; {fetch previous record} + function FetchFirst:boolean; {fetch first record} + function FetchLast: boolean; {fetch last record} + function FetchAbsolute(position: Integer): boolean; {fetch record by its absolute position in result set} + function FetchRelative(offset: Integer): boolean; {fetch record by position relative to current} function GetCursorName: AnsiString; function GetTransaction: ITransaction; override; + function IsBof: boolean; function IsEof: boolean; procedure Close; end; @@ -260,6 +267,8 @@ type function getUpdated: integer; end; + TFetchType = (ftNext,ftPrior,ftFirst,ftLast,ftAbsolute,ftRelative); + { TFB30Statement } TFB30Statement = class(TFBStatement,IStatement) @@ -270,6 +279,7 @@ type FSQLRecord: TIBXOUTPUTSQLDA; FResultSet: Firebird.IResultSet; FCursorSeqNo: integer; + FCursor: AnsiString; FBatch: Firebird.IBatch; FBatchCompletion: IBatchCompletion; FBatchRowCount: integer; @@ -280,21 +290,22 @@ type procedure CheckHandle; override; procedure CheckBatchModeAvailable; procedure GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults); override; - procedure InternalPrepare; override; + procedure InternalPrepare(CursorName: AnsiString=''); override; function InternalExecute(aTransaction: ITransaction): IResults; override; - function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override; + function InternalOpenCursor(aTransaction: ITransaction; Scrollable: boolean + ): IResultSet; override; procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override; procedure FreeHandle; override; procedure InternalClose(Force: boolean); override; function SavePerfStats(var Stats: TPerfStatistics): boolean; public constructor Create(Attachment: TFB30Attachment; Transaction: ITransaction; - sql: AnsiString; aSQLDialect: integer); + sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''); constructor CreateWithParameterNames(Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean =false; - CaseSensitiveParams: boolean=false); + CaseSensitiveParams: boolean=false; CursorName: AnsiString=''); destructor Destroy; override; - function FetchNext: boolean; + function Fetch(FetchType: TFetchType; PosOrOffset: integer=0): boolean; property StatementIntf: Firebird.IStatement read FStatementIntf; public @@ -794,6 +805,13 @@ end; { TResultSet } +procedure TResultSet.RowChange; +var i: integer; +begin + for i := 0 to getCount - 1 do + FResults.Column[i].RowChange; +end; + constructor TResultSet.Create(aResults: TIBXOUTPUTSQLDA); begin inherited Create(aResults); @@ -808,19 +826,56 @@ begin end; function TResultSet.FetchNext: boolean; -var i: integer; begin CheckActive; - Result := FResults.FStatement.FetchNext; + Result := FResults.FStatement.Fetch(ftNext); + if Result then + RowChange; +end; + +function TResultSet.FetchPrior: boolean; +begin + CheckActive; + Result := FResults.FStatement.Fetch(ftPrior); if Result then - for i := 0 to getCount - 1 do - FResults.Column[i].RowChange; + RowChange; +end; + +function TResultSet.FetchFirst: boolean; +begin + CheckActive; + Result := FResults.FStatement.Fetch(ftFirst); + if Result then + RowChange; +end; + +function TResultSet.FetchLast: boolean; +begin + CheckActive; + Result := FResults.FStatement.Fetch(ftLast); + if Result then + RowChange; +end; + +function TResultSet.FetchAbsolute(position: Integer): boolean; +begin + CheckActive; + Result := FResults.FStatement.Fetch(ftAbsolute,position); + if Result then + RowChange; +end; + +function TResultSet.FetchRelative(offset: Integer): boolean; +begin + CheckActive; + Result := FResults.FStatement.Fetch(ftRelative,offset); + if Result then + RowChange; end; function TResultSet.GetCursorName: AnsiString; begin - IBError(ibxeNotSupported,[nil]); - Result := ''; + Result := FResults.FStatement.FCursor; end; function TResultSet.GetTransaction: ITransaction; @@ -828,6 +883,11 @@ begin Result := FResults.FTransaction; end; +function TResultSet.IsBof: boolean; +begin + Result := FResults.FStatement.FBof; +end; + function TResultSet.IsEof: boolean; begin Result := FResults.FStatement.FEof; @@ -1264,16 +1324,25 @@ begin end; end; -procedure TFB30Statement.InternalPrepare; +procedure TFB30Statement.InternalPrepare(CursorName: AnsiString); +var GUID : TGUID; begin if FPrepared then Exit; + + FCursor := CursorName; if (FSQL = '') then IBError(ibxeEmptyQuery, [nil]); try CheckTransaction(FTransactionIntf); with FFirebird30ClientAPI do begin + if FCursor = '' then + begin + CreateGuid(GUID); + FCursor := GUIDToString(GUID); + end; + if FHasParamNames then begin if FProcessedSQL = '' then @@ -1296,6 +1365,11 @@ begin FSQLStatementType := TIBSQLStatementTypes(FStatementIntf.getType(StatusIntf)); Check4DataBaseError; + if FSQLStatementType = SQLSelect then + begin + FStatementIntf.setCursorName(StatusIntf,PAnsiChar(FCursor)); + Check4DataBaseError; + end; { Done getting the type } case FSQLStatementType of SQLGetSegment, @@ -1333,6 +1407,7 @@ begin end; end; FPrepared := true; + FSingleResults := false; if RetainInterfaces then begin @@ -1416,9 +1491,11 @@ begin Inc(FChangeSeqNo); end; -function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction - ): IResultSet; +function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction; + Scrollable: boolean): IResultSet; +var flags: cardinal; begin + flags := 0; if FSQLStatementType <> SQLSelect then IBError(ibxeIsASelectStatement,[]); @@ -1432,6 +1509,9 @@ begin if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then IBError(ibxeInterfaceOutofDate,[nil]); + if Scrollable then + flags := Firebird.IStatement.CURSOR_TYPE_SCROLLABLE; + with FFirebird30ClientAPI do begin if FCollectStatistics then @@ -1447,7 +1527,7 @@ begin FSQLParams.MetaData, FSQLParams.MessageBuffer, FSQLRecord.MetaData, - 0); + flags); Check4DataBaseError; if FCollectStatistics then @@ -1493,6 +1573,7 @@ begin FStatementIntf := nil; FPrepared := false; end; + FCursor := ''; end; procedure TFB30Statement.InternalClose(Force: boolean); @@ -1538,26 +1619,27 @@ begin end; constructor TFB30Statement.Create(Attachment: TFB30Attachment; - Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); + Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; + CursorName: AnsiString); begin inherited Create(Attachment,Transaction,sql,aSQLDialect); FFirebird30ClientAPI := Attachment.Firebird30ClientAPI; FSQLParams := TIBXINPUTSQLDA.Create(self); FSQLRecord := TIBXOUTPUTSQLDA.Create(self); - InternalPrepare; + InternalPrepare(CursorName); end; constructor TFB30Statement.CreateWithParameterNames( Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean; - CaseSensitiveParams: boolean); + CaseSensitiveParams: boolean; CursorName: AnsiString); begin inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames); FFirebird30ClientAPI := Attachment.Firebird30ClientAPI; FSQLParams := TIBXINPUTSQLDA.Create(self); FSQLParams.CaseSensitiveParams := CaseSensitiveParams; FSQLRecord := TIBXOUTPUTSQLDA.Create(self); - InternalPrepare; + InternalPrepare(CursorName); end; destructor TFB30Statement.Destroy; @@ -1567,40 +1649,67 @@ begin if assigned(FSQLRecord) then FSQLRecord.Free; end; -function TFB30Statement.FetchNext: boolean; +function TFB30Statement.Fetch(FetchType: TFetchType; PosOrOffset: integer + ): boolean; var fetchResult: integer; begin result := false; if not FOpen then IBError(ibxeSQLClosed, [nil]); - if FEOF then - IBError(ibxeEOF,[nil]); with FFirebird30ClientAPI do begin - { Go to the next record... } - fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer); - if fetchResult = Firebird.IStatus.RESULT_NO_DATA then - begin - FBOF := false; - FEOF := true; - Exit; {End of File} - end - else - if fetchResult <> Firebird.IStatus.RESULT_OK then - begin - try - IBDataBaseError; - except - Close; - raise; + case FetchType of + ftNext: + begin + if FEOF then + IBError(ibxeEOF,[nil]); + { Go to the next record... } + fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer); + if fetchResult = Firebird.IStatus.RESULT_NO_DATA then + begin + FBOF := false; + FEOF := true; + Exit; {End of File} + end end; - end - else - begin - FBOF := false; - result := true; + + ftPrior: + begin + if FBOF then + IBError(ibxeBOF,[nil]); + { Go to the next record... } + fetchResult := FResultSet.fetchPrior(StatusIntf,FSQLRecord.MessageBuffer); + if fetchResult = Firebird.IStatus.RESULT_NO_DATA then + begin + FBOF := true; + FEOF := false; + Exit; {Top of File} + end + end; + + ftFirst: + fetchResult := FResultSet.fetchFirst(StatusIntf,FSQLRecord.MessageBuffer); + + ftLast: + fetchResult := FResultSet.fetchLast(StatusIntf,FSQLRecord.MessageBuffer); + + ftAbsolute: + fetchResult := FResultSet.fetchAbsolute(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer); + + ftRelative: + fetchResult := FResultSet.fetchRelative(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer); end; + + Check4DataBaseError; + if fetchResult <> Firebird.IStatus.RESULT_OK then + exit; {result = false} + + {Result OK} + FBOF := false; + FEOF := false; + result := true; + if FCollectStatistics then begin UtilIntf.getPerfCounters(StatusIntf,