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 371 by tony, Wed Jan 5 15:21:22 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 99 | Line 98 | type
98      FSQLSubType: integer;
99      FSQLData: PByte; {Address of SQL Data in Message Buffer}
100      FSQLNullIndicator: PShort; {Address of null indicator}
101 <    FDataLength: integer;
102 <    FMetadataSize: integer;
101 >    FDataLength: cardinal;
102 >    FMetadataSize: cardinal;
103      FNullable: boolean;
104      FScale: integer;
105      FCharSetID: cardinal;
# Line 117 | Line 116 | type
116       function GetRelationName: AnsiString;  override;
117       function GetScale: integer; override;
118       function GetCharSetID: cardinal; override;
120     function GetCodePage: TSystemCodePage; override;
121     function GetCharSetWidth: integer; override;
119       function GetIsNull: Boolean;   override;
120       function GetIsNullable: boolean; override;
121       function GetSQLData: PByte;  override;
122       function GetDataLength: cardinal; override;
123       function GetSize: cardinal; override;
127     function GetAttachment: IAttachment; override;
124       function GetDefaultTextSQLType: cardinal; override;
125       procedure SetIsNull(Value: Boolean); override;
126       procedure SetIsNullable(Value: Boolean);  override;
127 <     procedure SetSQLData(AValue: PByte; len: cardinal); override;
128 <     procedure SetScale(aValue: integer); override;
129 <     procedure SetDataLength(len: cardinal); override;
134 <     procedure SetSQLType(aValue: cardinal); override;
127 >     procedure InternalSetScale(aValue: integer); override;
128 >     procedure InternalSetDataLength(len: cardinal); override;
129 >     procedure InternalSetSQLType(aValue: cardinal); override;
130       procedure SetCharSetID(aValue: cardinal); override;
131       procedure SetMetaSize(aValue: cardinal); override;
132    public
133      constructor Create(aParent: TIBXSQLDA; aIndex: integer);
134      procedure Changed; override;
135 +    procedure InitColumnMetaData(aMetaData: Firebird.IMessageMetadata);
136      procedure ColumnSQLDataInit;
137      procedure RowChange; override;
138      procedure FreeSQLData;
139 <    function GetAsArray(Array_ID: TISC_QUAD): IArray; override;
139 >    function GetAsArray: IArray; override;
140      function GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob; override;
141      function GetArrayMetaData: IArrayMetaData; override;
142      function GetBlobMetaData: IBlobMetaData; override;
143      function CreateBlob: IBlob; override;
144 +    procedure SetSQLData(AValue: PByte; len: cardinal); override;
145    end;
146  
147    { TIBXSQLDA }
# Line 158 | Line 155 | type
155   protected
156      FStatement: TFB30Statement;
157      FFirebird30ClientAPI: TFB30ClientAPI;
158 +    FMessageBuffer: PByte; {Message Buffer}
159 +    FMsgLength: integer; {Message Buffer length}
160      function GetTransactionSeqNo: integer; override;
161      procedure FreeXSQLDA; virtual;
162      function GetStatement: IStatement; override;
163      function GetPrepareSeqNo: integer; override;
164      procedure SetCount(Value: Integer); override;
165 +    procedure AllocMessageBuffer(len: integer); virtual;
166 +    procedure FreeMessageBuffer; virtual;
167    public
168 <    constructor Create(aStatement: TFB30Statement);
168 >    constructor Create(aStatement: TFB30Statement); overload;
169 >    constructor Create(api: IFirebirdAPI); overload;
170      destructor Destroy; override;
171      procedure Changed; virtual;
172      function CheckStatementStatus(Request: TStatementStatus): boolean; override;
173      function ColumnsInUseCount: integer; override;
174 <    function GetTransaction: TFB30Transaction; virtual;
174 >    function GetMetaData: Firebird.IMessageMetadata; virtual;
175      procedure Initialize; override;
176      function StateChanged(var ChangeSeqNo: integer): boolean; override;
177      function CanChangeMetaData: boolean; override;
176    property MetaData: Firebird.IMessageMetadata read FMetaData;
178      property Count: Integer read FCount write SetCount;
179      property Statement: TFB30Statement read FStatement;
180    end;
# Line 182 | Line 183 | type
183  
184    TIBXINPUTSQLDA = class(TIBXSQLDA)
185    private
185    FMessageBuffer: PByte; {Message Buffer}
186    FMsgLength: integer; {Message Buffer length}
186      FCurMetaData: Firebird.IMessageMetadata;
188    procedure FreeMessageBuffer;
187      procedure FreeCurMetaData;
188      function GetMessageBuffer: PByte;
191    function GetMetaData: Firebird.IMessageMetadata;
189      function GetModified: Boolean;
190      function GetMsgLength: integer;
191      procedure BuildMetadata;
195    procedure PackBuffer;
192    protected
193 +    procedure PackBuffer;
194      procedure FreeXSQLDA; override;
195    public
196 <    constructor Create(aStatement: TFB30Statement);
196 >    constructor Create(aStatement: TFB30Statement); overload;
197 >    constructor Create(api: IFirebirdAPI); overload;
198      destructor Destroy; override;
199      procedure Bind(aMetaData: Firebird.IMessageMetadata);
200      procedure Changed; override;
201 +    function GetMetaData: Firebird.IMessageMetadata; override;
202      procedure ReInitialise;
203      function IsInputDataArea: boolean; override;
205    property MetaData: Firebird.IMessageMetadata read GetMetaData;
204      property MessageBuffer: PByte read GetMessageBuffer;
205      property MsgLength: integer read GetMsgLength;
206    end;
# Line 212 | Line 210 | type
210    TIBXOUTPUTSQLDA = class(TIBXSQLDA)
211    private
212      FTransaction: TFB30Transaction; {transaction used to execute the statement}
215    FMessageBuffer: PByte; {Message Buffer}
216    FMsgLength: integer; {Message Buffer length}
213    protected
214 <    procedure FreeXSQLDA; override;
214 >    function GetTransaction: ITransaction; override;
215    public
216      procedure Bind(aMetaData: Firebird.IMessageMetadata);
217      procedure GetData(index: integer; var aIsNull: boolean; var len: short;
# Line 231 | Line 227 | type
227    private
228      FResults: TIBXOUTPUTSQLDA;
229      FCursorSeqNo: integer;
230 +    procedure RowChange;
231    public
232      constructor Create(aResults: TIBXOUTPUTSQLDA);
233      destructor Destroy; override;
234      {IResultSet}
235 <    function FetchNext: boolean;
235 >    function FetchNext: boolean; {fetch next record}
236 >    function FetchPrior: boolean; {fetch previous record}
237 >    function FetchFirst:boolean; {fetch first record}
238 >    function FetchLast: boolean; {fetch last record}
239 >    function FetchAbsolute(position: Integer): boolean; {fetch record by its absolute position in result set}
240 >    function FetchRelative(offset: Integer): boolean; {fetch record by position relative to current}
241      function GetCursorName: AnsiString;
242 <    function GetTransaction: ITransaction; override;
242 >    function IsBof: boolean;
243      function IsEof: boolean;
244      procedure Close;
245    end;
# Line 259 | Line 261 | type
261      function getUpdated: integer;
262    end;
263  
264 +  TFetchType = (ftNext,ftPrior,ftFirst,ftLast,ftAbsolute,ftRelative);
265 +
266    { TFB30Statement }
267  
268    TFB30Statement = class(TFBStatement,IStatement)
# Line 269 | Line 273 | type
273      FSQLRecord: TIBXOUTPUTSQLDA;
274      FResultSet: Firebird.IResultSet;
275      FCursorSeqNo: integer;
276 +    FCursor: AnsiString;
277      FBatch: Firebird.IBatch;
278      FBatchCompletion: IBatchCompletion;
279      FBatchRowCount: integer;
# Line 279 | Line 284 | type
284      procedure CheckHandle; override;
285      procedure CheckBatchModeAvailable;
286      procedure GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults); override;
287 <    procedure InternalPrepare; override;
287 >    function GetStatementIntf: IStatement; override;
288 >    procedure InternalPrepare(CursorName: AnsiString=''); override;
289      function InternalExecute(aTransaction: ITransaction): IResults; override;
290 <    function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override;
290 >    function InternalOpenCursor(aTransaction: ITransaction; Scrollable: boolean
291 >      ): IResultSet; override;
292      procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override;
293      procedure FreeHandle; override;
294      procedure InternalClose(Force: boolean); override;
295      function SavePerfStats(var Stats: TPerfStatistics): boolean;
296    public
297      constructor Create(Attachment: TFB30Attachment; Transaction: ITransaction;
298 <      sql: AnsiString; aSQLDialect: integer);
298 >      sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString='');
299      constructor CreateWithParameterNames(Attachment: TFB30Attachment; Transaction: ITransaction;
300        sql: AnsiString;  aSQLDialect: integer; GenerateParamNames: boolean =false;
301 <      CaseSensitiveParams: boolean=false);
301 >      CaseSensitiveParams: boolean=false; CursorName: AnsiString='');
302      destructor Destroy; override;
303 <    function FetchNext: boolean;
303 >    function Fetch(FetchType: TFetchType; PosOrOffset: integer=0): boolean;
304      property StatementIntf: Firebird.IStatement read FStatementIntf;
305 +    property SQLParams: TIBXINPUTSQLDA read FSQLParams;
306 +    property SQLRecord: TIBXOUTPUTSQLDA read FSQLRecord;
307  
308    public
309      {IStatement}
# Line 302 | Line 311 | type
311      function GetMetaData: IMetaData; override;
312      function GetPlan: AnsiString;
313      function IsPrepared: boolean;
314 +    function GetFlags: TStatementFlags; override;
315      function CreateBlob(column: TColumnMetaData): IBlob; override;
316      function CreateArray(column: TColumnMetaData): IArray; override;
317      procedure SetRetainInterfaces(aValue: boolean); override;
# Line 418 | Line 428 | begin
428      status := MasterIntf.getStatus;
429      FCompletionState.getStatus(StatusIntf,status,updateNo);
430      Check4DataBaseError;
431 <    Result := FormatFBStatus(status);
431 >    Result := FormatStatus(status);
432    end;
433   end;
434  
# Line 450 | Line 460 | begin
460    TIBXSQLDA(Parent).Changed;
461   end;
462  
463 + procedure TIBXSQLVAR.InitColumnMetaData(aMetaData: Firebird.IMessageMetadata);
464 + begin
465 +  with FFirebird30ClientAPI do
466 +  begin
467 +    FSQLType := aMetaData.getType(StatusIntf,Index);
468 +    Check4DataBaseError;
469 +    if FSQLType = SQL_BLOB then
470 +    begin
471 +      FSQLSubType := aMetaData.getSubType(StatusIntf,Index);
472 +      Check4DataBaseError;
473 +    end
474 +    else
475 +      FSQLSubType := 0;
476 +    FDataLength := aMetaData.getLength(StatusIntf,Index);
477 +    Check4DataBaseError;
478 +    FMetadataSize := FDataLength;
479 +    FRelationName := strpas(aMetaData.getRelation(StatusIntf,Index));
480 +    Check4DataBaseError;
481 +    FFieldName := strpas(aMetaData.getField(StatusIntf,Index));
482 +    Check4DataBaseError;
483 +    FNullable := aMetaData.isNullable(StatusIntf,Index);
484 +    Check4DataBaseError;
485 +    FScale := aMetaData.getScale(StatusIntf,Index);
486 +    Check4DataBaseError;
487 +    FCharSetID :=  aMetaData.getCharSet(StatusIntf,Index) and $FF;
488 +    Check4DataBaseError;
489 +  end;
490 + end;
491 +
492   procedure TIBXSQLVAR.ColumnSQLDataInit;
493   begin
494    FreeSQLData;
# Line 495 | Line 534 | begin
534   end;
535  
536   function TIBXSQLVAR.GetAliasName: AnsiString;
537 + var metadata: Firebird.IMessageMetadata;
538   begin
539 <  with FFirebird30ClientAPI do
540 <  begin
541 <    result := strpas(TIBXSQLDA(Parent).MetaData.getAlias(StatusIntf,Index));
542 <    Check4DataBaseError;
539 >  metadata := TIBXSQLDA(Parent).GetMetaData;
540 >  try
541 >    with FFirebird30ClientAPI do
542 >    begin
543 >      result := strpas(metaData.getAlias(StatusIntf,Index));
544 >      Check4DataBaseError;
545 >    end;
546 >  finally
547 >    metadata.release;
548    end;
549   end;
550  
# Line 509 | Line 554 | begin
554   end;
555  
556   function TIBXSQLVAR.GetOwnerName: AnsiString;
557 + var metadata: Firebird.IMessageMetadata;
558   begin
559 <  with FFirebird30ClientAPI do
560 <  begin
561 <    result := strpas(TIBXSQLDA(Parent).MetaData.getOwner(StatusIntf,Index));
562 <    Check4DataBaseError;
559 >  metadata := TIBXSQLDA(Parent).GetMetaData;
560 >  try
561 >    with FFirebird30ClientAPI do
562 >    begin
563 >      result := strpas(metaData.getOwner(StatusIntf,Index));
564 >      Check4DataBaseError;
565 >    end;
566 >  finally
567 >    metadata.release;
568    end;
569   end;
570  
# Line 548 | Line 599 | begin
599    end;
600   end;
601  
551 function TIBXSQLVAR.GetCodePage: TSystemCodePage;
552 begin
553  result := CP_NONE;
554  with Statement.GetAttachment do
555     CharSetID2CodePage(GetCharSetID,result);
556 end;
557
558 function TIBXSQLVAR.GetCharSetWidth: integer;
559 begin
560  result := 1;
561  with Statement.GetAttachment DO
562    CharSetWidth(GetCharSetID,result);
563 end;
564
602   function TIBXSQLVAR.GetIsNull: Boolean;
603   begin
604    Result := IsNullable and (FSQLNullIndicator^ = -1);
# Line 587 | Line 624 | begin
624    Result := FMetadataSize;
625   end;
626  
590 function TIBXSQLVAR.GetAttachment: IAttachment;
591 begin
592  Result := FStatement.GetAttachment;
593 end;
594
627   function TIBXSQLVAR.GetArrayMetaData: IArrayMetaData;
628   begin
629    if GetSQLType <> SQL_ARRAY then
630      IBError(ibxeInvalidDataConversion,[nil]);
631  
632    if FArrayMetaData = nil then
633 <    FArrayMetaData := TFB30ArrayMetaData.Create(FStatement.GetAttachment as TFB30Attachment,
634 <                FStatement.GetTransaction as TFB30Transaction,
633 >    FArrayMetaData := TFB30ArrayMetaData.Create(GetAttachment as TFB30Attachment,
634 >                GetTransaction as TFB30Transaction,
635                  GetRelationName,GetFieldName);
636    Result := FArrayMetaData;
637   end;
# Line 610 | Line 642 | begin
642      IBError(ibxeInvalidDataConversion,[nil]);
643  
644    if FBlobMetaData = nil then
645 <    FBlobMetaData := TFB30BlobMetaData.Create(FStatement.GetAttachment as TFB30Attachment,
646 <              FStatement.GetTransaction as TFB30Transaction,
645 >    FBlobMetaData := TFB30BlobMetaData.Create(GetAttachment as TFB30Attachment,
646 >              GetTransaction as TFB30Transaction,
647                GetRelationName,GetFieldName,
648                GetSubType);
649    (FBlobMetaData as TFBBlobMetaData).SetCharSetID(GetCharSetID);
# Line 654 | Line 686 | begin
686    Changed;
687   end;
688  
689 < procedure TIBXSQLVAR.SetScale(aValue: integer);
689 > procedure TIBXSQLVAR.InternalSetScale(aValue: integer);
690   begin
691    FScale := aValue;
692    Changed;
693   end;
694  
695 < procedure TIBXSQLVAR.SetDataLength(len: cardinal);
695 > procedure TIBXSQLVAR.InternalSetDataLength(len: cardinal);
696   begin
697    if not FOwnsSQLData then
698      FSQLData := nil;
# Line 671 | Line 703 | begin
703    Changed;
704   end;
705  
706 < procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
706 > procedure TIBXSQLVAR.InternalSetSQLType(aValue: cardinal);
707   begin
676  if (FSQLType <> aValue) and not CanChangeSQLType then
677    IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(FSQLType),TSQLDataItem.GetSQLTypeName(aValue)]);
708    FSQLType := aValue;
709    Changed;
710   end;
# Line 708 | Line 738 | procedure TIBXSQLVAR.RowChange;
738   begin
739    inherited;
740    FBlob := nil;
711  FArray := nil;
741   end;
742  
743   procedure TIBXSQLVAR.FreeSQLData;
# Line 719 | Line 748 | begin
748    FOwnsSQLData := true;
749   end;
750  
751 < function TIBXSQLVAR.GetAsArray(Array_ID: TISC_QUAD): IArray;
751 > function TIBXSQLVAR.GetAsArray: IArray;
752   begin
753    if SQLType <> SQL_ARRAY then
754      IBError(ibxeInvalidDataConversion,[nil]);
# Line 728 | Line 757 | begin
757      Result := nil
758    else
759    begin
760 <    if FArray = nil then
761 <      FArray := TFB30Array.Create(FStatement.GetAttachment as TFB30Attachment,
762 <                                TIBXSQLDA(Parent).GetTransaction,
763 <                                GetArrayMetaData,Array_ID);
764 <    Result := FArray;
760 >    if FArrayIntf = nil then
761 >      FArrayIntf := TFB30Array.Create(GetAttachment as TFB30Attachment,
762 >                                GetTransaction as TFB30Transaction,
763 >                                GetArrayMetaData,PISC_QUAD(SQLData)^);
764 >    Result := FArrayIntf;
765    end;
766   end;
767  
# Line 747 | Line 776 | begin
776      if IsNull then
777        Result := nil
778      else
779 <      Result := TFB30Blob.Create(FStatement.GetAttachment as TFB30Attachment,
780 <                               TIBXSQLDA(Parent).GetTransaction,
779 >      Result := TFB30Blob.Create(GetAttachment as TFB30Attachment,
780 >                               GetTransaction as TFB30Transaction,
781                                 GetBlobMetaData,
782                                 Blob_ID,BPB);
783      FBlob := Result;
# Line 757 | Line 786 | end;
786  
787   function TIBXSQLVAR.CreateBlob: IBlob;
788   begin
789 <  Result := TFB30Blob.Create(FStatement.GetAttachment as TFB30Attachment,
790 <                             FStatement.GetTransaction as TFB30Transaction,
789 >  Result := TFB30Blob.Create(GetAttachment as TFB30Attachment,
790 >                             GetTransaction as TFB30Transaction,
791                               GetSubType,GetCharSetID,nil);
792   end;
793  
794   { TResultSet }
795  
796 + procedure TResultSet.RowChange;
797 + var i: integer;
798 + begin
799 +  for i := 0 to getCount - 1 do
800 +    FResults.Column[i].RowChange;
801 + end;
802 +
803   constructor TResultSet.Create(aResults: TIBXOUTPUTSQLDA);
804   begin
805    inherited Create(aResults);
# Line 778 | Line 814 | begin
814   end;
815  
816   function TResultSet.FetchNext: boolean;
781 var i: integer;
817   begin
818    CheckActive;
819 <  Result := FResults.FStatement.FetchNext;
819 >  Result := FResults.FStatement.Fetch(ftNext);
820 >  if Result then
821 >    RowChange;
822 > end;
823 >
824 > function TResultSet.FetchPrior: boolean;
825 > begin
826 >  CheckActive;
827 >  Result := FResults.FStatement.Fetch(ftPrior);
828 >  if Result then
829 >    RowChange;
830 > end;
831 >
832 > function TResultSet.FetchFirst: boolean;
833 > begin
834 >  CheckActive;
835 >  Result := FResults.FStatement.Fetch(ftFirst);
836 >  if Result then
837 >    RowChange;
838 > end;
839 >
840 > function TResultSet.FetchLast: boolean;
841 > begin
842 >  CheckActive;
843 >  Result := FResults.FStatement.Fetch(ftLast);
844 >  if Result then
845 >    RowChange;
846 > end;
847 >
848 > function TResultSet.FetchAbsolute(position: Integer): boolean;
849 > begin
850 >  CheckActive;
851 >  Result := FResults.FStatement.Fetch(ftAbsolute,position);
852    if Result then
853 <    for i := 0 to getCount - 1 do
854 <      FResults.Column[i].RowChange;
853 >    RowChange;
854 > end;
855 >
856 > function TResultSet.FetchRelative(offset: Integer): boolean;
857 > begin
858 >  CheckActive;
859 >  Result := FResults.FStatement.Fetch(ftRelative,offset);
860 >  if Result then
861 >    RowChange;
862   end;
863  
864   function TResultSet.GetCursorName: AnsiString;
865   begin
866 <  IBError(ibxeNotSupported,[nil]);
793 <  Result := '';
866 >  Result := FResults.FStatement.FCursor;
867   end;
868  
869 < function TResultSet.GetTransaction: ITransaction;
869 > function TResultSet.IsBof: boolean;
870   begin
871 <  Result := FResults.FTransaction;
871 >  Result := FResults.FStatement.FBof;
872   end;
873  
874   function TResultSet.IsEof: boolean;
# Line 824 | Line 897 | begin
897      end;
898   end;
899  
827 procedure TIBXINPUTSQLDA.FreeMessageBuffer;
828 begin
829  if FMessageBuffer <> nil then
830  begin
831    FreeMem(FMessageBuffer);
832    FMessageBuffer := nil;
833  end;
834  FMsgLength := 0;
835 end;
836
900   procedure TIBXINPUTSQLDA.FreeCurMetaData;
901   begin
902    if FCurMetaData <> nil then
# Line 853 | Line 916 | function TIBXINPUTSQLDA.GetMetaData: Fir
916   begin
917    BuildMetadata;
918    Result := FCurMetaData;
919 +  if Result <> nil then
920 +    Result.addRef;
921   end;
922  
923   function TIBXINPUTSQLDA.GetMsgLength: integer;
# Line 864 | Line 929 | end;
929   procedure TIBXINPUTSQLDA.BuildMetadata;
930   var Builder: Firebird.IMetadataBuilder;
931      i: integer;
932 +    version: NativeInt;
933   begin
934    if (FCurMetaData = nil) and (Count > 0) then
935    with FFirebird30ClientAPI do
# Line 874 | Line 940 | begin
940        for i := 0 to Count - 1 do
941        with TIBXSQLVar(Column[i]) do
942        begin
943 <        Builder.setType(StatusIntf,i,FSQLType+1);
943 >        version := Builder.vtable.version;
944 >        if version >= 4 then
945 >        {Firebird 4 or later}
946 >        begin
947 >          Builder.setField(StatusIntf,i,PAnsiChar(Name));
948 >          Check4DataBaseError;
949 >          Builder.setAlias(StatusIntf,i,PAnsiChar(Name));
950 >          Check4DataBaseError;
951 >        end;
952 >        Builder.setType(StatusIntf,i,FSQLType);
953          Check4DataBaseError;
954          Builder.setSubType(StatusIntf,i,FSQLSubType);
955          Check4DataBaseError;
# Line 906 | Line 981 | end;
981   procedure TIBXINPUTSQLDA.PackBuffer;
982   var i: integer;
983      P: PByte;
984 +    MsgLen: cardinal;
985   begin
986    BuildMetadata;
987  
988    if (FMsgLength = 0) and (FCurMetaData <> nil) then
989    with FFirebird30ClientAPI do
990    begin
991 <    FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
991 >    MsgLen := FCurMetaData.getMessageLength(StatusIntf);
992      Check4DataBaseError;
993  
994 <    IBAlloc(FMessageBuffer,0,FMsgLength);
994 >    AllocMessageBuffer(MsgLen);
995  
996      for i := 0 to Count - 1 do
997      with TIBXSQLVar(Column[i]) do
# Line 955 | Line 1031 | procedure TIBXINPUTSQLDA.FreeXSQLDA;
1031   begin
1032    inherited FreeXSQLDA;
1033    FreeCurMetaData;
958  FreeMessageBuffer;
1034   end;
1035  
1036   constructor TIBXINPUTSQLDA.Create(aStatement: TFB30Statement);
# Line 964 | Line 1039 | begin
1039    FMessageBuffer := nil;
1040   end;
1041  
1042 + constructor TIBXINPUTSQLDA.Create(api: IFirebirdAPI);
1043 + begin
1044 +  inherited Create(api);
1045 +  FMessageBuffer := nil;
1046 + end;
1047 +
1048   destructor TIBXINPUTSQLDA.Destroy;
1049   begin
1050    FreeXSQLDA;
# Line 974 | Line 1055 | procedure TIBXINPUTSQLDA.Bind(aMetaData:
1055   var i: integer;
1056   begin
1057    FMetaData := aMetaData;
1058 +  FMetaData.AddRef;
1059    with FFirebird30ClientAPI do
1060    begin
1061      Count := aMetadata.getCount(StatusIntf);
# Line 983 | Line 1065 | begin
1065      for i := 0 to Count - 1 do
1066      with TIBXSQLVar(Column[i]) do
1067      begin
1068 <      FSQLType := aMetaData.getType(StatusIntf,i);
1069 <      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;
1068 >      InitColumnMetaData(aMetaData);
1069 >      SaveMetaData;
1070        if FNullable then
1071          FSQLNullIndicator := @FNullIndicator
1072        else
1073          FSQLNullIndicator := nil;
1004      FScale := aMetaData.getScale(StatusIntf,i);
1005      Check4DataBaseError;
1006      FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
1007      Check4DataBaseError;
1074        ColumnSQLDataInit;
1075      end;
1076    end;
# Line 1032 | Line 1098 | end;
1098  
1099   { TIBXOUTPUTSQLDA }
1100  
1101 < procedure TIBXOUTPUTSQLDA.FreeXSQLDA;
1101 > function TIBXOUTPUTSQLDA.GetTransaction: ITransaction;
1102   begin
1103 <  inherited FreeXSQLDA;
1104 <  FreeMem(FMessageBuffer);
1105 <  FMessageBuffer := nil;
1106 <  FMsgLength := 0;
1103 >  if FTransaction <> nil then
1104 >    Result := FTransaction
1105 >  else
1106 >    Result := inherited GetTransaction;
1107   end;
1108  
1109   procedure TIBXOUTPUTSQLDA.Bind(aMetaData: Firebird.IMessageMetadata);
1110   var i: integer;
1111 +    MsgLen: cardinal;
1112   begin
1113    FMetaData := aMetaData;
1114 +  FMetaData.AddRef;
1115    with FFirebird30ClientAPI do
1116    begin
1117 <    Count := metadata.getCount(StatusIntf);
1117 >    Count := aMetaData.getCount(StatusIntf);
1118      Check4DataBaseError;
1119      Initialize;
1120  
1121 <    FMsgLength := metaData.getMessageLength(StatusIntf);
1121 >    MsgLen := aMetaData.getMessageLength(StatusIntf);
1122      Check4DataBaseError;
1123 <    IBAlloc(FMessageBuffer,0,FMsgLength);
1123 >    AllocMessageBuffer(MsgLen);
1124  
1125      for i := 0 to Count - 1 do
1126      with TIBXSQLVar(Column[i]) do
1127      begin
1128 <      FSQLType := aMetaData.getType(StatusIntf,i);
1129 <      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;
1071 <      FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i);
1072 <      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);
1128 >      InitColumnMetaData(aMetaData);
1129 >      FSQLData := FMessageBuffer + aMetaData.getOffset(StatusIntf,i);
1130        Check4DataBaseError;
1131        if FNullable then
1132        begin
# Line 1086 | Line 1135 | begin
1135        end
1136        else
1137          FSQLNullIndicator := nil;
1138 <      FScale := aMetaData.getScale(StatusIntf,i);
1139 <      Check4DataBaseError;
1091 <      FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
1092 <      Check4DataBaseError;
1138 >      FBlob := nil;
1139 >      FArrayIntf := nil;
1140      end;
1141    end;
1142    SetUniqueRelationName;
# Line 1127 | Line 1174 | begin
1174   //  writeln('Creating ',ClassName);
1175   end;
1176  
1177 + constructor TIBXSQLDA.Create(api: IFirebirdAPI);
1178 + begin
1179 +  inherited Create;
1180 +  FStatement := nil;
1181 +  FSize := 0;
1182 +  FFirebird30ClientAPI := api as TFB30ClientAPI;
1183 + end;
1184 +
1185   destructor TIBXSQLDA.Destroy;
1186   begin
1187    FreeXSQLDA;
# Line 1142 | Line 1197 | end;
1197   function TIBXSQLDA.CheckStatementStatus(Request: TStatementStatus): boolean;
1198   begin
1199    Result := false;
1200 +  if FStatement <> nil then
1201    case Request of
1202    ssPrepared:
1203      Result := FStatement.IsPrepared;
1204  
1205    ssExecuteResults:
1206 <    Result :=FStatement.FSingleResults;
1206 >    Result := FStatement.FSingleResults;
1207  
1208    ssCursorOpen:
1209      Result := FStatement.FOpen;
# Line 1165 | Line 1221 | begin
1221    Result := FCount;
1222   end;
1223  
1168 function TIBXSQLDA.GetTransaction: TFB30Transaction;
1169 begin
1170  Result := FStatement.GetTransaction as TFB30Transaction;
1171 end;
1172
1224   procedure TIBXSQLDA.Initialize;
1225   begin
1226    if FMetaData <> nil then
# Line 1178 | Line 1229 | end;
1229  
1230   function TIBXSQLDA.StateChanged(var ChangeSeqNo: integer): boolean;
1231   begin
1232 <  Result := FStatement.ChangeSeqNo <> ChangeSeqNo;
1232 >  Result := (FStatement <> nil) and (FStatement.ChangeSeqNo <> ChangeSeqNo);
1233    if Result then
1234      ChangeSeqNo := FStatement.ChangeSeqNo;
1235   end;
# Line 1204 | Line 1255 | begin
1255    end;
1256   end;
1257  
1258 + procedure TIBXSQLDA.AllocMessageBuffer(len: integer);
1259 + begin
1260 +  with FFirebird30ClientAPI do
1261 +    IBAlloc(FMessageBuffer,0,len);
1262 +  FMsgLength := len;
1263 + end;
1264 +
1265 + procedure TIBXSQLDA.FreeMessageBuffer;
1266 + begin
1267 +  if FMessageBuffer <> nil then
1268 +  begin
1269 +    FreeMem(FMessageBuffer);
1270 +    FMessageBuffer := nil;
1271 +  end;
1272 +  FMsgLength := 0;
1273 + end;
1274 +
1275 + function TIBXSQLDA.GetMetaData: Firebird.IMessageMetadata;
1276 + begin
1277 +  Result := FMetadata;
1278 +  if Result <> nil then
1279 +    Result.addRef;
1280 + end;
1281 +
1282   function TIBXSQLDA.GetTransactionSeqNo: integer;
1283   begin
1284    Result := FTransactionSeqNo;
# Line 1222 | Line 1297 | begin
1297    FCount := 0;
1298    SetLength(FColumnList,0);
1299    FSize := 0;
1300 +  FreeMessageBuffer;
1301   end;
1302  
1303   function TIBXSQLDA.GetStatement: IStatement;
# Line 1231 | Line 1307 | end;
1307  
1308   function TIBXSQLDA.GetPrepareSeqNo: integer;
1309   begin
1310 <  Result := FStatement.FPrepareSeqNo;
1310 >  if FStatement = nil then
1311 >    Result := 0
1312 >  else
1313 >    Result := FStatement.FPrepareSeqNo;
1314   end;
1315  
1316   { TFB30Statement }
# Line 1271 | Line 1350 | begin
1350    end;
1351   end;
1352  
1353 < procedure TFB30Statement.InternalPrepare;
1353 > function TFB30Statement.GetStatementIntf: IStatement;
1354 > begin
1355 >  Result := self;
1356 > end;
1357 >
1358 > procedure TFB30Statement.InternalPrepare(CursorName: AnsiString);
1359 > var GUID : TGUID;
1360 >    metadata: Firebird.IMessageMetadata;
1361   begin
1362    if FPrepared then
1363      Exit;
1364 +
1365 +  FCursor := CursorName;
1366    if (FSQL = '') then
1367      IBError(ibxeEmptyQuery, [nil]);
1368    try
1369      CheckTransaction(FTransactionIntf);
1370      with FFirebird30ClientAPI do
1371      begin
1372 +      if FCursor = '' then
1373 +      begin
1374 +        CreateGuid(GUID);
1375 +        FCursor := GUIDToString(GUID);
1376 +      end;
1377 +
1378        if FHasParamNames then
1379        begin
1380          if FProcessedSQL = '' then
# Line 1303 | Line 1397 | begin
1397        FSQLStatementType := TIBSQLStatementTypes(FStatementIntf.getType(StatusIntf));
1398        Check4DataBaseError;
1399  
1400 +      if FSQLStatementType = SQLSelect then
1401 +      begin
1402 +        FStatementIntf.setCursorName(StatusIntf,PAnsiChar(FCursor));
1403 +        Check4DataBaseError;
1404 +      end;
1405        { Done getting the type }
1406        case FSQLStatementType of
1407          SQLGetSegment,
# Line 1319 | Line 1418 | begin
1418          SQLExecProcedure:
1419          begin
1420            {set up input sqlda}
1421 <          FSQLParams.Bind(FStatementIntf.getInputMetadata(StatusIntf));
1421 >          metadata := FStatementIntf.getInputMetadata(StatusIntf);
1422            Check4DataBaseError;
1423 +          try
1424 +            FSQLParams.Bind(metadata);
1425 +          finally
1426 +            metadata.release;
1427 +          end;
1428  
1429            {setup output sqlda}
1430            if FSQLStatementType in [SQLSelect, SQLSelectForUpdate,
1431                            SQLExecProcedure] then
1432 <            FSQLRecord.Bind(FStatementIntf.getOutputMetadata(StatusIntf));
1433 <          Check4DataBaseError;
1432 >          begin
1433 >            metadata := FStatementIntf.getOutputMetadata(StatusIntf);
1434 >            Check4DataBaseError;
1435 >            try
1436 >              FSQLRecord.Bind(metadata);
1437 >            finally
1438 >              metadata.release;
1439 >            end;
1440 >          end;
1441          end;
1442        end;
1443      end;
# Line 1340 | Line 1451 | begin
1451      end;
1452    end;
1453    FPrepared := true;
1454 +
1455    FSingleResults := false;
1456    if RetainInterfaces then
1457    begin
# Line 1359 | Line 1471 | end;
1471   function TFB30Statement.InternalExecute(aTransaction: ITransaction): IResults;
1472  
1473    procedure ExecuteQuery(outMetaData: Firebird.IMessageMetaData=nil; outBuffer: pointer=nil);
1474 +  var inMetadata: Firebird.IMessageMetaData;
1475    begin
1476      with FFirebird30ClientAPI do
1477      begin
1478        SavePerfStats(FBeforeStats);
1479 <      FStatementIntf.execute(StatusIntf,
1480 <                             (aTransaction as TFB30Transaction).TransactionIntf,
1481 <                             FSQLParams.MetaData,
1482 <                             FSQLParams.MessageBuffer,
1483 <                             outMetaData,
1484 <                             outBuffer);
1485 <      Check4DataBaseError;
1479 >      inMetadata := FSQLParams.GetMetaData;
1480 >      try
1481 >        FStatementIntf.execute(StatusIntf,
1482 >                               (aTransaction as TFB30Transaction).TransactionIntf,
1483 >                               inMetaData,
1484 >                               FSQLParams.MessageBuffer,
1485 >                               outMetaData,
1486 >                               outBuffer);
1487 >        Check4DataBaseError;
1488 >      finally
1489 >        if inMetadata <> nil then
1490 >          inMetadata.release;
1491 >      end;
1492        FStatisticsAvailable := SavePerfStats(FAfterStats);
1493      end;
1494    end;
1495  
1496 + var Cursor: IResultSet;
1497 +    outMetadata: Firebird.IMessageMetaData;
1498  
1499   begin
1500    Result := nil;
# Line 1399 | Line 1520 | begin
1520      begin
1521        case FSQLStatementType of
1522        SQLSelect:
1523 <        IBError(ibxeIsAExecuteProcedure,[]);
1523 >       {e.g. Update...returning with a single row in Firebird 5 and later}
1524 >      begin
1525 >        Cursor := InternalOpenCursor(aTransaction,false);
1526 >        if not Cursor.IsEof then
1527 >          Cursor.FetchNext;
1528 >        Result := Cursor; {note only first row}
1529 >        FSingleResults := true;
1530 >      end;
1531  
1532        SQLExecProcedure:
1533        begin
1534 <        ExecuteQuery(FSQLRecord.MetaData,FSQLRecord.MessageBuffer);
1535 <        Result := TResults.Create(FSQLRecord);
1536 <        FSingleResults := true;
1534 >        outMetadata := FSQLRecord.GetMetaData;
1535 >        try
1536 >          ExecuteQuery(outMetadata,FSQLRecord.MessageBuffer);
1537 >          Result := TResults.Create(FSQLRecord);
1538 >          FSingleResults := true;
1539 >        finally
1540 >          if outMetadata <> nil then
1541 >            outMetadata.release;
1542 >        end;
1543        end;
1544  
1545        else
# Line 1423 | Line 1557 | begin
1557    Inc(FChangeSeqNo);
1558   end;
1559  
1560 < function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction
1561 <  ): IResultSet;
1560 > function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction;
1561 >  Scrollable: boolean): IResultSet;
1562 > var flags: cardinal;
1563 >    inMetadata,
1564 >    outMetadata: Firebird.IMessageMetadata;
1565   begin
1566 <  if FSQLStatementType <> SQLSelect then
1566 >  flags := 0;
1567 >  if (FSQLStatementType <> SQLSelect) and not (stHasCursor in getFlags) then
1568     IBError(ibxeIsASelectStatement,[]);
1569  
1570    FBatchCompletion := nil;
# Line 1439 | Line 1577 | begin
1577    if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1578      IBError(ibxeInterfaceOutofDate,[nil]);
1579  
1580 + if Scrollable then
1581 +   flags := Firebird.IStatement.CURSOR_TYPE_SCROLLABLE;
1582 +
1583   with FFirebird30ClientAPI do
1584   begin
1585     if FCollectStatistics then
# Line 1449 | Line 1590 | begin
1590       Check4DataBaseError;
1591     end;
1592  
1593 <   FResultSet := FStatementIntf.openCursor(StatusIntf,
1593 >   inMetadata := FSQLParams.GetMetaData;
1594 >   outMetadata := FSQLRecord.GetMetaData;
1595 >   try
1596 >     FResultSet := FStatementIntf.openCursor(StatusIntf,
1597                            (aTransaction as TFB30Transaction).TransactionIntf,
1598 <                          FSQLParams.MetaData,
1598 >                          inMetaData,
1599                            FSQLParams.MessageBuffer,
1600 <                          FSQLRecord.MetaData,
1601 <                          0);
1602 <   Check4DataBaseError;
1600 >                          outMetaData,
1601 >                          flags);
1602 >     Check4DataBaseError;
1603 >   finally
1604 >     if inMetadata <> nil then
1605 >       inMetadata.release;
1606 >     if outMetadata <> nil then
1607 >       outMetadata.release;
1608 >   end;
1609  
1610     if FCollectStatistics then
1611     begin
# Line 1500 | Line 1650 | begin
1650      FStatementIntf := nil;
1651      FPrepared := false;
1652    end;
1653 +  FCursor := '';
1654   end;
1655  
1656   procedure TFB30Statement.InternalClose(Force: boolean);
# Line 1545 | Line 1696 | begin
1696   end;
1697  
1698   constructor TFB30Statement.Create(Attachment: TFB30Attachment;
1699 <  Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1699 >  Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1700 >  CursorName: AnsiString);
1701   begin
1702    inherited Create(Attachment,Transaction,sql,aSQLDialect);
1703    FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1704    FSQLParams := TIBXINPUTSQLDA.Create(self);
1705    FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1706 <  InternalPrepare;
1706 >  InternalPrepare(CursorName);
1707   end;
1708  
1709   constructor TFB30Statement.CreateWithParameterNames(
1710    Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString;
1711    aSQLDialect: integer; GenerateParamNames: boolean;
1712 <  CaseSensitiveParams: boolean);
1712 >  CaseSensitiveParams: boolean; CursorName: AnsiString);
1713   begin
1714    inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1715    FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1716    FSQLParams := TIBXINPUTSQLDA.Create(self);
1717    FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1718    FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1719 <  InternalPrepare;
1719 >  InternalPrepare(CursorName);
1720   end;
1721  
1722   destructor TFB30Statement.Destroy;
# Line 1574 | Line 1726 | begin
1726    if assigned(FSQLRecord) then FSQLRecord.Free;
1727   end;
1728  
1729 < function TFB30Statement.FetchNext: boolean;
1729 > function TFB30Statement.Fetch(FetchType: TFetchType; PosOrOffset: integer
1730 >  ): boolean;
1731   var fetchResult: integer;
1732   begin
1733 <  result := false;
1733 >    result := false;
1734    if not FOpen then
1735      IBError(ibxeSQLClosed, [nil]);
1583  if FEOF then
1584    IBError(ibxeEOF,[nil]);
1736  
1737    with FFirebird30ClientAPI do
1738    begin
1739 <    { Go to the next record... }
1740 <    fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1741 <    if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1742 <    begin
1743 <      FBOF := false;
1744 <      FEOF := true;
1745 <      Exit; {End of File}
1746 <    end
1747 <    else
1748 <    if fetchResult <> Firebird.IStatus.RESULT_OK then
1749 <    begin
1750 <      try
1751 <        IBDataBaseError;
1601 <      except
1602 <        Close;
1603 <        raise;
1739 >    case FetchType of
1740 >    ftNext:
1741 >      begin
1742 >        if FEOF then
1743 >          IBError(ibxeEOF,[nil]);
1744 >        { Go to the next record... }
1745 >        fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1746 >        if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1747 >        begin
1748 >          FBOF := false;
1749 >          FEOF := true;
1750 >          Exit; {End of File}
1751 >        end
1752        end;
1753 <    end
1754 <    else
1755 <    begin
1756 <      FBOF := false;
1757 <      result := true;
1753 >
1754 >    ftPrior:
1755 >      begin
1756 >        if FBOF then
1757 >          IBError(ibxeBOF,[nil]);
1758 >        { Go to the next record... }
1759 >        fetchResult := FResultSet.fetchPrior(StatusIntf,FSQLRecord.MessageBuffer);
1760 >        if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1761 >        begin
1762 >          FBOF := true;
1763 >          FEOF := false;
1764 >          Exit; {Top of File}
1765 >        end
1766 >      end;
1767 >
1768 >    ftFirst:
1769 >      fetchResult := FResultSet.fetchFirst(StatusIntf,FSQLRecord.MessageBuffer);
1770 >
1771 >    ftLast:
1772 >      fetchResult := FResultSet.fetchLast(StatusIntf,FSQLRecord.MessageBuffer);
1773 >
1774 >    ftAbsolute:
1775 >      fetchResult := FResultSet.fetchAbsolute(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1776 >
1777 >    ftRelative:
1778 >      fetchResult := FResultSet.fetchRelative(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1779      end;
1780 +
1781 +    Check4DataBaseError;
1782 +    if fetchResult <> Firebird.IStatus.RESULT_OK then
1783 +      exit; {result = false}
1784 +
1785 +    {Result OK}
1786 +    FBOF := false;
1787 +    FEOF := false;
1788 +    result := true;
1789 +
1790      if FCollectStatistics then
1791      begin
1792        UtilIntf.getPerfCounters(StatusIntf,
# Line 1693 | Line 1872 | end;
1872  
1873   procedure TFB30Statement.AddToBatch;
1874   var BatchPB: TXPBParameterBlock;
1875 +    inMetadata: Firebird.IMessageMetadata;
1876  
1877   const SixteenMB = 16 * 1024 * 1024;
1878 +      MB256 = 256* 1024 *1024;
1879   begin
1880    FBatchCompletion := nil;
1881    if not FPrepared then
1882      InternalPrepare;
1883    CheckHandle;
1884    CheckBatchModeAvailable;
1885 <  with FFirebird30ClientAPI do
1886 <  begin
1887 <    if FBatch = nil then
1885 >  inMetadata := FSQLParams.GetMetaData;
1886 >  try
1887 >    with FFirebird30ClientAPI do
1888      begin
1889 <      {Start Batch}
1890 <      BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH);
1891 <      with FFirebird30ClientAPI do
1892 <      try
1893 <        FBatchBufferSize := FBatchRowLimit * FSQLParams.MetaData.getAlignedLength(StatusIntf);
1894 <        Check4DatabaseError;
1895 <        if FBatchBufferSize < SixteenMB then
1896 <          FBatchBufferSize := SixteenMB;
1897 <        if FBatchBufferSize > 256 * 1024 *1024 {assumed limit} then
1898 <          IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]);
1899 <
1900 <        BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1);
1901 <        BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize);
1902 <        FBatch := FStatementIntf.createBatch(StatusIntf,
1903 <                                             FSQLParams.MetaData,
1904 <                                             BatchPB.getDataLength,
1905 <                                             BatchPB.getBuffer);
1906 <        Check4DataBaseError;
1889 >      if FBatch = nil then
1890 >      begin
1891 >        {Start Batch}
1892 >        BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH);
1893 >        with FFirebird30ClientAPI do
1894 >        try
1895 >          if FBatchRowLimit = maxint then
1896 >            FBatchBufferSize := MB256
1897 >          else
1898 >          begin
1899 >            FBatchBufferSize := FBatchRowLimit * inMetadata.getAlignedLength(StatusIntf);
1900 >            Check4DatabaseError;
1901 >            if FBatchBufferSize < SixteenMB then
1902 >              FBatchBufferSize := SixteenMB;
1903 >            if FBatchBufferSize > MB256 {assumed limit} then
1904 >              IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]);
1905 >          end;
1906 >          BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1);
1907 >          BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize);
1908 >          FBatch := FStatementIntf.createBatch(StatusIntf,
1909 >                                               inMetadata,
1910 >                                               BatchPB.getDataLength,
1911 >                                               BatchPB.getBuffer);
1912 >          Check4DataBaseError;
1913  
1914 <      finally
1915 <        BatchPB.Free;
1914 >        finally
1915 >          BatchPB.Free;
1916 >        end;
1917 >        FBatchRowCount := 0;
1918 >        FBatchBufferUsed := 0;
1919        end;
1730      FBatchRowCount := 0;
1731      FBatchBufferUsed := 0;
1732    end;
1920  
1921 <    Inc(FBatchRowCount);
1922 <    Inc(FBatchBufferUsed,FSQLParams.MetaData.getAlignedLength(StatusIntf));
1923 <    Check4DataBaseError;
1924 <    if FBatchBufferUsed > FBatchBufferSize then
1925 <      raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow),
1926 <                              Format(GetErrorMessage(ibxeBatchRowBufferOverflow),
1927 <                              [FBatchRowCount,FBatchBufferSize]));
1921 >      Inc(FBatchRowCount);
1922 >      Inc(FBatchBufferUsed,inMetadata.getAlignedLength(StatusIntf));
1923 >      Check4DataBaseError;
1924 >      if FBatchBufferUsed > FBatchBufferSize then
1925 >        raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow),
1926 >                                Format(GetErrorMessage(ibxeBatchRowBufferOverflow),
1927 >                                [FBatchRowCount,FBatchBufferSize]));
1928  
1929 <    FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer);
1930 <      Check4DataBaseError
1929 >      FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer);
1930 >        Check4DataBaseError
1931 >    end;
1932 >  finally
1933 >    if inMetadata <> nil then
1934 >      inMetadata.release;
1935    end;
1936   end;
1937  
# Line 1799 | Line 1990 | begin
1990    Result := FStatementIntf <> nil;
1991   end;
1992  
1993 + function TFB30Statement.GetFlags: TStatementFlags;
1994 + var flags: cardinal;
1995 + begin
1996 +  CheckHandle;
1997 +  Result := [];
1998 +  with FFirebird30ClientAPI do
1999 +  begin
2000 +    flags := FStatementIntf.getFlags(StatusIntf);
2001 +    Check4DataBaseError;
2002 +  end;
2003 +  if flags and Firebird.IStatement.FLAG_HAS_CURSOR <> 0 then
2004 +    Result := Result + [stHasCursor];
2005 +  if flags and Firebird.IStatement.FLAG_REPEAT_EXECUTE <> 0 then
2006 +    Result := Result + [stRepeatExecute];
2007 +  if flags and Firebird.IStatement.CURSOR_TYPE_SCROLLABLE <> 0 then
2008 +    Result := Result + [stScrollable];
2009 + end;
2010 +
2011   end.
2012  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines