ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/3.0/FB30Statement.pas
(Generate patch)

Comparing ibx/trunk/fbintf/client/3.0/FB30Statement.pas (file contents):
Revision 349 by tony, Mon Oct 18 08:39:40 2021 UTC vs.
Revision 350 by tony, Wed Oct 20 14:58:56 2021 UTC

# Line 232 | Line 232 | type
232    private
233      FResults: TIBXOUTPUTSQLDA;
234      FCursorSeqNo: integer;
235 +    procedure RowChange;
236    public
237      constructor Create(aResults: TIBXOUTPUTSQLDA);
238      destructor Destroy; override;
239      {IResultSet}
240 <    function FetchNext: boolean;
240 >    function FetchNext: boolean; {fetch next record}
241 >    function FetchPrior: boolean; {fetch previous record}
242 >    function FetchFirst:boolean; {fetch first record}
243 >    function FetchLast: boolean; {fetch last record}
244 >    function FetchAbsolute(position: Integer): boolean; {fetch record by its absolute position in result set}
245 >    function FetchRelative(offset: Integer): boolean; {fetch record by position relative to current}
246      function GetCursorName: AnsiString;
247      function GetTransaction: ITransaction; override;
248 +    function IsBof: boolean;
249      function IsEof: boolean;
250      procedure Close;
251    end;
# Line 260 | Line 267 | type
267      function getUpdated: integer;
268    end;
269  
270 +  TFetchType = (ftNext,ftPrior,ftFirst,ftLast,ftAbsolute,ftRelative);
271 +
272    { TFB30Statement }
273  
274    TFB30Statement = class(TFBStatement,IStatement)
# Line 270 | Line 279 | type
279      FSQLRecord: TIBXOUTPUTSQLDA;
280      FResultSet: Firebird.IResultSet;
281      FCursorSeqNo: integer;
282 +    FCursor: AnsiString;
283      FBatch: Firebird.IBatch;
284      FBatchCompletion: IBatchCompletion;
285      FBatchRowCount: integer;
# Line 280 | Line 290 | type
290      procedure CheckHandle; override;
291      procedure CheckBatchModeAvailable;
292      procedure GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults); override;
293 <    procedure InternalPrepare; override;
293 >    procedure InternalPrepare(CursorName: AnsiString=''); override;
294      function InternalExecute(aTransaction: ITransaction): IResults; override;
295 <    function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override;
295 >    function InternalOpenCursor(aTransaction: ITransaction; Scrollable: boolean
296 >      ): IResultSet; override;
297      procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override;
298      procedure FreeHandle; override;
299      procedure InternalClose(Force: boolean); override;
300      function SavePerfStats(var Stats: TPerfStatistics): boolean;
301    public
302      constructor Create(Attachment: TFB30Attachment; Transaction: ITransaction;
303 <      sql: AnsiString; aSQLDialect: integer);
303 >      sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString='');
304      constructor CreateWithParameterNames(Attachment: TFB30Attachment; Transaction: ITransaction;
305        sql: AnsiString;  aSQLDialect: integer; GenerateParamNames: boolean =false;
306 <      CaseSensitiveParams: boolean=false);
306 >      CaseSensitiveParams: boolean=false; CursorName: AnsiString='');
307      destructor Destroy; override;
308 <    function FetchNext: boolean;
308 >    function Fetch(FetchType: TFetchType; PosOrOffset: integer=0): boolean;
309      property StatementIntf: Firebird.IStatement read FStatementIntf;
310  
311    public
# Line 794 | Line 805 | end;
805  
806   { TResultSet }
807  
808 + procedure TResultSet.RowChange;
809 + var i: integer;
810 + begin
811 +  for i := 0 to getCount - 1 do
812 +    FResults.Column[i].RowChange;
813 + end;
814 +
815   constructor TResultSet.Create(aResults: TIBXOUTPUTSQLDA);
816   begin
817    inherited Create(aResults);
# Line 808 | Line 826 | begin
826   end;
827  
828   function TResultSet.FetchNext: boolean;
811 – var i: integer;
829   begin
830    CheckActive;
831 <  Result := FResults.FStatement.FetchNext;
831 >  Result := FResults.FStatement.Fetch(ftNext);
832 >  if Result then
833 >    RowChange;
834 > end;
835 >
836 > function TResultSet.FetchPrior: boolean;
837 > begin
838 >  CheckActive;
839 >  Result := FResults.FStatement.Fetch(ftPrior);
840    if Result then
841 <    for i := 0 to getCount - 1 do
842 <      FResults.Column[i].RowChange;
841 >    RowChange;
842 > end;
843 >
844 > function TResultSet.FetchFirst: boolean;
845 > begin
846 >  CheckActive;
847 >  Result := FResults.FStatement.Fetch(ftFirst);
848 >  if Result then
849 >    RowChange;
850 > end;
851 >
852 > function TResultSet.FetchLast: boolean;
853 > begin
854 >  CheckActive;
855 >  Result := FResults.FStatement.Fetch(ftLast);
856 >  if Result then
857 >    RowChange;
858 > end;
859 >
860 > function TResultSet.FetchAbsolute(position: Integer): boolean;
861 > begin
862 >  CheckActive;
863 >  Result := FResults.FStatement.Fetch(ftAbsolute,position);
864 >  if Result then
865 >    RowChange;
866 > end;
867 >
868 > function TResultSet.FetchRelative(offset: Integer): boolean;
869 > begin
870 >  CheckActive;
871 >  Result := FResults.FStatement.Fetch(ftRelative,offset);
872 >  if Result then
873 >    RowChange;
874   end;
875  
876   function TResultSet.GetCursorName: AnsiString;
877   begin
878 <  IBError(ibxeNotSupported,[nil]);
823 <  Result := '';
878 >  Result := FResults.FStatement.FCursor;
879   end;
880  
881   function TResultSet.GetTransaction: ITransaction;
# Line 828 | Line 883 | begin
883    Result := FResults.FTransaction;
884   end;
885  
886 + function TResultSet.IsBof: boolean;
887 + begin
888 +  Result := FResults.FStatement.FBof;
889 + end;
890 +
891   function TResultSet.IsEof: boolean;
892   begin
893    Result := FResults.FStatement.FEof;
# Line 1264 | Line 1324 | begin
1324    end;
1325   end;
1326  
1327 < procedure TFB30Statement.InternalPrepare;
1327 > procedure TFB30Statement.InternalPrepare(CursorName: AnsiString);
1328 > var GUID : TGUID;
1329   begin
1330    if FPrepared then
1331      Exit;
1332 +
1333 +  FCursor := CursorName;
1334    if (FSQL = '') then
1335      IBError(ibxeEmptyQuery, [nil]);
1336    try
1337      CheckTransaction(FTransactionIntf);
1338      with FFirebird30ClientAPI do
1339      begin
1340 +      if FCursor = '' then
1341 +      begin
1342 +        CreateGuid(GUID);
1343 +        FCursor := GUIDToString(GUID);
1344 +      end;
1345 +
1346        if FHasParamNames then
1347        begin
1348          if FProcessedSQL = '' then
# Line 1296 | Line 1365 | begin
1365        FSQLStatementType := TIBSQLStatementTypes(FStatementIntf.getType(StatusIntf));
1366        Check4DataBaseError;
1367  
1368 +      if FSQLStatementType = SQLSelect then
1369 +      begin
1370 +        FStatementIntf.setCursorName(StatusIntf,PAnsiChar(FCursor));
1371 +        Check4DataBaseError;
1372 +      end;
1373        { Done getting the type }
1374        case FSQLStatementType of
1375          SQLGetSegment,
# Line 1333 | Line 1407 | begin
1407      end;
1408    end;
1409    FPrepared := true;
1410 +
1411    FSingleResults := false;
1412    if RetainInterfaces then
1413    begin
# Line 1416 | Line 1491 | begin
1491    Inc(FChangeSeqNo);
1492   end;
1493  
1494 < function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction
1495 <  ): IResultSet;
1494 > function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction;
1495 >  Scrollable: boolean): IResultSet;
1496 > var flags: cardinal;
1497   begin
1498 +  flags := 0;
1499    if FSQLStatementType <> SQLSelect then
1500     IBError(ibxeIsASelectStatement,[]);
1501  
# Line 1432 | Line 1509 | begin
1509    if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1510      IBError(ibxeInterfaceOutofDate,[nil]);
1511  
1512 + if Scrollable then
1513 +   flags := Firebird.IStatement.CURSOR_TYPE_SCROLLABLE;
1514 +
1515   with FFirebird30ClientAPI do
1516   begin
1517     if FCollectStatistics then
# Line 1447 | Line 1527 | begin
1527                            FSQLParams.MetaData,
1528                            FSQLParams.MessageBuffer,
1529                            FSQLRecord.MetaData,
1530 <                          0);
1530 >                          flags);
1531     Check4DataBaseError;
1532  
1533     if FCollectStatistics then
# Line 1493 | Line 1573 | begin
1573      FStatementIntf := nil;
1574      FPrepared := false;
1575    end;
1576 +  FCursor := '';
1577   end;
1578  
1579   procedure TFB30Statement.InternalClose(Force: boolean);
# Line 1538 | Line 1619 | begin
1619   end;
1620  
1621   constructor TFB30Statement.Create(Attachment: TFB30Attachment;
1622 <  Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1622 >  Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1623 >  CursorName: AnsiString);
1624   begin
1625    inherited Create(Attachment,Transaction,sql,aSQLDialect);
1626    FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1627    FSQLParams := TIBXINPUTSQLDA.Create(self);
1628    FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1629 <  InternalPrepare;
1629 >  InternalPrepare(CursorName);
1630   end;
1631  
1632   constructor TFB30Statement.CreateWithParameterNames(
1633    Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString;
1634    aSQLDialect: integer; GenerateParamNames: boolean;
1635 <  CaseSensitiveParams: boolean);
1635 >  CaseSensitiveParams: boolean; CursorName: AnsiString);
1636   begin
1637    inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1638    FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1639    FSQLParams := TIBXINPUTSQLDA.Create(self);
1640    FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1641    FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1642 <  InternalPrepare;
1642 >  InternalPrepare(CursorName);
1643   end;
1644  
1645   destructor TFB30Statement.Destroy;
# Line 1567 | Line 1649 | begin
1649    if assigned(FSQLRecord) then FSQLRecord.Free;
1650   end;
1651  
1652 < function TFB30Statement.FetchNext: boolean;
1652 > function TFB30Statement.Fetch(FetchType: TFetchType; PosOrOffset: integer
1653 >  ): boolean;
1654   var fetchResult: integer;
1655   begin
1656    result := false;
1657    if not FOpen then
1658      IBError(ibxeSQLClosed, [nil]);
1576 –  if FEOF then
1577 –    IBError(ibxeEOF,[nil]);
1659  
1660    with FFirebird30ClientAPI do
1661    begin
1662 <    { Go to the next record... }
1663 <    fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1664 <    if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1665 <    begin
1666 <      FBOF := false;
1667 <      FEOF := true;
1668 <      Exit; {End of File}
1669 <    end
1670 <    else
1671 <    if fetchResult <> Firebird.IStatus.RESULT_OK then
1672 <    begin
1673 <      try
1674 <        IBDataBaseError;
1594 <      except
1595 <        Close;
1596 <        raise;
1662 >    case FetchType of
1663 >    ftNext:
1664 >      begin
1665 >        if FEOF then
1666 >          IBError(ibxeEOF,[nil]);
1667 >        { Go to the next record... }
1668 >        fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1669 >        if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1670 >        begin
1671 >          FBOF := false;
1672 >          FEOF := true;
1673 >          Exit; {End of File}
1674 >        end
1675        end;
1676 <    end
1677 <    else
1678 <    begin
1679 <      FBOF := false;
1680 <      result := true;
1676 >
1677 >    ftPrior:
1678 >      begin
1679 >        if FBOF then
1680 >          IBError(ibxeBOF,[nil]);
1681 >        { Go to the next record... }
1682 >        fetchResult := FResultSet.fetchPrior(StatusIntf,FSQLRecord.MessageBuffer);
1683 >        if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1684 >        begin
1685 >          FBOF := true;
1686 >          FEOF := false;
1687 >          Exit; {Top of File}
1688 >        end
1689 >      end;
1690 >
1691 >    ftFirst:
1692 >      fetchResult := FResultSet.fetchFirst(StatusIntf,FSQLRecord.MessageBuffer);
1693 >
1694 >    ftLast:
1695 >      fetchResult := FResultSet.fetchLast(StatusIntf,FSQLRecord.MessageBuffer);
1696 >
1697 >    ftAbsolute:
1698 >      fetchResult := FResultSet.fetchAbsolute(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1699 >
1700 >    ftRelative:
1701 >      fetchResult := FResultSet.fetchRelative(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1702      end;
1703 +
1704 +    Check4DataBaseError;
1705 +    if fetchResult <> Firebird.IStatus.RESULT_OK then
1706 +      exit; {result = false}
1707 +
1708 +    {Result OK}
1709 +    FBOF := false;
1710 +    FEOF := false;
1711 +    result := true;
1712 +
1713      if FCollectStatistics then
1714      begin
1715        UtilIntf.getPerfCounters(StatusIntf,

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines