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

Comparing:
ibx/trunk/fbintf/client/3.0/FB30Statement.pas (file contents), Revision 347 by tony, Mon Sep 20 22:08:20 2021 UTC vs.
ibx/branches/udr/client/3.0/FB30Statement.pas (file contents), Revision 370 by tony, Wed Jan 5 14:59:15 2022 UTC

# Line 88 | Line 88 | type
88      FStatement: TFB30Statement;
89      FFirebird30ClientAPI: TFB30ClientAPI;
90      FBlob: IBlob;             {Cache references}
91    FArray: IArray;
91      FNullIndicator: short;
92      FOwnsSQLData: boolean;
93      FBlobMetaData: IBlobMetaData;
# Line 137 | Line 136 | type
136    public
137      constructor Create(aParent: TIBXSQLDA; aIndex: integer);
138      procedure Changed; override;
139 +    procedure InitColumnMetaData(aMetaData: Firebird.IMessageMetadata);
140      procedure ColumnSQLDataInit;
141      procedure RowChange; override;
142      procedure FreeSQLData;
143 <    function GetAsArray(Array_ID: TISC_QUAD): IArray; override;
143 >    function GetAsArray: IArray; override;
144      function GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob; override;
145      function GetArrayMetaData: IArrayMetaData; override;
146      function GetBlobMetaData: IBlobMetaData; override;
# Line 231 | Line 231 | type
231    private
232      FResults: TIBXOUTPUTSQLDA;
233      FCursorSeqNo: integer;
234 +    procedure RowChange;
235    public
236      constructor Create(aResults: TIBXOUTPUTSQLDA);
237      destructor Destroy; override;
238      {IResultSet}
239 <    function FetchNext: boolean;
239 >    function FetchNext: boolean; {fetch next record}
240 >    function FetchPrior: boolean; {fetch previous record}
241 >    function FetchFirst:boolean; {fetch first record}
242 >    function FetchLast: boolean; {fetch last record}
243 >    function FetchAbsolute(position: Integer): boolean; {fetch record by its absolute position in result set}
244 >    function FetchRelative(offset: Integer): boolean; {fetch record by position relative to current}
245      function GetCursorName: AnsiString;
246      function GetTransaction: ITransaction; override;
247 +    function IsBof: boolean;
248      function IsEof: boolean;
249      procedure Close;
250    end;
# Line 259 | Line 266 | type
266      function getUpdated: integer;
267    end;
268  
269 +  TFetchType = (ftNext,ftPrior,ftFirst,ftLast,ftAbsolute,ftRelative);
270 +
271    { TFB30Statement }
272  
273    TFB30Statement = class(TFBStatement,IStatement)
# Line 269 | Line 278 | type
278      FSQLRecord: TIBXOUTPUTSQLDA;
279      FResultSet: Firebird.IResultSet;
280      FCursorSeqNo: integer;
281 +    FCursor: AnsiString;
282      FBatch: Firebird.IBatch;
283      FBatchCompletion: IBatchCompletion;
284      FBatchRowCount: integer;
# Line 279 | Line 289 | type
289      procedure CheckHandle; override;
290      procedure CheckBatchModeAvailable;
291      procedure GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults); override;
292 <    procedure InternalPrepare; override;
292 >    function GetStatementIntf: IStatement; 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 302 | Line 314 | type
314      function GetMetaData: IMetaData; override;
315      function GetPlan: AnsiString;
316      function IsPrepared: boolean;
317 +    function GetFlags: TStatementFlags; override;
318      function CreateBlob(column: TColumnMetaData): IBlob; override;
319      function CreateArray(column: TColumnMetaData): IArray; override;
320      procedure SetRetainInterfaces(aValue: boolean); override;
# Line 450 | Line 463 | begin
463    TIBXSQLDA(Parent).Changed;
464   end;
465  
466 + procedure TIBXSQLVAR.InitColumnMetaData(aMetaData: Firebird.IMessageMetadata);
467 + begin
468 +  with FFirebird30ClientAPI do
469 +  begin
470 +    FSQLType := aMetaData.getType(StatusIntf,Index);
471 +    Check4DataBaseError;
472 +    if FSQLType = SQL_BLOB then
473 +    begin
474 +      FSQLSubType := aMetaData.getSubType(StatusIntf,Index);
475 +      Check4DataBaseError;
476 +    end
477 +    else
478 +      FSQLSubType := 0;
479 +    FDataLength := aMetaData.getLength(StatusIntf,Index);
480 +    Check4DataBaseError;
481 +    FMetadataSize := FDataLength;
482 +    FRelationName := strpas(aMetaData.getRelation(StatusIntf,Index));
483 +    Check4DataBaseError;
484 +    FFieldName := strpas(aMetaData.getField(StatusIntf,Index));
485 +    Check4DataBaseError;
486 +    FNullable := aMetaData.isNullable(StatusIntf,Index);
487 +    Check4DataBaseError;
488 +    FScale := aMetaData.getScale(StatusIntf,Index);
489 +    Check4DataBaseError;
490 +    FCharSetID :=  aMetaData.getCharSet(StatusIntf,Index) and $FF;
491 +    Check4DataBaseError;
492 +  end;
493 + end;
494 +
495   procedure TIBXSQLVAR.ColumnSQLDataInit;
496   begin
497    FreeSQLData;
# Line 708 | Line 750 | procedure TIBXSQLVAR.RowChange;
750   begin
751    inherited;
752    FBlob := nil;
711  FArray := nil;
753   end;
754  
755   procedure TIBXSQLVAR.FreeSQLData;
# Line 719 | Line 760 | begin
760    FOwnsSQLData := true;
761   end;
762  
763 < function TIBXSQLVAR.GetAsArray(Array_ID: TISC_QUAD): IArray;
763 > function TIBXSQLVAR.GetAsArray: IArray;
764   begin
765    if SQLType <> SQL_ARRAY then
766      IBError(ibxeInvalidDataConversion,[nil]);
# Line 728 | Line 769 | begin
769      Result := nil
770    else
771    begin
772 <    if FArray = nil then
773 <      FArray := TFB30Array.Create(FStatement.GetAttachment as TFB30Attachment,
772 >    if FArrayIntf = nil then
773 >      FArrayIntf := TFB30Array.Create(FStatement.GetAttachment as TFB30Attachment,
774                                  TIBXSQLDA(Parent).GetTransaction,
775 <                                GetArrayMetaData,Array_ID);
776 <    Result := FArray;
775 >                                GetArrayMetaData,PISC_QUAD(SQLData)^);
776 >    Result := FArrayIntf;
777    end;
778   end;
779  
# Line 764 | 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 778 | Line 826 | begin
826   end;
827  
828   function TResultSet.FetchNext: boolean;
781 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 >    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 <    for i := 0 to getCount - 1 do
866 <      FResults.Column[i].RowChange;
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]);
793 <  Result := '';
878 >  Result := FResults.FStatement.FCursor;
879   end;
880  
881   function TResultSet.GetTransaction: ITransaction;
# Line 798 | 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 983 | Line 1073 | begin
1073      for i := 0 to Count - 1 do
1074      with TIBXSQLVar(Column[i]) do
1075      begin
1076 <      FSQLType := aMetaData.getType(StatusIntf,i);
1077 <      Check4DataBaseError;
988 <      if FSQLType = SQL_BLOB then
989 <      begin
990 <        FSQLSubType := aMetaData.getSubType(StatusIntf,i);
991 <        Check4DataBaseError;
992 <      end
993 <      else
994 <        FSQLSubType := 0;
995 <      FDataLength := aMetaData.getLength(StatusIntf,i);
996 <      Check4DataBaseError;
997 <      FMetadataSize := FDataLength;
998 <      FNullable := aMetaData.isNullable(StatusIntf,i);
999 <      Check4DataBaseError;
1076 >      InitColumnMetaData(aMetaData);
1077 >      SaveMetaData;
1078        if FNullable then
1079          FSQLNullIndicator := @FNullIndicator
1080        else
1081          FSQLNullIndicator := nil;
1004      FScale := aMetaData.getScale(StatusIntf,i);
1005      Check4DataBaseError;
1006      FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
1007      Check4DataBaseError;
1082        ColumnSQLDataInit;
1083      end;
1084    end;
# Line 1057 | Line 1131 | begin
1131      for i := 0 to Count - 1 do
1132      with TIBXSQLVar(Column[i]) do
1133      begin
1134 <      FSQLType := aMetaData.getType(StatusIntf,i);
1061 <      Check4DataBaseError;
1062 <      if FSQLType = SQL_BLOB then
1063 <      begin
1064 <        FSQLSubType := aMetaData.getSubType(StatusIntf,i);
1065 <        Check4DataBaseError;
1066 <      end
1067 <      else
1068 <        FSQLSubType := 0;
1069 <      FBlob := nil;
1070 <      FArray := nil;
1134 >      InitColumnMetaData(aMetaData);
1135        FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i);
1136        Check4DataBaseError;
1073      FDataLength := aMetaData.getLength(StatusIntf,i);
1074      Check4DataBaseError;
1075      FMetadataSize := FDataLength;
1076      FRelationName := strpas(aMetaData.getRelation(StatusIntf,i));
1077      Check4DataBaseError;
1078      FFieldName := strpas(aMetaData.getField(StatusIntf,i));
1079      Check4DataBaseError;
1080      FNullable := aMetaData.isNullable(StatusIntf,i);
1081      Check4DataBaseError;
1137        if FNullable then
1138        begin
1139          FSQLNullIndicator := PShort(FMessageBuffer + aMetaData.getNullOffset(StatusIntf,i));
# Line 1086 | Line 1141 | begin
1141        end
1142        else
1143          FSQLNullIndicator := nil;
1144 <      FScale := aMetaData.getScale(StatusIntf,i);
1145 <      Check4DataBaseError;
1091 <      FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
1092 <      Check4DataBaseError;
1144 >      FBlob := nil;
1145 >      FArrayIntf := nil;
1146      end;
1147    end;
1148    SetUniqueRelationName;
# Line 1271 | Line 1324 | begin
1324    end;
1325   end;
1326  
1327 < procedure TFB30Statement.InternalPrepare;
1327 > function TFB30Statement.GetStatementIntf: IStatement;
1328 > begin
1329 >  Result := self;
1330 > end;
1331 >
1332 > procedure TFB30Statement.InternalPrepare(CursorName: AnsiString);
1333 > var GUID : TGUID;
1334   begin
1335    if FPrepared then
1336      Exit;
1337 +
1338 +  FCursor := CursorName;
1339    if (FSQL = '') then
1340      IBError(ibxeEmptyQuery, [nil]);
1341    try
1342      CheckTransaction(FTransactionIntf);
1343      with FFirebird30ClientAPI do
1344      begin
1345 +      if FCursor = '' then
1346 +      begin
1347 +        CreateGuid(GUID);
1348 +        FCursor := GUIDToString(GUID);
1349 +      end;
1350 +
1351        if FHasParamNames then
1352        begin
1353          if FProcessedSQL = '' then
# Line 1303 | Line 1370 | begin
1370        FSQLStatementType := TIBSQLStatementTypes(FStatementIntf.getType(StatusIntf));
1371        Check4DataBaseError;
1372  
1373 +      if FSQLStatementType = SQLSelect then
1374 +      begin
1375 +        FStatementIntf.setCursorName(StatusIntf,PAnsiChar(FCursor));
1376 +        Check4DataBaseError;
1377 +      end;
1378        { Done getting the type }
1379        case FSQLStatementType of
1380          SQLGetSegment,
# Line 1340 | Line 1412 | begin
1412      end;
1413    end;
1414    FPrepared := true;
1415 +
1416    FSingleResults := false;
1417    if RetainInterfaces then
1418    begin
# Line 1374 | Line 1447 | function TFB30Statement.InternalExecute(
1447      end;
1448    end;
1449  
1450 + var Cursor: IResultSet;
1451  
1452   begin
1453    Result := nil;
# Line 1399 | Line 1473 | begin
1473      begin
1474        case FSQLStatementType of
1475        SQLSelect:
1476 <        IBError(ibxeIsAExecuteProcedure,[]);
1476 >       {e.g. Update...returning with a single row in Firebird 5 and later}
1477 >      begin
1478 >        Cursor := InternalOpenCursor(aTransaction,false);
1479 >        if not Cursor.IsEof then
1480 >          Cursor.FetchNext;
1481 >        Result := Cursor; {note only first row}
1482 >        FSingleResults := true;
1483 >      end;
1484  
1485        SQLExecProcedure:
1486        begin
# Line 1423 | Line 1504 | begin
1504    Inc(FChangeSeqNo);
1505   end;
1506  
1507 < function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction
1508 <  ): IResultSet;
1507 > function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction;
1508 >  Scrollable: boolean): IResultSet;
1509 > var flags: cardinal;
1510   begin
1511 <  if FSQLStatementType <> SQLSelect then
1511 >  flags := 0;
1512 >  if (FSQLStatementType <> SQLSelect) and not (stHasCursor in getFlags) then
1513     IBError(ibxeIsASelectStatement,[]);
1514  
1515    FBatchCompletion := nil;
# Line 1439 | Line 1522 | begin
1522    if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1523      IBError(ibxeInterfaceOutofDate,[nil]);
1524  
1525 + if Scrollable then
1526 +   flags := Firebird.IStatement.CURSOR_TYPE_SCROLLABLE;
1527 +
1528   with FFirebird30ClientAPI do
1529   begin
1530     if FCollectStatistics then
# Line 1454 | Line 1540 | begin
1540                            FSQLParams.MetaData,
1541                            FSQLParams.MessageBuffer,
1542                            FSQLRecord.MetaData,
1543 <                          0);
1543 >                          flags);
1544     Check4DataBaseError;
1545  
1546     if FCollectStatistics then
# Line 1500 | Line 1586 | begin
1586      FStatementIntf := nil;
1587      FPrepared := false;
1588    end;
1589 +  FCursor := '';
1590   end;
1591  
1592   procedure TFB30Statement.InternalClose(Force: boolean);
# Line 1545 | Line 1632 | begin
1632   end;
1633  
1634   constructor TFB30Statement.Create(Attachment: TFB30Attachment;
1635 <  Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1635 >  Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1636 >  CursorName: AnsiString);
1637   begin
1638    inherited Create(Attachment,Transaction,sql,aSQLDialect);
1639    FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1640    FSQLParams := TIBXINPUTSQLDA.Create(self);
1641    FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1642 <  InternalPrepare;
1642 >  InternalPrepare(CursorName);
1643   end;
1644  
1645   constructor TFB30Statement.CreateWithParameterNames(
1646    Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString;
1647    aSQLDialect: integer; GenerateParamNames: boolean;
1648 <  CaseSensitiveParams: boolean);
1648 >  CaseSensitiveParams: boolean; CursorName: AnsiString);
1649   begin
1650    inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1651    FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1652    FSQLParams := TIBXINPUTSQLDA.Create(self);
1653    FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1654    FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1655 <  InternalPrepare;
1655 >  InternalPrepare(CursorName);
1656   end;
1657  
1658   destructor TFB30Statement.Destroy;
# Line 1574 | Line 1662 | begin
1662    if assigned(FSQLRecord) then FSQLRecord.Free;
1663   end;
1664  
1665 < function TFB30Statement.FetchNext: boolean;
1665 > function TFB30Statement.Fetch(FetchType: TFetchType; PosOrOffset: integer
1666 >  ): boolean;
1667   var fetchResult: integer;
1668   begin
1669    result := false;
1670    if not FOpen then
1671      IBError(ibxeSQLClosed, [nil]);
1583  if FEOF then
1584    IBError(ibxeEOF,[nil]);
1672  
1673    with FFirebird30ClientAPI do
1674    begin
1675 <    { Go to the next record... }
1676 <    fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1677 <    if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1678 <    begin
1679 <      FBOF := false;
1680 <      FEOF := true;
1681 <      Exit; {End of File}
1682 <    end
1683 <    else
1684 <    if fetchResult <> Firebird.IStatus.RESULT_OK then
1685 <    begin
1686 <      try
1687 <        IBDataBaseError;
1601 <      except
1602 <        Close;
1603 <        raise;
1675 >    case FetchType of
1676 >    ftNext:
1677 >      begin
1678 >        if FEOF then
1679 >          IBError(ibxeEOF,[nil]);
1680 >        { Go to the next record... }
1681 >        fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1682 >        if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1683 >        begin
1684 >          FBOF := false;
1685 >          FEOF := true;
1686 >          Exit; {End of File}
1687 >        end
1688        end;
1689 <    end
1690 <    else
1691 <    begin
1692 <      FBOF := false;
1693 <      result := true;
1689 >
1690 >    ftPrior:
1691 >      begin
1692 >        if FBOF then
1693 >          IBError(ibxeBOF,[nil]);
1694 >        { Go to the next record... }
1695 >        fetchResult := FResultSet.fetchPrior(StatusIntf,FSQLRecord.MessageBuffer);
1696 >        if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1697 >        begin
1698 >          FBOF := true;
1699 >          FEOF := false;
1700 >          Exit; {Top of File}
1701 >        end
1702 >      end;
1703 >
1704 >    ftFirst:
1705 >      fetchResult := FResultSet.fetchFirst(StatusIntf,FSQLRecord.MessageBuffer);
1706 >
1707 >    ftLast:
1708 >      fetchResult := FResultSet.fetchLast(StatusIntf,FSQLRecord.MessageBuffer);
1709 >
1710 >    ftAbsolute:
1711 >      fetchResult := FResultSet.fetchAbsolute(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1712 >
1713 >    ftRelative:
1714 >      fetchResult := FResultSet.fetchRelative(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1715      end;
1716 +
1717 +    Check4DataBaseError;
1718 +    if fetchResult <> Firebird.IStatus.RESULT_OK then
1719 +      exit; {result = false}
1720 +
1721 +    {Result OK}
1722 +    FBOF := false;
1723 +    FEOF := false;
1724 +    result := true;
1725 +
1726      if FCollectStatistics then
1727      begin
1728        UtilIntf.getPerfCounters(StatusIntf,
# Line 1799 | Line 1914 | begin
1914    Result := FStatementIntf <> nil;
1915   end;
1916  
1917 + function TFB30Statement.GetFlags: TStatementFlags;
1918 + var flags: cardinal;
1919 + begin
1920 +  CheckHandle;
1921 +  Result := [];
1922 +  with FFirebird30ClientAPI do
1923 +  begin
1924 +    flags := FStatementIntf.getFlags(StatusIntf);
1925 +    Check4DataBaseError;
1926 +  end;
1927 +  if flags and Firebird.IStatement.FLAG_HAS_CURSOR <> 0 then
1928 +    Result := Result + [stHasCursor];
1929 +  if flags and Firebird.IStatement.FLAG_REPEAT_EXECUTE <> 0 then
1930 +    Result := Result + [stRepeatExecute];
1931 +  if flags and Firebird.IStatement.CURSOR_TYPE_SCROLLABLE <> 0 then
1932 +    Result := Result + [stScrollable];
1933 + end;
1934 +
1935   end.
1936  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines