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 56 by tony, Mon Mar 6 10:20:02 2017 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 78 | Line 78 | uses
78    FB30Attachment,IBExternals, FBSQLData, FBOutputBlock, FBActivityMonitor;
79  
80   type
81
81    TFB30Statement = class;
82    TIBXSQLDA = class;
83  
# Line 87 | Line 86 | type
86    TIBXSQLVAR = class(TSQLVarData)
87    private
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;
101 >    FDataLength: cardinal;
102 >    FMetadataSize: cardinal;
103      FNullable: boolean;
104      FScale: integer;
105      FCharSetID: cardinal;
# Line 107 | Line 107 | type
107      FFieldName: AnsiString;
108  
109      protected
110 +     function CanChangeSQLType: boolean;
111       function GetSQLType: cardinal; override;
112       function GetSubtype: integer; override;
113       function GetAliasName: AnsiString;  override;
# Line 115 | Line 116 | type
116       function GetRelationName: AnsiString;  override;
117       function GetScale: integer; override;
118       function GetCharSetID: cardinal; override;
118     function GetCodePage: TSystemCodePage; 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;
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;
128 <     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 <
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 148 | Line 152 | type
152      FSize: Integer;  {Number of TIBXSQLVARs in column list}
153      FMetaData: Firebird.IMessageMetadata;
154      FTransactionSeqNo: integer;
155 <  protected
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 <    property MetaData: Firebird.IMessageMetadata read FMetaData;
177 >    function CanChangeMetaData: boolean; override;
178      property Count: Integer read FCount write SetCount;
179      property Statement: TFB30Statement read FStatement;
180    end;
# Line 173 | Line 183 | type
183  
184    TIBXINPUTSQLDA = class(TIBXSQLDA)
185    private
176    FMessageBuffer: PByte; {Message Buffer}
177    FMsgLength: integer; {Message Buffer length}
186      FCurMetaData: Firebird.IMessageMetadata;
187 <    procedure FreeMessageBuffer;
187 >    procedure FreeCurMetaData;
188      function GetMessageBuffer: PByte;
181    function GetMetaData: Firebird.IMessageMetadata;
189      function GetModified: Boolean;
190      function GetMsgLength: integer;
191 <    procedure PackBuffer;
191 >    procedure BuildMetadata;
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;
193    property MetaData: Firebird.IMessageMetadata read GetMetaData;
204      property MessageBuffer: PByte read GetMessageBuffer;
205      property MsgLength: integer read GetMsgLength;
206    end;
# Line 200 | Line 210 | type
210    TIBXOUTPUTSQLDA = class(TIBXSQLDA)
211    private
212      FTransaction: TFB30Transaction; {transaction used to execute the statement}
203    FMessageBuffer: PByte; {Message Buffer}
204    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 219 | 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;
246  
247 +  { TBatchCompletion }
248 +
249 +  TBatchCompletion = class(TInterfaceOwner,IBatchCompletion)
250 +  private
251 +    FCompletionState: Firebird.IBatchCompletionState;
252 +    FFirebird30ClientAPI: TFB30ClientAPI;
253 +  public
254 +    constructor Create(api: TFB30ClientAPI; cs: IBatchCompletionState);
255 +    destructor Destroy; override;
256 +    {IBatchCompletion}
257 +    function getErrorStatus(var RowNo: integer; var status: IStatus): boolean;
258 +    function getTotalProcessed: cardinal;
259 +    function getState(updateNo: cardinal): TBatchCompletionState;
260 +    function getStatusMessage(updateNo: cardinal): AnsiString;
261 +    function getUpdated: integer;
262 +  end;
263 +
264 +  TFetchType = (ftNext,ftPrior,ftFirst,ftLast,ftAbsolute,ftRelative);
265 +
266    { TFB30Statement }
267  
268    TFB30Statement = class(TFBStatement,IStatement)
269    private
270      FStatementIntf: Firebird.IStatement;
271 +    FFirebird30ClientAPI: TFB30ClientAPI;
272      FSQLParams: TIBXINPUTSQLDA;
273      FSQLRecord: TIBXOUTPUTSQLDA;
274      FResultSet: Firebird.IResultSet;
275      FCursorSeqNo: integer;
276 +    FCursor: AnsiString;
277 +    FBatch: Firebird.IBatch;
278 +    FBatchCompletion: IBatchCompletion;
279 +    FBatchRowCount: integer;
280 +    FBatchBufferSize: integer;
281 +    FBatchBufferUsed: integer;
282    protected
283 +    procedure CheckChangeBatchRowLimit; override;
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);
300 >      sql: AnsiString;  aSQLDialect: integer; GenerateParamNames: 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 262 | 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;
318 <
318 >    function IsInBatchMode: boolean; override;
319 >    function HasBatchMode: boolean; override;
320 >    procedure AddToBatch; override;
321 >    function ExecuteBatch(aTransaction: ITransaction
322 >      ): IBatchCompletion; override;
323 >    procedure CancelBatch; override;
324 >    function GetBatchCompletion: IBatchCompletion; override;
325   end;
326  
327   implementation
328  
329 < uses IBUtils, FBMessages, FBBLob, FB30Blob, variants,  FBArray, FB30Array;
329 > uses IBUtils, FBMessages, FBBlob, FB30Blob, variants,  FBArray, FB30Array;
330  
331   const
332    ISQL_COUNTERS = 'CurrentMemory, MaxMemory, RealTime, UserTime, Buffers, Reads, Writes, Fetches';
333  
334 + { EIBBatchCompletionError }
335 +
336 + { TBatchCompletion }
337 +
338 + constructor TBatchCompletion.Create(api: TFB30ClientAPI;
339 +  cs: IBatchCompletionState);
340 + begin
341 +  inherited Create;
342 +  FFirebird30ClientAPI := api;
343 +  FCompletionState := cs;
344 + end;
345 +
346 + destructor TBatchCompletion.Destroy;
347 + begin
348 +  if FCompletionState <> nil then
349 +  begin
350 +    FCompletionState.dispose;
351 +    FCompletionState := nil;
352 +  end;
353 +  inherited Destroy;
354 + end;
355 +
356 + function TBatchCompletion.getErrorStatus(var RowNo: integer; var status: IStatus
357 +  ): boolean;
358 + var i: integer;
359 +  upcount: cardinal;
360 +  state: integer;
361 +  FBStatus: Firebird.IStatus;
362 + begin
363 +  Result := false;
364 +  RowNo := -1;
365 +  FBStatus := nil;
366 +  with FFirebird30ClientAPI do
367 +  begin
368 +    upcount := FCompletionState.getSize(StatusIntf);
369 +    Check4DataBaseError;
370 +    for i := 0 to upcount - 1 do
371 +    begin
372 +      state := FCompletionState.getState(StatusIntf,i);
373 +      if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then
374 +      begin
375 +        RowNo := i+1;
376 +        FBStatus := MasterIntf.getStatus;
377 +        try
378 +          FCompletionState.getStatus(StatusIntf,FBStatus,i);
379 +          Check4DataBaseError;
380 +        except
381 +          FBStatus.dispose;
382 +          raise
383 +        end;
384 +        status := TFB30StatusObject.Create(FFirebird30ClientAPI,FBStatus,
385 +                      Format(SBatchCompletionError,[RowNo]));
386 +        status.SetIBDataBaseErrorMessages(GetStatus.GetIBDataBaseErrorMessages);
387 +        Result := true;
388 +        break;
389 +      end;
390 +    end;
391 +  end;
392 + end;
393 +
394 + function TBatchCompletion.getTotalProcessed: cardinal;
395 + begin
396 +  with FFirebird30ClientAPI do
397 +  begin
398 +    Result := FCompletionState.getsize(StatusIntf);
399 +    Check4DataBaseError;
400 +  end;
401 + end;
402 +
403 + function TBatchCompletion.getState(updateNo: cardinal): TBatchCompletionState;
404 + var state: integer;
405 + begin
406 +  with FFirebird30ClientAPI do
407 +  begin
408 +    state := FCompletionState.getState(StatusIntf,updateNo);
409 +    Check4DataBaseError;
410 +    case state of
411 +      Firebird.IBatchCompletionState.EXECUTE_FAILED:
412 +        Result := bcExecuteFailed;
413 +
414 +      Firebird.IBatchCompletionState.SUCCESS_NO_INFO:
415 +        Result := bcSuccessNoInfo;
416 +
417 +     else
418 +        Result := bcNoMoreErrors;
419 +    end;
420 +  end;
421 + end;
422 +
423 + function TBatchCompletion.getStatusMessage(updateNo: cardinal): AnsiString;
424 + var status: Firebird.IStatus;
425 + begin
426 +  with FFirebird30ClientAPI do
427 +  begin
428 +    status := MasterIntf.getStatus;
429 +    FCompletionState.getStatus(StatusIntf,status,updateNo);
430 +    Check4DataBaseError;
431 +    Result := FormatStatus(status);
432 +  end;
433 + end;
434 +
435 + function TBatchCompletion.getUpdated: integer;
436 + var i: integer;
437 +    upcount: cardinal;
438 +    state: integer;
439 + begin
440 +  Result := 0;
441 +  with FFirebird30ClientAPI do
442 +  begin
443 +    upcount := FCompletionState.getSize(StatusIntf);
444 +    Check4DataBaseError;
445 +    for i := 0 to upcount -1  do
446 +    begin
447 +      state := FCompletionState.getState(StatusIntf,i);
448 +      if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then
449 +          break;
450 +      Inc(Result);
451 +    end;
452 +  end;
453 + end;
454 +
455   { TIBXSQLVAR }
456  
457   procedure TIBXSQLVAR.Changed;
# Line 283 | 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;
495 +  with FFirebird30ClientAPI do
496 +  begin
497 +    case SQLType of
498 +      SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
499 +      SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
500 +      SQL_LONG, SQL_INT64, SQL_INT128, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT,
501 +      SQL_TIMESTAMP_TZ, SQL_TIME_TZ, SQL_DEC_FIXED, SQL_DEC16, SQL_DEC34,
502 +      SQL_TIMESTAMP_TZ_EX, SQL_TIME_TZ_EX:
503 +      begin
504 +        if (FDataLength = 0) then
505 +          { Make sure you get a valid pointer anyway
506 +           select '' from foo }
507 +          IBAlloc(FSQLData, 0, 1)
508 +        else
509 +          IBAlloc(FSQLData, 0, FDataLength)
510 +      end;
511 +      SQL_VARYING:
512 +        IBAlloc(FSQLData, 0, FDataLength + 2);
513 +     else
514 +        IBError(ibxeUnknownSQLDataType, [SQLType and (not 1)])
515 +    end;
516 +    FOwnsSQLData := true;
517 +    FNullIndicator := -1;
518 +  end;
519 + end;
520 +
521 + function TIBXSQLVAR.CanChangeSQLType: boolean;
522 + begin
523 +  Result := Parent.CanChangeMetaData;
524 + end;
525 +
526   function TIBXSQLVAR.GetSQLType: cardinal;
527   begin
528    Result := FSQLType;
# Line 294 | Line 534 | begin
534   end;
535  
536   function TIBXSQLVAR.GetAliasName: AnsiString;
537 + var metadata: Firebird.IMessageMetadata;
538   begin
539 <  with Firebird30ClientAPI 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 308 | Line 554 | begin
554   end;
555  
556   function TIBXSQLVAR.GetOwnerName: AnsiString;
557 + var metadata: Firebird.IMessageMetadata;
558   begin
559 <  with Firebird30ClientAPI 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 328 | Line 580 | end;
580  
581   function TIBXSQLVAR.GetCharSetID: cardinal;
582   begin
583 <  result := 0;
583 >  result := 0; {NONE}
584    case SQLType of
585    SQL_VARYING, SQL_TEXT:
586        result := FCharSetID;
587  
588    SQL_BLOB:
589      if (SQLSubType = 1) then
590 <      result := FCharSetID;
590 >      result := FCharSetID
591 >    else
592 >      result := 1; {OCTETS}
593  
594    SQL_ARRAY:
595      if (FRelationName <> '') and (FFieldName <> '') then
# Line 345 | Line 599 | begin
599    end;
600   end;
601  
348 function TIBXSQLVAR.GetCodePage: TSystemCodePage;
349 begin
350  result := CP_NONE;
351  with Firebird30ClientAPI do
352     CharSetID2CodePage(GetCharSetID,result);
353 end;
354
602   function TIBXSQLVAR.GetIsNull: Boolean;
603   begin
604    Result := IsNullable and (FSQLNullIndicator^ = -1);
# Line 372 | Line 619 | begin
619    Result := FDataLength;
620   end;
621  
622 + function TIBXSQLVAR.GetSize: cardinal;
623 + begin
624 +  Result := FMetadataSize;
625 + end;
626 +
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 390 | 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 421 | Line 673 | begin
673    end
674    else
675      FSQLNullIndicator := nil;
676 +  Changed;
677   end;
678  
679   procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal);
# Line 430 | Line 683 | begin
683    FSQLData := AValue;
684    FDataLength := len;
685    FOwnsSQLData := false;
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;
699    FDataLength := len;
700 <  with Firebird30ClientAPI do
700 >  with FFirebird30ClientAPI do
701      IBAlloc(FSQLData, 0, FDataLength);
702    FOwnsSQLData := true;
703 +  Changed;
704   end;
705  
706 < procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
706 > procedure TIBXSQLVAR.InternalSetSQLType(aValue: cardinal);
707   begin
708    FSQLType := aValue;
709 +  Changed;
710   end;
711  
712   procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal);
713   begin
714    FCharSetID := aValue;
715 +  Changed;
716 + end;
717 +
718 + procedure TIBXSQLVAR.SetMetaSize(aValue: cardinal);
719 + begin
720 +  if (aValue > FMetaDataSize) and not CanChangeSQLType then
721 +    IBError(ibxeCannotIncreaseMetadatasize,[FMetaDataSize,aValue]);
722 +  FMetaDataSize := aValue;
723 + end;
724 +
725 + function TIBXSQLVAR.GetDefaultTextSQLType: cardinal;
726 + begin
727 +  Result := SQL_VARYING;
728   end;
729  
730   constructor TIBXSQLVAR.Create(aParent: TIBXSQLDA; aIndex: integer);
731   begin
732    inherited Create(aParent,aIndex);
733    FStatement := aParent.Statement;
734 +  FFirebird30ClientAPI := aParent.FFirebird30ClientAPI;
735   end;
736  
737   procedure TIBXSQLVAR.RowChange;
738   begin
739    inherited;
740    FBlob := nil;
470  FArray := nil;
741   end;
742  
743   procedure TIBXSQLVAR.FreeSQLData;
# Line 478 | 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 487 | 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 506 | 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 516 | 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 537 | Line 814 | begin
814   end;
815  
816   function TResultSet.FetchNext: boolean;
540 var i: integer;
817   begin
818    CheckActive;
819 <  Result := FResults.FStatement.FetchNext;
819 >  Result := FResults.FStatement.Fetch(ftNext);
820    if Result then
821 <    for i := 0 to getCount - 1 do
822 <      FResults.Column[i].RowChange;
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 >    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]);
552 <  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 583 | Line 897 | begin
897      end;
898   end;
899  
900 < procedure TIBXINPUTSQLDA.FreeMessageBuffer;
900 > procedure TIBXINPUTSQLDA.FreeCurMetaData;
901   begin
902    if FCurMetaData <> nil then
903    begin
904      FCurMetaData.release;
905      FCurMetaData := nil;
906    end;
593  if FMessageBuffer <> nil then
594  begin
595    FreeMem(FMessageBuffer);
596    FMessageBuffer := nil;
597  end;
598  FMsgLength := 0;
907   end;
908  
909   function TIBXINPUTSQLDA.GetMessageBuffer: PByte;
# Line 606 | Line 914 | end;
914  
915   function TIBXINPUTSQLDA.GetMetaData: Firebird.IMessageMetadata;
916   begin
917 <  PackBuffer;
917 >  BuildMetadata;
918    Result := FCurMetaData;
919 +  if Result <> nil then
920 +    Result.addRef;
921   end;
922  
923   function TIBXINPUTSQLDA.GetMsgLength: integer;
# Line 616 | Line 926 | begin
926    Result := FMsgLength;
927   end;
928  
929 < procedure TIBXINPUTSQLDA.PackBuffer;
929 > procedure TIBXINPUTSQLDA.BuildMetadata;
930   var Builder: Firebird.IMetadataBuilder;
931      i: integer;
932 +    version: NativeInt;
933   begin
934 <  if FMsgLength > 0 then Exit;
935 <
625 <  with Firebird30ClientAPI do
934 >  if (FCurMetaData = nil) and (Count > 0) then
935 >  with FFirebird30ClientAPI do
936    begin
937 <    Builder := inherited MetaData.getBuilder(StatusIntf);
937 >    Builder := FFirebird30ClientAPI.MasterIntf.getMetadataBuilder(StatusIntf,Count);
938      Check4DataBaseError;
939      try
940        for i := 0 to Count - 1 do
941        with TIBXSQLVar(Column[i]) do
942        begin
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;
956 <        Builder.setLength(StatusIntf,i,FDataLength);
956 > //        writeln('Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength);
957 >        if FSQLType = SQL_VARYING then
958 >        begin
959 >          {The datalength can be greater than the metadata size when SQLType has been overridden to text}
960 >          if (GetDataLength > GetSize) and CanChangeMetaData then
961 >            Builder.setLength(StatusIntf,i,GetDataLength)
962 >          else
963 >            Builder.setLength(StatusIntf,i,GetSize)
964 >        end
965 >        else
966 >          Builder.setLength(StatusIntf,i,GetDataLength);
967          Check4DataBaseError;
968          Builder.setCharSet(StatusIntf,i,GetCharSetID);
969          Check4DataBaseError;
# Line 646 | Line 975 | begin
975      finally
976        Builder.release;
977      end;
978 +  end;
979 + end;
980 +
981 + procedure TIBXINPUTSQLDA.PackBuffer;
982 + var i: integer;
983 +    P: PByte;
984 +    MsgLen: cardinal;
985 + begin
986 +  BuildMetadata;
987  
988 <    FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
988 >  if (FMsgLength = 0) and (FCurMetaData <> nil) then
989 >  with FFirebird30ClientAPI do
990 >  begin
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
998      begin
999 +      P := FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i);
1000 + //     writeln('Packbuffer: Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength);
1001 +      if not Modified then
1002 +        IBError(ibxeUninitializedInputParameter,[i,Name]);
1003        if IsNull then
1004 <        FillChar((FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength,0)
1004 >        FillChar(P^,FDataLength,0)
1005        else
1006 <        Move(FSQLData^,(FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength);
1007 <      Check4DataBaseError;
1006 >      if FSQLData <> nil then
1007 >      begin
1008 >        if SQLType = SQL_VARYING then
1009 >        begin
1010 >            EncodeInteger(FDataLength,2,P);
1011 >            Inc(P,2);
1012 >        end
1013 >        else
1014 >        if (SQLType = SQL_BLOB) and (FStatement.FBatch <> nil) then
1015 >        begin
1016 >          FStatement.FBatch.registerBlob(Statusintf,ISC_QUADPtr(FSQLData),ISC_QUADPtr(FSQLData));
1017 >          Check4DatabaseError;
1018 >        end;
1019 >        Move(FSQLData^,P^,FDataLength);
1020 >      end;
1021        if IsNullable then
1022        begin
1023          Move(FNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(FNullIndicator));
# Line 672 | Line 1030 | end;
1030   procedure TIBXINPUTSQLDA.FreeXSQLDA;
1031   begin
1032    inherited FreeXSQLDA;
1033 <  FreeMessageBuffer;
1033 >  FreeCurMetaData;
1034   end;
1035  
1036   constructor TIBXINPUTSQLDA.Create(aStatement: TFB30Statement);
# Line 681 | 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 <  FreeMessageBuffer;
1050 >  FreeXSQLDA;
1051    inherited Destroy;
1052   end;
1053  
# Line 691 | Line 1055 | procedure TIBXINPUTSQLDA.Bind(aMetaData:
1055   var i: integer;
1056   begin
1057    FMetaData := aMetaData;
1058 <  with Firebird30ClientAPI do
1058 >  FMetaData.AddRef;
1059 >  with FFirebird30ClientAPI do
1060    begin
1061 <    Count := metadata.getCount(StatusIntf);
1061 >    Count := aMetadata.getCount(StatusIntf);
1062      Check4DataBaseError;
1063      Initialize;
1064  
1065      for i := 0 to Count - 1 do
1066      with TIBXSQLVar(Column[i]) do
1067      begin
1068 <      FSQLType := aMetaData.getType(StatusIntf,i);
1069 <      Check4DataBaseError;
705 <      if FSQLType = SQL_BLOB then
706 <      begin
707 <        FSQLSubType := aMetaData.getSubType(StatusIntf,i);
708 <        Check4DataBaseError;
709 <      end
710 <      else
711 <        FSQLSubType := 0;
712 <      FDataLength := aMetaData.getLength(StatusIntf,i);
713 <      Check4DataBaseError;
714 <      case SQLType of
715 <        SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
716 <        SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
717 <        SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
718 <        begin
719 <          if (FDataLength = 0) then
720 <            { Make sure you get a valid pointer anyway
721 <             select '' from foo }
722 <            IBAlloc(FSQLData, 0, 1)
723 <          else
724 <            IBAlloc(FSQLData, 0, FDataLength)
725 <        end;
726 <        SQL_VARYING:
727 <          IBAlloc(FSQLData, 0, FDataLength + 2);
728 <       else
729 <          IBError(ibxeUnknownSQLDataType, [sqltype and (not 1)])
730 <      end;
731 <      FNullable := aMetaData.isNullable(StatusIntf,i);
732 <      FOwnsSQLData := true;
733 <      Check4DataBaseError;
734 <      FNullIndicator := -1;
1068 >      InitColumnMetaData(aMetaData);
1069 >      SaveMetaData;
1070        if FNullable then
1071          FSQLNullIndicator := @FNullIndicator
1072        else
1073          FSQLNullIndicator := nil;
1074 <      FScale := aMetaData.getScale(StatusIntf,i);
740 <      Check4DataBaseError;
741 <      FCharSetID :=  aMetaData.getCharSet(StatusIntf,i);
742 <      Check4DataBaseError;
1074 >      ColumnSQLDataInit;
1075      end;
1076    end;
1077   end;
# Line 747 | Line 1079 | end;
1079   procedure TIBXINPUTSQLDA.Changed;
1080   begin
1081    inherited Changed;
1082 +  FreeCurMetaData;
1083    FreeMessageBuffer;
1084   end;
1085  
1086 + procedure TIBXINPUTSQLDA.ReInitialise;
1087 + var i: integer;
1088 + begin
1089 +  FreeMessageBuffer;
1090 +  for i := 0 to Count - 1 do
1091 +    TIBXSQLVar(Column[i]).ColumnSQLDataInit;
1092 + end;
1093 +
1094   function TIBXINPUTSQLDA.IsInputDataArea: boolean;
1095   begin
1096    Result := true;
# Line 757 | 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 <  with Firebird30ClientAPI do
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;
787 <      if FSQLType = SQL_BLOB then
788 <      begin
789 <        FSQLSubType := aMetaData.getSubType(StatusIntf,i);
790 <        Check4DataBaseError;
791 <      end
792 <      else
793 <        FSQLSubType := 0;
794 <      FBlob := nil;
795 <      FArray := nil;
796 <      FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i);
797 <      Check4DataBaseError;
798 <      FDataLength := aMetaData.getLength(StatusIntf,i);
799 <      Check4DataBaseError;
800 <      FRelationName := strpas(aMetaData.getRelation(StatusIntf,i));
801 <      Check4DataBaseError;
802 <      FFieldName := strpas(aMetaData.getField(StatusIntf,i));
803 <      Check4DataBaseError;
804 <      FNullable := aMetaData.isNullable(StatusIntf,i);
1128 >      InitColumnMetaData(aMetaData);
1129 >      FSQLData := FMessageBuffer + aMetaData.getOffset(StatusIntf,i);
1130        Check4DataBaseError;
1131        if FNullable then
1132        begin
# Line 810 | Line 1135 | begin
1135        end
1136        else
1137          FSQLNullIndicator := nil;
1138 <      FScale := aMetaData.getScale(StatusIntf,i);
1139 <      Check4DataBaseError;
815 <      FCharSetID :=  aMetaData.getCharSet(StatusIntf,i);
816 <      Check4DataBaseError;
1138 >      FBlob := nil;
1139 >      FArrayIntf := nil;
1140      end;
1141    end;
1142    SetUniqueRelationName;
# Line 829 | Line 1152 | begin
1152      len := FDataLength;
1153      if not IsNull and (FSQLType = SQL_VARYING) then
1154      begin
1155 <      with Firebird30ClientAPI do
1155 >      with FFirebird30ClientAPI do
1156          len := DecodeInteger(data,2);
1157        Inc(Data,2);
1158      end;
# Line 846 | Line 1169 | constructor TIBXSQLDA.Create(aStatement:
1169   begin
1170    inherited Create;
1171    FStatement := aStatement;
1172 +  FFirebird30ClientAPI := aStatement.FFirebird30ClientAPI;
1173    FSize := 0;
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 865 | 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 888 | Line 1221 | begin
1221    Result := FCount;
1222   end;
1223  
891 function TIBXSQLDA.GetTransaction: TFB30Transaction;
892 begin
893  Result := FStatement.GetTransaction as TFB30Transaction;
894 end;
895
1224   procedure TIBXSQLDA.Initialize;
1225   begin
1226    if FMetaData <> nil then
# Line 901 | 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;
1236  
1237 + function TIBXSQLDA.CanChangeMetaData: boolean;
1238 + begin
1239 +  Result := FStatement.FBatch = nil;
1240 + end;
1241 +
1242   procedure TIBXSQLDA.SetCount(Value: Integer);
1243   var
1244    i: Integer;
# Line 922 | 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 937 | Line 1294 | begin
1294      TIBXSQLVAR(Column[i]).FreeSQLData;
1295    for i := 0 to FSize - 1  do
1296      TIBXSQLVAR(Column[i]).Free;
1297 +  FCount := 0;
1298    SetLength(FColumnList,0);
1299    FSize := 0;
1300 +  FreeMessageBuffer;
1301   end;
1302  
1303   function TIBXSQLDA.GetStatement: IStatement;
# Line 948 | 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 }
1317  
1318 + procedure TFB30Statement.CheckChangeBatchRowLimit;
1319 + begin
1320 +  if IsInBatchMode then
1321 +    IBError(ibxeInBatchMode,[nil]);
1322 + end;
1323 +
1324   procedure TFB30Statement.CheckHandle;
1325   begin
1326    if FStatementIntf = nil then
1327      IBError(ibxeInvalidStatementHandle,[nil]);
1328   end;
1329  
1330 + procedure TFB30Statement.CheckBatchModeAvailable;
1331 + begin
1332 +  if not HasBatchMode then
1333 +    IBError(ibxeBatchModeNotSupported,[nil]);
1334 +  case SQLStatementType of
1335 +  SQLInsert,
1336 +  SQLUpdate: {OK};
1337 +  else
1338 +     IBError(ibxeInvalidBatchQuery,[GetSQLStatementTypeName]);
1339 +  end;
1340 + end;
1341 +
1342   procedure TFB30Statement.GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults
1343    );
1344   begin
1345 <  with Firebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
1345 >  with FFirebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
1346    begin
1347      StatementIntf.getInfo(StatusIntf,1,BytePtr(@info_request),
1348                       GetBufSize, BytePtr(Buffer));
# Line 970 | 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 Firebird30ClientAPI do
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
1381 <          FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1381 >          ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1382          FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf,
1383                              (FTransactionIntf as TFB30Transaction).TransactionIntf,
1384                              Length(FProcessedSQL),
# Line 1002 | 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 1018 | 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 1034 | Line 1446 | begin
1446        if (FStatementIntf <> nil) then
1447          FreeHandle;
1448        if E is EIBInterBaseError then
1449 <        raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
1450 <                                       EIBInterBaseError(E).IBErrorCode,
1039 <                                       EIBInterBaseError(E).Message +
1040 <                                       sSQLErrorSeparator + FSQL)
1041 <      else
1042 <        raise;
1449 >        E.Message := E.Message + sSQLErrorSeparator + FSQL;
1450 >      raise;
1451      end;
1452    end;
1453    FPrepared := true;
1454 +
1455    FSingleResults := false;
1456    if RetainInterfaces then
1457    begin
# Line 1060 | Line 1469 | begin
1469   end;
1470  
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 +      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;
1501 +  FBatchCompletion := nil;
1502    FBOF := false;
1503    FEOF := false;
1504    FSingleResults := false;
1505 +  FStatisticsAvailable := false;
1506 +  if IsInBatchMode then
1507 +    IBerror(ibxeInBatchMode,[]);
1508    CheckTransaction(aTransaction);
1509    if not FPrepared then
1510      InternalPrepare;
1511    CheckHandle;
1512    if aTransaction <> FTransactionIntf then
1513      AddMonitor(aTransaction as TFB30Transaction);
1514 <  if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1514 >  if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1515      IBError(ibxeInterfaceOutofDate,[nil]);
1516  
1517 +
1518    try
1519 <    with Firebird30ClientAPI do
1519 >    with FFirebird30ClientAPI do
1520      begin
1080      if FCollectStatistics then
1081      begin
1082        UtilIntf.getPerfCounters(StatusIntf,
1083                      (GetAttachment as TFB30Attachment).AttachmentIntf,
1084                      ISQL_COUNTERS,@FBeforeStats);
1085        Check4DataBaseError;
1086      end;
1087
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 <        FStatementIntf.execute(StatusIntf,
1535 <                               (aTransaction as TFB30Transaction).TransactionIntf,
1536 <                               FSQLParams.MetaData,
1537 <                               FSQLParams.MessageBuffer,
1538 <                               FSQLRecord.MetaData,
1539 <                               FSQLRecord.MessageBuffer);
1540 <        Check4DataBaseError;
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  
1102        Result := TResults.Create(FSQLRecord);
1103        FSingleResults := true;
1104      end
1545        else
1546 <        FStatementIntf.execute(StatusIntf,
1107 <                               (aTransaction as TFB30Transaction).TransactionIntf,
1108 <                               FSQLParams.MetaData,
1109 <                               FSQLParams.MessageBuffer,
1110 <                               nil,
1111 <                               nil);
1112 <        Check4DataBaseError;
1113 <      end;
1114 <      if FCollectStatistics then
1115 <      begin
1116 <        UtilIntf.getPerfCounters(StatusIntf,
1117 <                  (GetAttachment as TFB30Attachment).AttachmentIntf,
1118 <                  ISQL_COUNTERS, @FAfterStats);
1119 <        Check4DataBaseError;
1120 <        FStatisticsAvailable := true;
1546 >        ExecuteQuery;
1547        end;
1548      end;
1549    finally
# Line 1125 | Line 1551 | begin
1551         RemoveMonitor(aTransaction as TFB30Transaction);
1552    end;
1553    FExecTransactionIntf := aTransaction;
1554 +  FSQLRecord.FTransaction := (aTransaction as TFB30Transaction);
1555 +  FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1556    SignalActivity;
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 < CheckTransaction(aTransaction);
1570 >  FBatchCompletion := nil;
1571 >  CheckTransaction(aTransaction);
1572    if not FPrepared then
1573      InternalPrepare;
1574    CheckHandle;
1575    if aTransaction <> FTransactionIntf then
1576      AddMonitor(aTransaction as TFB30Transaction);
1577 <  if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1577 >  if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1578      IBError(ibxeInterfaceOutofDate,[nil]);
1579  
1580 < with Firebird30ClientAPI do
1580 > if Scrollable then
1581 >   flags := Firebird.IStatement.CURSOR_TYPE_SCROLLABLE;
1582 >
1583 > with FFirebird30ClientAPI do
1584   begin
1585     if FCollectStatistics then
1586     begin
# Line 1154 | 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 1184 | Line 1629 | begin
1629   Inc(FChangeSeqNo);
1630   end;
1631  
1632 + procedure TFB30Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean;
1633 +  var processedSQL: AnsiString);
1634 + begin
1635 +  FSQLParams.PreprocessSQL(sql,GenerateParamNames,processedSQL);
1636 + end;
1637 +
1638   procedure TFB30Statement.FreeHandle;
1639   begin
1640    Close;
1641    ReleaseInterfaces;
1642 +  if FBatch <> nil then
1643 +  begin
1644 +    FBatch.release;
1645 +    FBatch := nil;
1646 +  end;
1647    if FStatementIntf <> nil then
1648    begin
1649      FStatementIntf.release;
1650      FStatementIntf := nil;
1651      FPrepared := false;
1652    end;
1653 +  FCursor := '';
1654   end;
1655  
1656   procedure TFB30Statement.InternalClose(Force: boolean);
1657   begin
1658    if (FStatementIntf <> nil) and (SQLStatementType = SQLSelect) and FOpen then
1659    try
1660 <    with Firebird30ClientAPI do
1660 >    with FFirebird30ClientAPI do
1661      begin
1662        if FResultSet <> nil then
1663        begin
# Line 1224 | Line 1681 | begin
1681    Inc(FChangeSeqNo);
1682   end;
1683  
1684 + function TFB30Statement.SavePerfStats(var Stats: TPerfStatistics): boolean;
1685 + begin
1686 +  Result := false;
1687 +  if FCollectStatistics then
1688 +  with FFirebird30ClientAPI do
1689 +  begin
1690 +    UtilIntf.getPerfCounters(StatusIntf,
1691 +              (GetAttachment as TFB30Attachment).AttachmentIntf,
1692 +              ISQL_COUNTERS, @Stats);
1693 +    Check4DataBaseError;
1694 +    Result := true;
1695 +  end;
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);
1711 >  aSQLDialect: integer; GenerateParamNames: 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 1250 | 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]);
1259  if FEOF then
1260    IBError(ibxeEOF,[nil]);
1736  
1737 <  with Firebird30ClientAPI do
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;
1277 <      except
1278 <        Close;
1279 <        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
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 <      FBOF := false;
1793 <      result := true;
1792 >      UtilIntf.getPerfCounters(StatusIntf,
1793 >                              (GetAttachment as TFB30Attachment).AttachmentIntf,
1794 >                              ISQL_COUNTERS,@FAfterStats);
1795 >      Check4DataBaseError;
1796 >      FStatisticsAvailable := true;
1797      end;
1798    end;
1799    FSQLRecord.RowChange;
# Line 1315 | Line 1826 | begin
1826         SQLUpdate, SQLDelete])) then
1827      result := ''
1828    else
1829 <  with Firebird30ClientAPI do
1829 >  with FFirebird30ClientAPI do
1830    begin
1831      Result := FStatementIntf.getPlan(StatusIntf,true);
1832      Check4DataBaseError;
# Line 1349 | Line 1860 | begin
1860      TSQLParams(GetInterface(0)).RetainInterfaces := aValue;
1861   end;
1862  
1863 + function TFB30Statement.IsInBatchMode: boolean;
1864 + begin
1865 +  Result := FBatch <> nil;
1866 + end;
1867 +
1868 + function TFB30Statement.HasBatchMode: boolean;
1869 + begin
1870 +  Result := GetAttachment.HasBatchMode;
1871 + 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 +  inMetadata := FSQLParams.GetMetaData;
1886 +  try
1887 +    with FFirebird30ClientAPI do
1888 +    begin
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;
1916 +        end;
1917 +        FBatchRowCount := 0;
1918 +        FBatchBufferUsed := 0;
1919 +      end;
1920 +
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
1931 +    end;
1932 +  finally
1933 +    if inMetadata <> nil then
1934 +      inMetadata.release;
1935 +  end;
1936 + end;
1937 +
1938 + function TFB30Statement.ExecuteBatch(aTransaction: ITransaction
1939 +  ): IBatchCompletion;
1940 +
1941 + procedure Check4BatchCompletionError(bc: IBatchCompletion);
1942 + var status: IStatus;
1943 +    RowNo: integer;
1944 + begin
1945 +  status := nil;
1946 +  {Raise an exception if there was an error reported in the BatchCompletion}
1947 +  if (bc <> nil) and bc.getErrorStatus(RowNo,status) then
1948 +    raise EIBInterbaseError.Create(status);
1949 + end;
1950 +
1951 + var cs: Firebird.IBatchCompletionState;
1952 +
1953 + begin
1954 +  Result := nil;
1955 +  if FBatch = nil then
1956 +    IBError(ibxeNotInBatchMode,[]);
1957 +
1958 +  with FFirebird30ClientAPI do
1959 +  begin
1960 +    SavePerfStats(FBeforeStats);
1961 +    if aTransaction = nil then
1962 +      cs := FBatch.execute(StatusIntf,(FTransactionIntf as TFB30Transaction).TransactionIntf)
1963 +    else
1964 +      cs := FBatch.execute(StatusIntf,(aTransaction as TFB30Transaction).TransactionIntf);
1965 +    Check4DataBaseError;
1966 +    FBatchCompletion := TBatchCompletion.Create(FFirebird30ClientAPI,cs);
1967 +    FStatisticsAvailable := SavePerfStats(FAfterStats);
1968 +    FBatch.release;
1969 +    FBatch := nil;
1970 +    Check4BatchCompletionError(FBatchCompletion);
1971 +    Result := FBatchCompletion;
1972 +  end;
1973 + end;
1974 +
1975 + procedure TFB30Statement.CancelBatch;
1976 + begin
1977 +  if FBatch = nil then
1978 +    IBError(ibxeNotInBatchMode,[]);
1979 +  FBatch.release;
1980 +  FBatch := nil;
1981 + end;
1982 +
1983 + function TFB30Statement.GetBatchCompletion: IBatchCompletion;
1984 + begin
1985 +  Result := FBatchCompletion;
1986 + end;
1987 +
1988   function TFB30Statement.IsPrepared: boolean;
1989   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