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 309 by tony, Tue Jul 21 08:00:42 2020 UTC vs.
ibx/branches/udr/client/3.0/FB30Statement.pas (file contents), Revision 384 by tony, Mon Jan 17 09:52:58 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 89 | Line 88 | type
88      FStatement: TFB30Statement;
89      FFirebird30ClientAPI: TFB30ClientAPI;
90      FBlob: IBlob;             {Cache references}
92    FArray: IArray;
91      FNullIndicator: short;
92      FOwnsSQLData: boolean;
93      FBlobMetaData: IBlobMetaData;
# Line 100 | 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 108 | 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 116 | Line 116 | type
116       function GetRelationName: AnsiString;  override;
117       function GetScale: integer; override;
118       function GetCharSetID: cardinal; override;
119     function GetCodePage: TSystemCodePage; override;
120     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;
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;
130 <     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 153 | 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 <    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 176 | Line 183 | type
183  
184    TIBXINPUTSQLDA = class(TIBXSQLDA)
185    private
179    FMessageBuffer: PByte; {Message Buffer}
180    FMsgLength: integer; {Message Buffer length}
186      FCurMetaData: Firebird.IMessageMetadata;
187 <    procedure FreeMessageBuffer;
187 >    procedure FreeCurMetaData;
188      function GetMessageBuffer: PByte;
184    function GetMetaData: Firebird.IMessageMetadata;
189      function GetModified: Boolean;
190      function GetMsgLength: integer;
191      procedure BuildMetadata;
188    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;
197    property MetaData: Firebird.IMessageMetadata read GetMetaData;
204      property MessageBuffer: PByte read GetMessageBuffer;
205      property MsgLength: integer read GetMsgLength;
206    end;
# Line 204 | Line 210 | type
210    TIBXOUTPUTSQLDA = class(TIBXSQLDA)
211    private
212      FTransaction: TFB30Transaction; {transaction used to execute the statement}
207    FMessageBuffer: PByte; {Message Buffer}
208    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 223 | 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)
# Line 244 | 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;
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;
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 269 | 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
# Line 282 | Line 331 | uses IBUtils, FBMessages, FBBlob, FB30Bl
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 290 | 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 301 | 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 315 | 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 335 | 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 350 | Line 597 | begin
597      else
598        result := FCharSetID;
599    end;
353  result := result;
354 end;
355
356 function TIBXSQLVAR.GetCodePage: TSystemCodePage;
357 begin
358  result := CP_NONE;
359  with Statement.GetAttachment do
360     CharSetID2CodePage(GetCharSetID,result);
361 end;
362
363 function TIBXSQLVAR.GetCharSetWidth: integer;
364 begin
365  result := 1;
366  with Statement.GetAttachment DO
367    CharSetWidth(GetCharSetID,result);
600   end;
601  
602   function TIBXSQLVAR.GetIsNull: Boolean;
# Line 387 | 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 405 | 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 449 | 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 466 | Line 703 | begin
703    Changed;
704   end;
705  
706 < procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
706 > procedure TIBXSQLVAR.InternalSetSQLType(aValue: cardinal);
707   begin
708    FSQLType := aValue;
709    Changed;
# Line 478 | Line 715 | begin
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);
# Line 489 | Line 738 | procedure TIBXSQLVAR.RowChange;
738   begin
739    inherited;
740    FBlob := nil;
492  FArray := nil;
741   end;
742  
743   procedure TIBXSQLVAR.FreeSQLData;
# Line 500 | 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 509 | 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 528 | 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 538 | 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 559 | Line 814 | begin
814   end;
815  
816   function TResultSet.FetchNext: boolean;
562 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]);
574 <  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 605 | 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;
615  if FMessageBuffer <> nil then
616  begin
617    FreeMem(FMessageBuffer);
618    FMessageBuffer := nil;
619  end;
620  FMsgLength := 0;
907   end;
908  
909   function TIBXINPUTSQLDA.GetMessageBuffer: PByte;
# Line 630 | 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 641 | Line 929 | end;
929   procedure TIBXINPUTSQLDA.BuildMetadata;
930   var Builder: Firebird.IMetadataBuilder;
931      i: integer;
932 +    version: NativeInt;
933   begin
934 <  if FCurMetaData = nil then
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 672 | Line 980 | end;
980  
981   procedure TIBXINPUTSQLDA.PackBuffer;
982   var i: integer;
983 +    P: PByte;
984 +    MsgLen: cardinal;
985 +    aNullIndicator: short;
986   begin
987    BuildMetadata;
988  
989 <  if FMsgLength = 0 then
989 >  if (FMsgLength = 0) and (FCurMetaData <> nil) then
990    with FFirebird30ClientAPI do
991    begin
992 <    FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
992 >    MsgLen := FCurMetaData.getMessageLength(StatusIntf);
993      Check4DataBaseError;
994  
995 <    IBAlloc(FMessageBuffer,0,FMsgLength);
995 >    AllocMessageBuffer(MsgLen);
996  
997      for i := 0 to Count - 1 do
998      with TIBXSQLVar(Column[i]) do
999      begin
1000 +      P := FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i);
1001 + //     writeln('Packbuffer: Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength);
1002        if not Modified then
1003          IBError(ibxeUninitializedInputParameter,[i,Name]);
691
1004        if IsNull then
1005 <        FillChar((FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength,0)
1005 >        FillChar(P^,FDataLength,0)
1006        else
1007        if FSQLData <> nil then
1008 <        Move(FSQLData^,(FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength);
1009 <      Check4DataBaseError;
1008 >      begin
1009 >        if SQLType = SQL_VARYING then
1010 >        begin
1011 >            EncodeInteger(FDataLength,2,P);
1012 >            Inc(P,2);
1013 >        end
1014 >        else
1015 >        if (SQLType = SQL_BLOB) and (FStatement.FBatch <> nil) then
1016 >        begin
1017 >          FStatement.FBatch.registerBlob(Statusintf,ISC_QUADPtr(FSQLData),ISC_QUADPtr(FSQLData));
1018 >          Check4DatabaseError;
1019 >        end;
1020 >        Move(FSQLData^,P^,FDataLength);
1021 >      end;
1022        if IsNullable then
1023        begin
1024          Move(FNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(FNullIndicator));
1025          Check4DataBaseError;
1026 +      end
1027 +      else
1028 +      begin
1029 +        aNullIndicator := 0;
1030 +        Move(aNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(aNullIndicator));
1031        end;
1032      end;
1033    end;
# Line 707 | Line 1036 | end;
1036   procedure TIBXINPUTSQLDA.FreeXSQLDA;
1037   begin
1038    inherited FreeXSQLDA;
1039 <  FreeMessageBuffer;
1039 >  FreeCurMetaData;
1040   end;
1041  
1042   constructor TIBXINPUTSQLDA.Create(aStatement: TFB30Statement);
# Line 716 | Line 1045 | begin
1045    FMessageBuffer := nil;
1046   end;
1047  
1048 + constructor TIBXINPUTSQLDA.Create(api: IFirebirdAPI);
1049 + begin
1050 +  inherited Create(api);
1051 +  FMessageBuffer := nil;
1052 + end;
1053 +
1054   destructor TIBXINPUTSQLDA.Destroy;
1055   begin
1056 <  FreeMessageBuffer;
1056 >  FreeXSQLDA;
1057    inherited Destroy;
1058   end;
1059  
# Line 726 | Line 1061 | procedure TIBXINPUTSQLDA.Bind(aMetaData:
1061   var i: integer;
1062   begin
1063    FMetaData := aMetaData;
1064 +  FMetaData.AddRef;
1065    with FFirebird30ClientAPI do
1066    begin
1067 <    Count := metadata.getCount(StatusIntf);
1067 >    Count := aMetadata.getCount(StatusIntf);
1068      Check4DataBaseError;
1069      Initialize;
1070  
1071      for i := 0 to Count - 1 do
1072      with TIBXSQLVar(Column[i]) do
1073      begin
1074 <      FSQLType := aMetaData.getType(StatusIntf,i);
1075 <      Check4DataBaseError;
740 <      if FSQLType = SQL_BLOB then
741 <      begin
742 <        FSQLSubType := aMetaData.getSubType(StatusIntf,i);
743 <        Check4DataBaseError;
744 <      end
745 <      else
746 <        FSQLSubType := 0;
747 <      FDataLength := aMetaData.getLength(StatusIntf,i);
748 <      Check4DataBaseError;
749 <      case SQLType of
750 <        SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
751 <        SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
752 <        SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
753 <        begin
754 <          if (FDataLength = 0) then
755 <            { Make sure you get a valid pointer anyway
756 <             select '' from foo }
757 <            IBAlloc(FSQLData, 0, 1)
758 <          else
759 <            IBAlloc(FSQLData, 0, FDataLength)
760 <        end;
761 <        SQL_VARYING:
762 <          IBAlloc(FSQLData, 0, FDataLength + 2);
763 <       else
764 <          IBError(ibxeUnknownSQLDataType, [sqltype and (not 1)])
765 <      end;
766 <      FNullable := aMetaData.isNullable(StatusIntf,i);
767 <      FOwnsSQLData := true;
768 <      Check4DataBaseError;
769 <      FNullIndicator := -1;
1074 >      InitColumnMetaData(aMetaData);
1075 >      SaveMetaData;
1076        if FNullable then
1077          FSQLNullIndicator := @FNullIndicator
1078        else
1079          FSQLNullIndicator := nil;
1080 <      FScale := aMetaData.getScale(StatusIntf,i);
775 <      Check4DataBaseError;
776 <      FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
777 <      Check4DataBaseError;
1080 >      ColumnSQLDataInit;
1081      end;
1082    end;
1083   end;
# Line 782 | Line 1085 | end;
1085   procedure TIBXINPUTSQLDA.Changed;
1086   begin
1087    inherited Changed;
1088 +  FreeCurMetaData;
1089    FreeMessageBuffer;
1090   end;
1091  
1092 + procedure TIBXINPUTSQLDA.ReInitialise;
1093 + var i: integer;
1094 + begin
1095 +  FreeMessageBuffer;
1096 +  for i := 0 to Count - 1 do
1097 +    TIBXSQLVar(Column[i]).ColumnSQLDataInit;
1098 + end;
1099 +
1100   function TIBXINPUTSQLDA.IsInputDataArea: boolean;
1101   begin
1102    Result := true;
# Line 792 | Line 1104 | end;
1104  
1105   { TIBXOUTPUTSQLDA }
1106  
1107 < procedure TIBXOUTPUTSQLDA.FreeXSQLDA;
1107 > function TIBXOUTPUTSQLDA.GetTransaction: ITransaction;
1108   begin
1109 <  inherited FreeXSQLDA;
1110 <  FreeMem(FMessageBuffer);
1111 <  FMessageBuffer := nil;
1112 <  FMsgLength := 0;
1109 >  if FTransaction <> nil then
1110 >    Result := FTransaction
1111 >  else
1112 >    Result := inherited GetTransaction;
1113   end;
1114  
1115   procedure TIBXOUTPUTSQLDA.Bind(aMetaData: Firebird.IMessageMetadata);
1116   var i: integer;
1117 +    MsgLen: cardinal;
1118   begin
1119    FMetaData := aMetaData;
1120 +  FMetaData.AddRef;
1121    with FFirebird30ClientAPI do
1122    begin
1123 <    Count := metadata.getCount(StatusIntf);
1123 >    Count := aMetaData.getCount(StatusIntf);
1124      Check4DataBaseError;
1125      Initialize;
1126  
1127 <    FMsgLength := metaData.getMessageLength(StatusIntf);
1127 >    MsgLen := aMetaData.getMessageLength(StatusIntf);
1128      Check4DataBaseError;
1129 <    IBAlloc(FMessageBuffer,0,FMsgLength);
1129 >    AllocMessageBuffer(MsgLen);
1130  
1131      for i := 0 to Count - 1 do
1132      with TIBXSQLVar(Column[i]) do
1133      begin
1134 <      FSQLType := aMetaData.getType(StatusIntf,i);
1135 <      Check4DataBaseError;
822 <      if FSQLType = SQL_BLOB then
823 <      begin
824 <        FSQLSubType := aMetaData.getSubType(StatusIntf,i);
825 <        Check4DataBaseError;
826 <      end
827 <      else
828 <        FSQLSubType := 0;
829 <      FBlob := nil;
830 <      FArray := nil;
831 <      FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i);
832 <      Check4DataBaseError;
833 <      FDataLength := aMetaData.getLength(StatusIntf,i);
834 <      Check4DataBaseError;
835 <      FRelationName := strpas(aMetaData.getRelation(StatusIntf,i));
836 <      Check4DataBaseError;
837 <      FFieldName := strpas(aMetaData.getField(StatusIntf,i));
838 <      Check4DataBaseError;
839 <      FNullable := aMetaData.isNullable(StatusIntf,i);
1134 >      InitColumnMetaData(aMetaData);
1135 >      FSQLData := FMessageBuffer + aMetaData.getOffset(StatusIntf,i);
1136        Check4DataBaseError;
1137        if FNullable then
1138        begin
# Line 845 | Line 1141 | begin
1141        end
1142        else
1143          FSQLNullIndicator := nil;
1144 <      FScale := aMetaData.getScale(StatusIntf,i);
1145 <      Check4DataBaseError;
850 <      FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
851 <      Check4DataBaseError;
1144 >      FBlob := nil;
1145 >      FArrayIntf := nil;
1146      end;
1147    end;
1148    SetUniqueRelationName;
# Line 886 | Line 1180 | begin
1180   //  writeln('Creating ',ClassName);
1181   end;
1182  
1183 + constructor TIBXSQLDA.Create(api: IFirebirdAPI);
1184 + begin
1185 +  inherited Create;
1186 +  FStatement := nil;
1187 +  FSize := 0;
1188 +  FFirebird30ClientAPI := api as TFB30ClientAPI;
1189 + end;
1190 +
1191   destructor TIBXSQLDA.Destroy;
1192   begin
1193    FreeXSQLDA;
# Line 901 | Line 1203 | end;
1203   function TIBXSQLDA.CheckStatementStatus(Request: TStatementStatus): boolean;
1204   begin
1205    Result := false;
1206 +  if FStatement <> nil then
1207    case Request of
1208    ssPrepared:
1209      Result := FStatement.IsPrepared;
1210  
1211    ssExecuteResults:
1212 <    Result :=FStatement.FSingleResults;
1212 >    Result := FStatement.FSingleResults;
1213  
1214    ssCursorOpen:
1215      Result := FStatement.FOpen;
# Line 924 | Line 1227 | begin
1227    Result := FCount;
1228   end;
1229  
927 function TIBXSQLDA.GetTransaction: TFB30Transaction;
928 begin
929  Result := FStatement.GetTransaction as TFB30Transaction;
930 end;
931
1230   procedure TIBXSQLDA.Initialize;
1231   begin
1232    if FMetaData <> nil then
# Line 937 | Line 1235 | end;
1235  
1236   function TIBXSQLDA.StateChanged(var ChangeSeqNo: integer): boolean;
1237   begin
1238 <  Result := FStatement.ChangeSeqNo <> ChangeSeqNo;
1238 >  Result := (FStatement <> nil) and (FStatement.ChangeSeqNo <> ChangeSeqNo);
1239    if Result then
1240      ChangeSeqNo := FStatement.ChangeSeqNo;
1241   end;
1242  
1243 + function TIBXSQLDA.CanChangeMetaData: boolean;
1244 + begin
1245 +  Result := FStatement.FBatch = nil;
1246 + end;
1247 +
1248   procedure TIBXSQLDA.SetCount(Value: Integer);
1249   var
1250    i: Integer;
# Line 958 | Line 1261 | begin
1261    end;
1262   end;
1263  
1264 + procedure TIBXSQLDA.AllocMessageBuffer(len: integer);
1265 + begin
1266 +  with FFirebird30ClientAPI do
1267 +    IBAlloc(FMessageBuffer,0,len);
1268 +  FMsgLength := len;
1269 + end;
1270 +
1271 + procedure TIBXSQLDA.FreeMessageBuffer;
1272 + begin
1273 +  if FMessageBuffer <> nil then
1274 +  begin
1275 +    FreeMem(FMessageBuffer);
1276 +    FMessageBuffer := nil;
1277 +  end;
1278 +  FMsgLength := 0;
1279 + end;
1280 +
1281 + function TIBXSQLDA.GetMetaData: Firebird.IMessageMetadata;
1282 + begin
1283 +  Result := FMetadata;
1284 +  if Result <> nil then
1285 +    Result.addRef;
1286 + end;
1287 +
1288   function TIBXSQLDA.GetTransactionSeqNo: integer;
1289   begin
1290    Result := FTransactionSeqNo;
# Line 973 | Line 1300 | begin
1300      TIBXSQLVAR(Column[i]).FreeSQLData;
1301    for i := 0 to FSize - 1  do
1302      TIBXSQLVAR(Column[i]).Free;
1303 +  FCount := 0;
1304    SetLength(FColumnList,0);
1305    FSize := 0;
1306 +  FreeMessageBuffer;
1307   end;
1308  
1309   function TIBXSQLDA.GetStatement: IStatement;
# Line 984 | Line 1313 | end;
1313  
1314   function TIBXSQLDA.GetPrepareSeqNo: integer;
1315   begin
1316 <  Result := FStatement.FPrepareSeqNo;
1316 >  if FStatement = nil then
1317 >    Result := 0
1318 >  else
1319 >    Result := FStatement.FPrepareSeqNo;
1320   end;
1321  
1322   { TFB30Statement }
1323  
1324 + procedure TFB30Statement.CheckChangeBatchRowLimit;
1325 + begin
1326 +  if IsInBatchMode then
1327 +    IBError(ibxeInBatchMode,[nil]);
1328 + end;
1329 +
1330   procedure TFB30Statement.CheckHandle;
1331   begin
1332    if FStatementIntf = nil then
1333      IBError(ibxeInvalidStatementHandle,[nil]);
1334   end;
1335  
1336 + procedure TFB30Statement.CheckBatchModeAvailable;
1337 + begin
1338 +  if not HasBatchMode then
1339 +    IBError(ibxeBatchModeNotSupported,[nil]);
1340 +  case SQLStatementType of
1341 +  SQLInsert,
1342 +  SQLUpdate: {OK};
1343 +  else
1344 +     IBError(ibxeInvalidBatchQuery,[GetSQLStatementTypeName]);
1345 +  end;
1346 + end;
1347 +
1348   procedure TFB30Statement.GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults
1349    );
1350   begin
# Line 1006 | Line 1356 | begin
1356    end;
1357   end;
1358  
1359 < procedure TFB30Statement.InternalPrepare;
1359 > function TFB30Statement.GetStatementIntf: IStatement;
1360 > begin
1361 >  Result := self;
1362 > end;
1363 >
1364 > procedure TFB30Statement.InternalPrepare(CursorName: AnsiString);
1365 > var GUID : TGUID;
1366 >    metadata: Firebird.IMessageMetadata;
1367   begin
1368    if FPrepared then
1369      Exit;
1370 +
1371 +  FCursor := CursorName;
1372    if (FSQL = '') then
1373      IBError(ibxeEmptyQuery, [nil]);
1374    try
1375      CheckTransaction(FTransactionIntf);
1376      with FFirebird30ClientAPI do
1377      begin
1378 +      if FCursor = '' then
1379 +      begin
1380 +        CreateGuid(GUID);
1381 +        FCursor := GUIDToString(GUID);
1382 +      end;
1383 +
1384        if FHasParamNames then
1385        begin
1386          if FProcessedSQL = '' then
# Line 1038 | Line 1403 | begin
1403        FSQLStatementType := TIBSQLStatementTypes(FStatementIntf.getType(StatusIntf));
1404        Check4DataBaseError;
1405  
1406 +      if FSQLStatementType = SQLSelect then
1407 +      begin
1408 +        FStatementIntf.setCursorName(StatusIntf,PAnsiChar(FCursor));
1409 +        Check4DataBaseError;
1410 +      end;
1411        { Done getting the type }
1412        case FSQLStatementType of
1413          SQLGetSegment,
# Line 1054 | Line 1424 | begin
1424          SQLExecProcedure:
1425          begin
1426            {set up input sqlda}
1427 <          FSQLParams.Bind(FStatementIntf.getInputMetadata(StatusIntf));
1427 >          metadata := FStatementIntf.getInputMetadata(StatusIntf);
1428            Check4DataBaseError;
1429 +          try
1430 +            FSQLParams.Bind(metadata);
1431 +          finally
1432 +            metadata.release;
1433 +          end;
1434  
1435            {setup output sqlda}
1436            if FSQLStatementType in [SQLSelect, SQLSelectForUpdate,
1437                            SQLExecProcedure] then
1438 <            FSQLRecord.Bind(FStatementIntf.getOutputMetadata(StatusIntf));
1439 <          Check4DataBaseError;
1438 >          begin
1439 >            metadata := FStatementIntf.getOutputMetadata(StatusIntf);
1440 >            Check4DataBaseError;
1441 >            try
1442 >              FSQLRecord.Bind(metadata);
1443 >            finally
1444 >              metadata.release;
1445 >            end;
1446 >          end;
1447          end;
1448        end;
1449      end;
# Line 1070 | Line 1452 | begin
1452        if (FStatementIntf <> nil) then
1453          FreeHandle;
1454        if E is EIBInterBaseError then
1455 <        raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
1456 <                                       EIBInterBaseError(E).IBErrorCode,
1075 <                                       EIBInterBaseError(E).Message +
1076 <                                       sSQLErrorSeparator + FSQL)
1077 <      else
1078 <        raise;
1455 >        E.Message := E.Message + sSQLErrorSeparator + FSQL;
1456 >      raise;
1457      end;
1458    end;
1459    FPrepared := true;
1460 +
1461    FSingleResults := false;
1462    if RetainInterfaces then
1463    begin
# Line 1096 | Line 1475 | begin
1475   end;
1476  
1477   function TFB30Statement.InternalExecute(aTransaction: ITransaction): IResults;
1478 +
1479 +  procedure ExecuteQuery(outMetaData: Firebird.IMessageMetaData=nil; outBuffer: pointer=nil);
1480 +  var inMetadata: Firebird.IMessageMetaData;
1481 +  begin
1482 +    with FFirebird30ClientAPI do
1483 +    begin
1484 +      SavePerfStats(FBeforeStats);
1485 +      inMetadata := FSQLParams.GetMetaData;
1486 +      try
1487 +        FStatementIntf.execute(StatusIntf,
1488 +                               (aTransaction as TFB30Transaction).TransactionIntf,
1489 +                               inMetaData,
1490 +                               FSQLParams.MessageBuffer,
1491 +                               outMetaData,
1492 +                               outBuffer);
1493 +        Check4DataBaseError;
1494 +      finally
1495 +        if inMetadata <> nil then
1496 +          inMetadata.release;
1497 +      end;
1498 +      FStatisticsAvailable := SavePerfStats(FAfterStats);
1499 +    end;
1500 +  end;
1501 +
1502 + var Cursor: IResultSet;
1503 +    outMetadata: Firebird.IMessageMetaData;
1504 +
1505   begin
1506    Result := nil;
1507 +  FBatchCompletion := nil;
1508    FBOF := false;
1509    FEOF := false;
1510    FSingleResults := false;
1511 +  FStatisticsAvailable := false;
1512 +  if IsInBatchMode then
1513 +    IBerror(ibxeInBatchMode,[]);
1514    CheckTransaction(aTransaction);
1515    if not FPrepared then
1516      InternalPrepare;
1517    CheckHandle;
1518    if aTransaction <> FTransactionIntf then
1519      AddMonitor(aTransaction as TFB30Transaction);
1520 <  if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1520 >  if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1521      IBError(ibxeInterfaceOutofDate,[nil]);
1522  
1523 +
1524    try
1525      with FFirebird30ClientAPI do
1526      begin
1116      if FCollectStatistics then
1117      begin
1118        UtilIntf.getPerfCounters(StatusIntf,
1119                      (GetAttachment as TFB30Attachment).AttachmentIntf,
1120                      ISQL_COUNTERS,@FBeforeStats);
1121        Check4DataBaseError;
1122      end;
1123
1527        case FSQLStatementType of
1528        SQLSelect:
1529 <        IBError(ibxeIsAExecuteProcedure,[]);
1529 >       {e.g. Update...returning with a single row in Firebird 5 and later}
1530 >      begin
1531 >        Cursor := InternalOpenCursor(aTransaction,false);
1532 >        if not Cursor.IsEof then
1533 >          Cursor.FetchNext;
1534 >        Result := Cursor; {note only first row}
1535 >        FSingleResults := true;
1536 >      end;
1537  
1538        SQLExecProcedure:
1539        begin
1540 <        FStatementIntf.execute(StatusIntf,
1541 <                               (aTransaction as TFB30Transaction).TransactionIntf,
1542 <                               FSQLParams.MetaData,
1543 <                               FSQLParams.MessageBuffer,
1544 <                               FSQLRecord.MetaData,
1545 <                               FSQLRecord.MessageBuffer);
1546 <        Check4DataBaseError;
1540 >        outMetadata := FSQLRecord.GetMetaData;
1541 >        try
1542 >          ExecuteQuery(outMetadata,FSQLRecord.MessageBuffer);
1543 >          Result := TResults.Create(FSQLRecord);
1544 >          FSingleResults := true;
1545 >        finally
1546 >          if outMetadata <> nil then
1547 >            outMetadata.release;
1548 >        end;
1549 >      end;
1550  
1138        Result := TResults.Create(FSQLRecord);
1139        FSingleResults := true;
1140      end
1551        else
1552 <        FStatementIntf.execute(StatusIntf,
1143 <                               (aTransaction as TFB30Transaction).TransactionIntf,
1144 <                               FSQLParams.MetaData,
1145 <                               FSQLParams.MessageBuffer,
1146 <                               nil,
1147 <                               nil);
1148 <        Check4DataBaseError;
1149 <      end;
1150 <      if FCollectStatistics then
1151 <      begin
1152 <        UtilIntf.getPerfCounters(StatusIntf,
1153 <                  (GetAttachment as TFB30Attachment).AttachmentIntf,
1154 <                  ISQL_COUNTERS, @FAfterStats);
1155 <        Check4DataBaseError;
1156 <        FStatisticsAvailable := true;
1552 >        ExecuteQuery;
1553        end;
1554      end;
1555    finally
# Line 1167 | Line 1563 | begin
1563    Inc(FChangeSeqNo);
1564   end;
1565  
1566 < function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction
1567 <  ): IResultSet;
1566 > function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction;
1567 >  Scrollable: boolean): IResultSet;
1568 > var flags: cardinal;
1569 >    inMetadata,
1570 >    outMetadata: Firebird.IMessageMetadata;
1571   begin
1572 <  if FSQLStatementType <> SQLSelect then
1572 >  flags := 0;
1573 >  if (FSQLStatementType <> SQLSelect) and not (stHasCursor in getFlags) then
1574     IBError(ibxeIsASelectStatement,[]);
1575  
1576 < CheckTransaction(aTransaction);
1576 >  FBatchCompletion := nil;
1577 >  CheckTransaction(aTransaction);
1578    if not FPrepared then
1579      InternalPrepare;
1580    CheckHandle;
1581    if aTransaction <> FTransactionIntf then
1582      AddMonitor(aTransaction as TFB30Transaction);
1583 <  if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1583 >  if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1584      IBError(ibxeInterfaceOutofDate,[nil]);
1585  
1586 + if Scrollable then
1587 +   flags := Firebird.IStatement.CURSOR_TYPE_SCROLLABLE;
1588 +
1589   with FFirebird30ClientAPI do
1590   begin
1591     if FCollectStatistics then
# Line 1192 | Line 1596 | begin
1596       Check4DataBaseError;
1597     end;
1598  
1599 <   FResultSet := FStatementIntf.openCursor(StatusIntf,
1599 >   inMetadata := FSQLParams.GetMetaData;
1600 >   outMetadata := FSQLRecord.GetMetaData;
1601 >   try
1602 >     FResultSet := FStatementIntf.openCursor(StatusIntf,
1603                            (aTransaction as TFB30Transaction).TransactionIntf,
1604 <                          FSQLParams.MetaData,
1604 >                          inMetaData,
1605                            FSQLParams.MessageBuffer,
1606 <                          FSQLRecord.MetaData,
1607 <                          0);
1608 <   Check4DataBaseError;
1606 >                          outMetaData,
1607 >                          flags);
1608 >     Check4DataBaseError;
1609 >   finally
1610 >     if inMetadata <> nil then
1611 >       inMetadata.release;
1612 >     if outMetadata <> nil then
1613 >       outMetadata.release;
1614 >   end;
1615  
1616     if FCollectStatistics then
1617     begin
# Line 1232 | Line 1645 | procedure TFB30Statement.FreeHandle;
1645   begin
1646    Close;
1647    ReleaseInterfaces;
1648 +  if FBatch <> nil then
1649 +  begin
1650 +    FBatch.release;
1651 +    FBatch := nil;
1652 +  end;
1653    if FStatementIntf <> nil then
1654    begin
1655      FStatementIntf.release;
1656      FStatementIntf := nil;
1657      FPrepared := false;
1658    end;
1659 +  FCursor := '';
1660   end;
1661  
1662   procedure TFB30Statement.InternalClose(Force: boolean);
# Line 1268 | Line 1687 | begin
1687    Inc(FChangeSeqNo);
1688   end;
1689  
1690 + function TFB30Statement.SavePerfStats(var Stats: TPerfStatistics): boolean;
1691 + begin
1692 +  Result := false;
1693 +  if FCollectStatistics then
1694 +  with FFirebird30ClientAPI do
1695 +  begin
1696 +    UtilIntf.getPerfCounters(StatusIntf,
1697 +              (GetAttachment as TFB30Attachment).AttachmentIntf,
1698 +              ISQL_COUNTERS, @Stats);
1699 +    Check4DataBaseError;
1700 +    Result := true;
1701 +  end;
1702 + end;
1703 +
1704   constructor TFB30Statement.Create(Attachment: TFB30Attachment;
1705 <  Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1705 >  Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1706 >  CursorName: AnsiString);
1707   begin
1708    inherited Create(Attachment,Transaction,sql,aSQLDialect);
1709    FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1710    FSQLParams := TIBXINPUTSQLDA.Create(self);
1711    FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1712 <  InternalPrepare;
1712 >  InternalPrepare(CursorName);
1713   end;
1714  
1715   constructor TFB30Statement.CreateWithParameterNames(
1716    Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString;
1717    aSQLDialect: integer; GenerateParamNames: boolean;
1718 <  CaseSensitiveParams: boolean);
1718 >  CaseSensitiveParams: boolean; CursorName: AnsiString);
1719   begin
1720    inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1721    FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1722    FSQLParams := TIBXINPUTSQLDA.Create(self);
1723    FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1724    FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1725 <  InternalPrepare;
1725 >  InternalPrepare(CursorName);
1726   end;
1727  
1728   destructor TFB30Statement.Destroy;
# Line 1298 | Line 1732 | begin
1732    if assigned(FSQLRecord) then FSQLRecord.Free;
1733   end;
1734  
1735 < function TFB30Statement.FetchNext: boolean;
1735 > function TFB30Statement.Fetch(FetchType: TFetchType; PosOrOffset: integer
1736 >  ): boolean;
1737   var fetchResult: integer;
1738   begin
1739 <  result := false;
1739 >    result := false;
1740    if not FOpen then
1741      IBError(ibxeSQLClosed, [nil]);
1307  if FEOF then
1308    IBError(ibxeEOF,[nil]);
1742  
1743    with FFirebird30ClientAPI do
1744    begin
1745 <    { Go to the next record... }
1746 <    fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1747 <    if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1748 <    begin
1749 <      FBOF := false;
1750 <      FEOF := true;
1751 <      Exit; {End of File}
1752 <    end
1753 <    else
1754 <    if fetchResult <> Firebird.IStatus.RESULT_OK then
1755 <    begin
1756 <      try
1757 <        IBDataBaseError;
1325 <      except
1326 <        Close;
1327 <        raise;
1745 >    case FetchType of
1746 >    ftNext:
1747 >      begin
1748 >        if FEOF then
1749 >          IBError(ibxeEOF,[nil]);
1750 >        { Go to the next record... }
1751 >        fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1752 >        if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1753 >        begin
1754 >          FBOF := false;
1755 >          FEOF := true;
1756 >          Exit; {End of File}
1757 >        end
1758        end;
1759 <    end
1760 <    else
1761 <    begin
1762 <      FBOF := false;
1763 <      result := true;
1759 >
1760 >    ftPrior:
1761 >      begin
1762 >        if FBOF then
1763 >          IBError(ibxeBOF,[nil]);
1764 >        { Go to the next record... }
1765 >        fetchResult := FResultSet.fetchPrior(StatusIntf,FSQLRecord.MessageBuffer);
1766 >        if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1767 >        begin
1768 >          FBOF := true;
1769 >          FEOF := false;
1770 >          Exit; {Top of File}
1771 >        end
1772 >      end;
1773 >
1774 >    ftFirst:
1775 >      fetchResult := FResultSet.fetchFirst(StatusIntf,FSQLRecord.MessageBuffer);
1776 >
1777 >    ftLast:
1778 >      fetchResult := FResultSet.fetchLast(StatusIntf,FSQLRecord.MessageBuffer);
1779 >
1780 >    ftAbsolute:
1781 >      fetchResult := FResultSet.fetchAbsolute(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1782 >
1783 >    ftRelative:
1784 >      fetchResult := FResultSet.fetchRelative(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1785      end;
1786 +
1787 +    Check4DataBaseError;
1788 +    if fetchResult <> Firebird.IStatus.RESULT_OK then
1789 +      exit; {result = false}
1790 +
1791 +    {Result OK}
1792 +    FBOF := false;
1793 +    FEOF := false;
1794 +    result := true;
1795 +
1796      if FCollectStatistics then
1797      begin
1798        UtilIntf.getPerfCounters(StatusIntf,
# Line 1405 | Line 1866 | begin
1866      TSQLParams(GetInterface(0)).RetainInterfaces := aValue;
1867   end;
1868  
1869 + function TFB30Statement.IsInBatchMode: boolean;
1870 + begin
1871 +  Result := FBatch <> nil;
1872 + end;
1873 +
1874 + function TFB30Statement.HasBatchMode: boolean;
1875 + begin
1876 +  Result := GetAttachment.HasBatchMode;
1877 + end;
1878 +
1879 + procedure TFB30Statement.AddToBatch;
1880 + var BatchPB: TXPBParameterBlock;
1881 +    inMetadata: Firebird.IMessageMetadata;
1882 +
1883 + const SixteenMB = 16 * 1024 * 1024;
1884 +      MB256 = 256* 1024 *1024;
1885 + begin
1886 +  FBatchCompletion := nil;
1887 +  if not FPrepared then
1888 +    InternalPrepare;
1889 +  CheckHandle;
1890 +  CheckBatchModeAvailable;
1891 +  inMetadata := FSQLParams.GetMetaData;
1892 +  try
1893 +    with FFirebird30ClientAPI do
1894 +    begin
1895 +      if FBatch = nil then
1896 +      begin
1897 +        {Start Batch}
1898 +        BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH);
1899 +        with FFirebird30ClientAPI do
1900 +        try
1901 +          if FBatchRowLimit = maxint then
1902 +            FBatchBufferSize := MB256
1903 +          else
1904 +          begin
1905 +            FBatchBufferSize := FBatchRowLimit * inMetadata.getAlignedLength(StatusIntf);
1906 +            Check4DatabaseError;
1907 +            if FBatchBufferSize < SixteenMB then
1908 +              FBatchBufferSize := SixteenMB;
1909 +            if FBatchBufferSize > MB256 {assumed limit} then
1910 +              IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]);
1911 +          end;
1912 +          BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1);
1913 +          BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize);
1914 +          FBatch := FStatementIntf.createBatch(StatusIntf,
1915 +                                               inMetadata,
1916 +                                               BatchPB.getDataLength,
1917 +                                               BatchPB.getBuffer);
1918 +          Check4DataBaseError;
1919 +
1920 +        finally
1921 +          BatchPB.Free;
1922 +        end;
1923 +        FBatchRowCount := 0;
1924 +        FBatchBufferUsed := 0;
1925 +      end;
1926 +
1927 +      Inc(FBatchRowCount);
1928 +      Inc(FBatchBufferUsed,inMetadata.getAlignedLength(StatusIntf));
1929 +      Check4DataBaseError;
1930 +      if FBatchBufferUsed > FBatchBufferSize then
1931 +        raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow),
1932 +                                Format(GetErrorMessage(ibxeBatchRowBufferOverflow),
1933 +                                [FBatchRowCount,FBatchBufferSize]));
1934 +
1935 +      FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer);
1936 +        Check4DataBaseError
1937 +    end;
1938 +  finally
1939 +    if inMetadata <> nil then
1940 +      inMetadata.release;
1941 +  end;
1942 + end;
1943 +
1944 + function TFB30Statement.ExecuteBatch(aTransaction: ITransaction
1945 +  ): IBatchCompletion;
1946 +
1947 + procedure Check4BatchCompletionError(bc: IBatchCompletion);
1948 + var status: IStatus;
1949 +    RowNo: integer;
1950 + begin
1951 +  status := nil;
1952 +  {Raise an exception if there was an error reported in the BatchCompletion}
1953 +  if (bc <> nil) and bc.getErrorStatus(RowNo,status) then
1954 +    raise EIBInterbaseError.Create(status);
1955 + end;
1956 +
1957 + var cs: Firebird.IBatchCompletionState;
1958 +
1959 + begin
1960 +  Result := nil;
1961 +  if FBatch = nil then
1962 +    IBError(ibxeNotInBatchMode,[]);
1963 +
1964 +  with FFirebird30ClientAPI do
1965 +  begin
1966 +    SavePerfStats(FBeforeStats);
1967 +    if aTransaction = nil then
1968 +      cs := FBatch.execute(StatusIntf,(FTransactionIntf as TFB30Transaction).TransactionIntf)
1969 +    else
1970 +      cs := FBatch.execute(StatusIntf,(aTransaction as TFB30Transaction).TransactionIntf);
1971 +    Check4DataBaseError;
1972 +    FBatchCompletion := TBatchCompletion.Create(FFirebird30ClientAPI,cs);
1973 +    FStatisticsAvailable := SavePerfStats(FAfterStats);
1974 +    FBatch.release;
1975 +    FBatch := nil;
1976 +    Check4BatchCompletionError(FBatchCompletion);
1977 +    Result := FBatchCompletion;
1978 +  end;
1979 + end;
1980 +
1981 + procedure TFB30Statement.CancelBatch;
1982 + begin
1983 +  if FBatch = nil then
1984 +    IBError(ibxeNotInBatchMode,[]);
1985 +  FBatch.release;
1986 +  FBatch := nil;
1987 + end;
1988 +
1989 + function TFB30Statement.GetBatchCompletion: IBatchCompletion;
1990 + begin
1991 +  Result := FBatchCompletion;
1992 + end;
1993 +
1994   function TFB30Statement.IsPrepared: boolean;
1995   begin
1996    Result := FStatementIntf <> nil;
1997   end;
1998  
1999 + function TFB30Statement.GetFlags: TStatementFlags;
2000 + var flags: cardinal;
2001 + begin
2002 +  CheckHandle;
2003 +  Result := [];
2004 +  with FFirebird30ClientAPI do
2005 +  begin
2006 +    flags := FStatementIntf.getFlags(StatusIntf);
2007 +    Check4DataBaseError;
2008 +  end;
2009 +  if flags and Firebird.IStatement.FLAG_HAS_CURSOR <> 0 then
2010 +    Result := Result + [stHasCursor];
2011 +  if flags and Firebird.IStatement.FLAG_REPEAT_EXECUTE <> 0 then
2012 +    Result := Result + [stRepeatExecute];
2013 +  if flags and Firebird.IStatement.CURSOR_TYPE_SCROLLABLE <> 0 then
2014 +    Result := Result + [stScrollable];
2015 + end;
2016 +
2017   end.
2018  

Comparing:
ibx/trunk/fbintf/client/3.0/FB30Statement.pas (property svn:eol-style), Revision 309 by tony, Tue Jul 21 08:00:42 2020 UTC vs.
ibx/branches/udr/client/3.0/FB30Statement.pas (property svn:eol-style), Revision 384 by tony, Mon Jan 17 09:52:58 2022 UTC

# Line 0 | Line 1
1 + native

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines