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 47 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
ibx/branches/udr/client/3.0/FB30Statement.pas (file contents), Revision 370 by tony, Wed Jan 5 14:59:15 2022 UTC

# Line 25 | Line 25
25   *
26   *)
27   unit FB30Statement;
28 + {$IFDEF MSWINDOWS}
29 + {$DEFINE WINDOWS}
30 + {$ENDIF}
31  
32   {$IFDEF FPC}
33 < {$mode objfpc}{$H+}
33 > {$mode delphi}
34   {$codepage UTF8}
35   {$interfaces COM}
36   {$ENDIF}
# Line 75 | Line 78 | uses
78    FB30Attachment,IBExternals, FBSQLData, FBOutputBlock, FBActivityMonitor;
79  
80   type
78
81    TFB30Statement = class;
82    TIBXSQLDA = class;
83  
# Line 84 | Line 86 | type
86    TIBXSQLVAR = class(TSQLVarData)
87    private
88      FStatement: TFB30Statement;
89 +    FFirebird30ClientAPI: TFB30ClientAPI;
90      FBlob: IBlob;             {Cache references}
88    FArray: IArray;
91      FNullIndicator: short;
92      FOwnsSQLData: boolean;
93      FBlobMetaData: IBlobMetaData;
# Line 94 | Line 96 | type
96      {SQL Var Type Data}
97      FSQLType: cardinal;
98      FSQLSubType: integer;
99 <    FSQLData: PChar; {Address of SQL Data in Message Buffer}
99 >    FSQLData: PByte; {Address of SQL Data in Message Buffer}
100      FSQLNullIndicator: PShort; {Address of null indicator}
101      FDataLength: integer;
102 +    FMetadataSize: integer;
103      FNullable: boolean;
104      FScale: integer;
105      FCharSetID: cardinal;
106 <    FRelationName: string;
107 <    FFieldName: string;
106 >    FRelationName: AnsiString;
107 >    FFieldName: AnsiString;
108  
109      protected
110 +     function CanChangeSQLType: boolean;
111       function GetSQLType: cardinal; override;
112       function GetSubtype: integer; override;
113 <     function GetAliasName: string;  override;
114 <     function GetFieldName: string; override;
115 <     function GetOwnerName: string;  override;
116 <     function GetRelationName: string;  override;
113 >     function GetAliasName: AnsiString;  override;
114 >     function GetFieldName: AnsiString; override;
115 >     function GetOwnerName: AnsiString;  override;
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;
121       function GetIsNull: Boolean;   override;
122       function GetIsNullable: boolean; override;
123 <     function GetSQLData: PChar;  override;
123 >     function GetSQLData: PByte;  override;
124       function GetDataLength: cardinal; override;
125 +     function GetSize: cardinal; override;
126 +     function GetAttachment: IAttachment; override;
127 +     function GetDefaultTextSQLType: cardinal; override;
128       procedure SetIsNull(Value: Boolean); override;
129       procedure SetIsNullable(Value: Boolean);  override;
130 <     procedure SetSQLData(AValue: PChar; len: cardinal); override;
130 >     procedure SetSQLData(AValue: PByte; len: cardinal); override;
131       procedure SetScale(aValue: integer); override;
132       procedure SetDataLength(len: cardinal); override;
133       procedure SetSQLType(aValue: cardinal); override;
134       procedure SetCharSetID(aValue: cardinal); override;
135 <
135 >     procedure SetMetaSize(aValue: cardinal); override;
136    public
137      constructor Create(aParent: TIBXSQLDA; aIndex: integer);
138      procedure Changed; override;
139 +    procedure InitColumnMetaData(aMetaData: Firebird.IMessageMetadata);
140 +    procedure ColumnSQLDataInit;
141      procedure RowChange; override;
142      procedure FreeSQLData;
143 <    function GetAsArray(Array_ID: TISC_QUAD): IArray; override;
143 >    function GetAsArray: IArray; override;
144      function GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob; override;
145      function GetArrayMetaData: IArrayMetaData; override;
146      function GetBlobMetaData: IBlobMetaData; override;
# Line 145 | Line 155 | type
155      FSize: Integer;  {Number of TIBXSQLVARs in column list}
156      FMetaData: Firebird.IMessageMetadata;
157      FTransactionSeqNo: integer;
158 <  protected
158 > protected
159      FStatement: TFB30Statement;
160 +    FFirebird30ClientAPI: TFB30ClientAPI;
161      function GetTransactionSeqNo: integer; override;
162      procedure FreeXSQLDA; virtual;
163      function GetStatement: IStatement; override;
# Line 161 | Line 172 | type
172      function GetTransaction: TFB30Transaction; virtual;
173      procedure Initialize; override;
174      function StateChanged(var ChangeSeqNo: integer): boolean; override;
175 +    function CanChangeMetaData: boolean; override;
176      property MetaData: Firebird.IMessageMetadata read FMetaData;
177      property Count: Integer read FCount write SetCount;
178      property Statement: TFB30Statement read FStatement;
# Line 170 | Line 182 | type
182  
183    TIBXINPUTSQLDA = class(TIBXSQLDA)
184    private
185 <    FMessageBuffer: PChar; {Message Buffer}
185 >    FMessageBuffer: PByte; {Message Buffer}
186      FMsgLength: integer; {Message Buffer length}
187      FCurMetaData: Firebird.IMessageMetadata;
188      procedure FreeMessageBuffer;
189 <    function GetMessageBuffer: PChar;
189 >    procedure FreeCurMetaData;
190 >    function GetMessageBuffer: PByte;
191      function GetMetaData: Firebird.IMessageMetadata;
192      function GetModified: Boolean;
193      function GetMsgLength: integer;
194 +    procedure BuildMetadata;
195      procedure PackBuffer;
196    protected
197      procedure FreeXSQLDA; override;
# Line 186 | Line 200 | type
200      destructor Destroy; override;
201      procedure Bind(aMetaData: Firebird.IMessageMetadata);
202      procedure Changed; override;
203 +    procedure ReInitialise;
204      function IsInputDataArea: boolean; override;
205      property MetaData: Firebird.IMessageMetadata read GetMetaData;
206 <    property MessageBuffer: PChar read GetMessageBuffer;
206 >    property MessageBuffer: PByte read GetMessageBuffer;
207      property MsgLength: integer read GetMsgLength;
208    end;
209  
# Line 197 | Line 212 | type
212    TIBXOUTPUTSQLDA = class(TIBXSQLDA)
213    private
214      FTransaction: TFB30Transaction; {transaction used to execute the statement}
215 <    FMessageBuffer: PChar; {Message Buffer}
215 >    FMessageBuffer: PByte; {Message Buffer}
216      FMsgLength: integer; {Message Buffer length}
217    protected
218      procedure FreeXSQLDA; override;
219    public
220      procedure Bind(aMetaData: Firebird.IMessageMetadata);
221      procedure GetData(index: integer; var aIsNull: boolean; var len: short;
222 <      var data: PChar); override;
222 >      var data: PByte); override;
223      function IsInputDataArea: boolean; override;
224 <    property MessageBuffer: PChar read FMessageBuffer;
224 >    property MessageBuffer: PByte read FMessageBuffer;
225      property MsgLength: integer read FMsgLength;
226    end;
227  
# Line 216 | Line 231 | type
231    private
232      FResults: TIBXOUTPUTSQLDA;
233      FCursorSeqNo: integer;
234 +    procedure RowChange;
235    public
236      constructor Create(aResults: TIBXOUTPUTSQLDA);
237      destructor Destroy; override;
238      {IResultSet}
239 <    function FetchNext: boolean;
240 <    function GetCursorName: string;
239 >    function FetchNext: boolean; {fetch next record}
240 >    function FetchPrior: boolean; {fetch previous record}
241 >    function FetchFirst:boolean; {fetch first record}
242 >    function FetchLast: boolean; {fetch last record}
243 >    function FetchAbsolute(position: Integer): boolean; {fetch record by its absolute position in result set}
244 >    function FetchRelative(offset: Integer): boolean; {fetch record by position relative to current}
245 >    function GetCursorName: AnsiString;
246      function GetTransaction: ITransaction; override;
247 +    function IsBof: boolean;
248      function IsEof: boolean;
249      procedure Close;
250    end;
251  
252 +  { TBatchCompletion }
253 +
254 +  TBatchCompletion = class(TInterfaceOwner,IBatchCompletion)
255 +  private
256 +    FCompletionState: Firebird.IBatchCompletionState;
257 +    FFirebird30ClientAPI: TFB30ClientAPI;
258 +  public
259 +    constructor Create(api: TFB30ClientAPI; cs: IBatchCompletionState);
260 +    destructor Destroy; override;
261 +    {IBatchCompletion}
262 +    function getErrorStatus(var RowNo: integer; var status: IStatus): boolean;
263 +    function getTotalProcessed: cardinal;
264 +    function getState(updateNo: cardinal): TBatchCompletionState;
265 +    function getStatusMessage(updateNo: cardinal): AnsiString;
266 +    function getUpdated: integer;
267 +  end;
268 +
269 +  TFetchType = (ftNext,ftPrior,ftFirst,ftLast,ftAbsolute,ftRelative);
270 +
271    { TFB30Statement }
272  
273    TFB30Statement = class(TFBStatement,IStatement)
274    private
275      FStatementIntf: Firebird.IStatement;
276 +    FFirebird30ClientAPI: TFB30ClientAPI;
277      FSQLParams: TIBXINPUTSQLDA;
278      FSQLRecord: TIBXOUTPUTSQLDA;
279      FResultSet: Firebird.IResultSet;
280      FCursorSeqNo: integer;
281 +    FCursor: AnsiString;
282 +    FBatch: Firebird.IBatch;
283 +    FBatchCompletion: IBatchCompletion;
284 +    FBatchRowCount: integer;
285 +    FBatchBufferSize: integer;
286 +    FBatchBufferUsed: integer;
287    protected
288 +    procedure CheckChangeBatchRowLimit; override;
289      procedure CheckHandle; override;
290 +    procedure CheckBatchModeAvailable;
291      procedure GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults); override;
292 <    procedure InternalPrepare; override;
292 >    function GetStatementIntf: IStatement; override;
293 >    procedure InternalPrepare(CursorName: AnsiString=''); override;
294      function InternalExecute(aTransaction: ITransaction): IResults; override;
295 <    function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override;
295 >    function InternalOpenCursor(aTransaction: ITransaction; Scrollable: boolean
296 >      ): IResultSet; override;
297 >    procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override;
298      procedure FreeHandle; override;
299      procedure InternalClose(Force: boolean); override;
300 +    function SavePerfStats(var Stats: TPerfStatistics): boolean;
301    public
302      constructor Create(Attachment: TFB30Attachment; Transaction: ITransaction;
303 <      sql: string; aSQLDialect: integer);
303 >      sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString='');
304      constructor CreateWithParameterNames(Attachment: TFB30Attachment; Transaction: ITransaction;
305 <      sql: string;  aSQLDialect: integer; GenerateParamNames: boolean =false);
305 >      sql: AnsiString;  aSQLDialect: integer; GenerateParamNames: boolean =false;
306 >      CaseSensitiveParams: boolean=false; CursorName: AnsiString='');
307      destructor Destroy; override;
308 <    function FetchNext: boolean;
308 >    function Fetch(FetchType: TFetchType; PosOrOffset: integer=0): boolean;
309      property StatementIntf: Firebird.IStatement read FStatementIntf;
310  
311    public
312      {IStatement}
313      function GetSQLParams: ISQLParams; override;
314      function GetMetaData: IMetaData; override;
315 <    function GetPlan: String;
315 >    function GetPlan: AnsiString;
316      function IsPrepared: boolean;
317 +    function GetFlags: TStatementFlags; override;
318      function CreateBlob(column: TColumnMetaData): IBlob; override;
319      function CreateArray(column: TColumnMetaData): IArray; override;
320      procedure SetRetainInterfaces(aValue: boolean); override;
321 <
321 >    function IsInBatchMode: boolean; override;
322 >    function HasBatchMode: boolean; override;
323 >    procedure AddToBatch; override;
324 >    function ExecuteBatch(aTransaction: ITransaction
325 >      ): IBatchCompletion; override;
326 >    procedure CancelBatch; override;
327 >    function GetBatchCompletion: IBatchCompletion; override;
328   end;
329  
330   implementation
331  
332 < uses IBUtils, FBMessages, FBBLob, FB30Blob, variants,  FBArray, FB30Array;
332 > uses IBUtils, FBMessages, FBBlob, FB30Blob, variants,  FBArray, FB30Array;
333  
334   const
335    ISQL_COUNTERS = 'CurrentMemory, MaxMemory, RealTime, UserTime, Buffers, Reads, Writes, Fetches';
336  
337 + { EIBBatchCompletionError }
338 +
339 + { TBatchCompletion }
340 +
341 + constructor TBatchCompletion.Create(api: TFB30ClientAPI;
342 +  cs: IBatchCompletionState);
343 + begin
344 +  inherited Create;
345 +  FFirebird30ClientAPI := api;
346 +  FCompletionState := cs;
347 + end;
348 +
349 + destructor TBatchCompletion.Destroy;
350 + begin
351 +  if FCompletionState <> nil then
352 +  begin
353 +    FCompletionState.dispose;
354 +    FCompletionState := nil;
355 +  end;
356 +  inherited Destroy;
357 + end;
358 +
359 + function TBatchCompletion.getErrorStatus(var RowNo: integer; var status: IStatus
360 +  ): boolean;
361 + var i: integer;
362 +  upcount: cardinal;
363 +  state: integer;
364 +  FBStatus: Firebird.IStatus;
365 + begin
366 +  Result := false;
367 +  RowNo := -1;
368 +  FBStatus := nil;
369 +  with FFirebird30ClientAPI do
370 +  begin
371 +    upcount := FCompletionState.getSize(StatusIntf);
372 +    Check4DataBaseError;
373 +    for i := 0 to upcount - 1 do
374 +    begin
375 +      state := FCompletionState.getState(StatusIntf,i);
376 +      if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then
377 +      begin
378 +        RowNo := i+1;
379 +        FBStatus := MasterIntf.getStatus;
380 +        try
381 +          FCompletionState.getStatus(StatusIntf,FBStatus,i);
382 +          Check4DataBaseError;
383 +        except
384 +          FBStatus.dispose;
385 +          raise
386 +        end;
387 +        status := TFB30StatusObject.Create(FFirebird30ClientAPI,FBStatus,
388 +                      Format(SBatchCompletionError,[RowNo]));
389 +        status.SetIBDataBaseErrorMessages(GetStatus.GetIBDataBaseErrorMessages);
390 +        Result := true;
391 +        break;
392 +      end;
393 +    end;
394 +  end;
395 + end;
396 +
397 + function TBatchCompletion.getTotalProcessed: cardinal;
398 + begin
399 +  with FFirebird30ClientAPI do
400 +  begin
401 +    Result := FCompletionState.getsize(StatusIntf);
402 +    Check4DataBaseError;
403 +  end;
404 + end;
405 +
406 + function TBatchCompletion.getState(updateNo: cardinal): TBatchCompletionState;
407 + var state: integer;
408 + begin
409 +  with FFirebird30ClientAPI do
410 +  begin
411 +    state := FCompletionState.getState(StatusIntf,updateNo);
412 +    Check4DataBaseError;
413 +    case state of
414 +      Firebird.IBatchCompletionState.EXECUTE_FAILED:
415 +        Result := bcExecuteFailed;
416 +
417 +      Firebird.IBatchCompletionState.SUCCESS_NO_INFO:
418 +        Result := bcSuccessNoInfo;
419 +
420 +     else
421 +        Result := bcNoMoreErrors;
422 +    end;
423 +  end;
424 + end;
425 +
426 + function TBatchCompletion.getStatusMessage(updateNo: cardinal): AnsiString;
427 + var status: Firebird.IStatus;
428 + begin
429 +  with FFirebird30ClientAPI do
430 +  begin
431 +    status := MasterIntf.getStatus;
432 +    FCompletionState.getStatus(StatusIntf,status,updateNo);
433 +    Check4DataBaseError;
434 +    Result := FormatFBStatus(status);
435 +  end;
436 + end;
437 +
438 + function TBatchCompletion.getUpdated: integer;
439 + var i: integer;
440 +    upcount: cardinal;
441 +    state: integer;
442 + begin
443 +  Result := 0;
444 +  with FFirebird30ClientAPI do
445 +  begin
446 +    upcount := FCompletionState.getSize(StatusIntf);
447 +    Check4DataBaseError;
448 +    for i := 0 to upcount -1  do
449 +    begin
450 +      state := FCompletionState.getState(StatusIntf,i);
451 +      if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then
452 +          break;
453 +      Inc(Result);
454 +    end;
455 +  end;
456 + end;
457 +
458   { TIBXSQLVAR }
459  
460   procedure TIBXSQLVAR.Changed;
# Line 280 | Line 463 | begin
463    TIBXSQLDA(Parent).Changed;
464   end;
465  
466 + procedure TIBXSQLVAR.InitColumnMetaData(aMetaData: Firebird.IMessageMetadata);
467 + begin
468 +  with FFirebird30ClientAPI do
469 +  begin
470 +    FSQLType := aMetaData.getType(StatusIntf,Index);
471 +    Check4DataBaseError;
472 +    if FSQLType = SQL_BLOB then
473 +    begin
474 +      FSQLSubType := aMetaData.getSubType(StatusIntf,Index);
475 +      Check4DataBaseError;
476 +    end
477 +    else
478 +      FSQLSubType := 0;
479 +    FDataLength := aMetaData.getLength(StatusIntf,Index);
480 +    Check4DataBaseError;
481 +    FMetadataSize := FDataLength;
482 +    FRelationName := strpas(aMetaData.getRelation(StatusIntf,Index));
483 +    Check4DataBaseError;
484 +    FFieldName := strpas(aMetaData.getField(StatusIntf,Index));
485 +    Check4DataBaseError;
486 +    FNullable := aMetaData.isNullable(StatusIntf,Index);
487 +    Check4DataBaseError;
488 +    FScale := aMetaData.getScale(StatusIntf,Index);
489 +    Check4DataBaseError;
490 +    FCharSetID :=  aMetaData.getCharSet(StatusIntf,Index) and $FF;
491 +    Check4DataBaseError;
492 +  end;
493 + end;
494 +
495 + procedure TIBXSQLVAR.ColumnSQLDataInit;
496 + begin
497 +  FreeSQLData;
498 +  with FFirebird30ClientAPI do
499 +  begin
500 +    case SQLType of
501 +      SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
502 +      SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
503 +      SQL_LONG, SQL_INT64, SQL_INT128, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT,
504 +      SQL_TIMESTAMP_TZ, SQL_TIME_TZ, SQL_DEC_FIXED, SQL_DEC16, SQL_DEC34,
505 +      SQL_TIMESTAMP_TZ_EX, SQL_TIME_TZ_EX:
506 +      begin
507 +        if (FDataLength = 0) then
508 +          { Make sure you get a valid pointer anyway
509 +           select '' from foo }
510 +          IBAlloc(FSQLData, 0, 1)
511 +        else
512 +          IBAlloc(FSQLData, 0, FDataLength)
513 +      end;
514 +      SQL_VARYING:
515 +        IBAlloc(FSQLData, 0, FDataLength + 2);
516 +     else
517 +        IBError(ibxeUnknownSQLDataType, [SQLType and (not 1)])
518 +    end;
519 +    FOwnsSQLData := true;
520 +    FNullIndicator := -1;
521 +  end;
522 + end;
523 +
524 + function TIBXSQLVAR.CanChangeSQLType: boolean;
525 + begin
526 +  Result := Parent.CanChangeMetaData;
527 + end;
528 +
529   function TIBXSQLVAR.GetSQLType: cardinal;
530   begin
531    Result := FSQLType;
# Line 290 | Line 536 | begin
536    Result := FSQLSubType;
537   end;
538  
539 < function TIBXSQLVAR.GetAliasName: string;
539 > function TIBXSQLVAR.GetAliasName: AnsiString;
540   begin
541 <  with Firebird30ClientAPI do
541 >  with FFirebird30ClientAPI do
542    begin
543      result := strpas(TIBXSQLDA(Parent).MetaData.getAlias(StatusIntf,Index));
544      Check4DataBaseError;
545    end;
546   end;
547  
548 < function TIBXSQLVAR.GetFieldName: string;
548 > function TIBXSQLVAR.GetFieldName: AnsiString;
549   begin
550    Result := FFieldName;
551   end;
552  
553 < function TIBXSQLVAR.GetOwnerName: string;
553 > function TIBXSQLVAR.GetOwnerName: AnsiString;
554   begin
555 <  with Firebird30ClientAPI do
555 >  with FFirebird30ClientAPI do
556    begin
557      result := strpas(TIBXSQLDA(Parent).MetaData.getOwner(StatusIntf,Index));
558      Check4DataBaseError;
559    end;
560   end;
561  
562 < function TIBXSQLVAR.GetRelationName: string;
562 > function TIBXSQLVAR.GetRelationName: AnsiString;
563   begin
564    Result := FRelationName;
565   end;
# Line 325 | Line 571 | end;
571  
572   function TIBXSQLVAR.GetCharSetID: cardinal;
573   begin
574 <  result := 0;
574 >  result := 0; {NONE}
575    case SQLType of
576    SQL_VARYING, SQL_TEXT:
577        result := FCharSetID;
578  
579    SQL_BLOB:
580      if (SQLSubType = 1) then
581 <      result := FCharSetID;
581 >      result := FCharSetID
582 >    else
583 >      result := 1; {OCTETS}
584  
585    SQL_ARRAY:
586      if (FRelationName <> '') and (FFieldName <> '') then
# Line 345 | Line 593 | end;
593   function TIBXSQLVAR.GetCodePage: TSystemCodePage;
594   begin
595    result := CP_NONE;
596 <  with Firebird30ClientAPI do
596 >  with Statement.GetAttachment do
597       CharSetID2CodePage(GetCharSetID,result);
598   end;
599  
600 + function TIBXSQLVAR.GetCharSetWidth: integer;
601 + begin
602 +  result := 1;
603 +  with Statement.GetAttachment DO
604 +    CharSetWidth(GetCharSetID,result);
605 + end;
606 +
607   function TIBXSQLVAR.GetIsNull: Boolean;
608   begin
609    Result := IsNullable and (FSQLNullIndicator^ = -1);
# Line 359 | Line 614 | begin
614    Result := FSQLNullIndicator <> nil;
615   end;
616  
617 < function TIBXSQLVAR.GetSQLData: PChar;
617 > function TIBXSQLVAR.GetSQLData: PByte;
618   begin
619    Result := FSQLData;
620   end;
# Line 369 | Line 624 | begin
624    Result := FDataLength;
625   end;
626  
627 + function TIBXSQLVAR.GetSize: cardinal;
628 + begin
629 +  Result := FMetadataSize;
630 + end;
631 +
632 + function TIBXSQLVAR.GetAttachment: IAttachment;
633 + begin
634 +  Result := FStatement.GetAttachment;
635 + end;
636 +
637   function TIBXSQLVAR.GetArrayMetaData: IArrayMetaData;
638   begin
639    if GetSQLType <> SQL_ARRAY then
# Line 418 | Line 683 | begin
683    end
684    else
685      FSQLNullIndicator := nil;
686 +  Changed;
687   end;
688  
689 < procedure TIBXSQLVAR.SetSQLData(AValue: PChar; len: cardinal);
689 > procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal);
690   begin
691    if FOwnsSQLData then
692      FreeMem(FSQLData);
693    FSQLData := AValue;
694    FDataLength := len;
695    FOwnsSQLData := false;
696 +  Changed;
697   end;
698  
699   procedure TIBXSQLVAR.SetScale(aValue: integer);
700   begin
701    FScale := aValue;
702 +  Changed;
703   end;
704  
705   procedure TIBXSQLVAR.SetDataLength(len: cardinal);
# Line 439 | Line 707 | begin
707    if not FOwnsSQLData then
708      FSQLData := nil;
709    FDataLength := len;
710 <  with Firebird30ClientAPI do
710 >  with FFirebird30ClientAPI do
711      IBAlloc(FSQLData, 0, FDataLength);
712    FOwnsSQLData := true;
713 +  Changed;
714   end;
715  
716   procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
717   begin
718 +  if (FSQLType <> aValue) and not CanChangeSQLType then
719 +    IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(FSQLType),TSQLDataItem.GetSQLTypeName(aValue)]);
720    FSQLType := aValue;
721 +  Changed;
722   end;
723  
724   procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal);
725   begin
726    FCharSetID := aValue;
727 +  Changed;
728 + end;
729 +
730 + procedure TIBXSQLVAR.SetMetaSize(aValue: cardinal);
731 + begin
732 +  if (aValue > FMetaDataSize) and not CanChangeSQLType then
733 +    IBError(ibxeCannotIncreaseMetadatasize,[FMetaDataSize,aValue]);
734 +  FMetaDataSize := aValue;
735 + end;
736 +
737 + function TIBXSQLVAR.GetDefaultTextSQLType: cardinal;
738 + begin
739 +  Result := SQL_VARYING;
740   end;
741  
742   constructor TIBXSQLVAR.Create(aParent: TIBXSQLDA; aIndex: integer);
743   begin
744    inherited Create(aParent,aIndex);
745    FStatement := aParent.Statement;
746 +  FFirebird30ClientAPI := aParent.FFirebird30ClientAPI;
747   end;
748  
749   procedure TIBXSQLVAR.RowChange;
750   begin
751    inherited;
752    FBlob := nil;
467  FArray := nil;
753   end;
754  
755   procedure TIBXSQLVAR.FreeSQLData;
# Line 475 | Line 760 | begin
760    FOwnsSQLData := true;
761   end;
762  
763 < function TIBXSQLVAR.GetAsArray(Array_ID: TISC_QUAD): IArray;
763 > function TIBXSQLVAR.GetAsArray: IArray;
764   begin
765    if SQLType <> SQL_ARRAY then
766      IBError(ibxeInvalidDataConversion,[nil]);
# Line 484 | Line 769 | begin
769      Result := nil
770    else
771    begin
772 <    if FArray = nil then
773 <      FArray := TFB30Array.Create(FStatement.GetAttachment as TFB30Attachment,
772 >    if FArrayIntf = nil then
773 >      FArrayIntf := TFB30Array.Create(FStatement.GetAttachment as TFB30Attachment,
774                                  TIBXSQLDA(Parent).GetTransaction,
775 <                                GetArrayMetaData,Array_ID);
776 <    Result := FArray;
775 >                                GetArrayMetaData,PISC_QUAD(SQLData)^);
776 >    Result := FArrayIntf;
777    end;
778   end;
779  
# Line 520 | Line 805 | end;
805  
806   { TResultSet }
807  
808 + procedure TResultSet.RowChange;
809 + var i: integer;
810 + begin
811 +  for i := 0 to getCount - 1 do
812 +    FResults.Column[i].RowChange;
813 + end;
814 +
815   constructor TResultSet.Create(aResults: TIBXOUTPUTSQLDA);
816   begin
817    inherited Create(aResults);
# Line 534 | Line 826 | begin
826   end;
827  
828   function TResultSet.FetchNext: boolean;
537 var i: integer;
829   begin
830    CheckActive;
831 <  Result := FResults.FStatement.FetchNext;
831 >  Result := FResults.FStatement.Fetch(ftNext);
832 >  if Result then
833 >    RowChange;
834 > end;
835 >
836 > function TResultSet.FetchPrior: boolean;
837 > begin
838 >  CheckActive;
839 >  Result := FResults.FStatement.Fetch(ftPrior);
840 >  if Result then
841 >    RowChange;
842 > end;
843 >
844 > function TResultSet.FetchFirst: boolean;
845 > begin
846 >  CheckActive;
847 >  Result := FResults.FStatement.Fetch(ftFirst);
848    if Result then
849 <    for i := 0 to getCount - 1 do
543 <      FResults.Column[i].RowChange;
849 >    RowChange;
850   end;
851  
852 < function TResultSet.GetCursorName: string;
852 > function TResultSet.FetchLast: boolean;
853   begin
854 <  IBError(ibxeNotSupported,[nil]);
855 <  Result := '';
854 >  CheckActive;
855 >  Result := FResults.FStatement.Fetch(ftLast);
856 >  if Result then
857 >    RowChange;
858 > end;
859 >
860 > function TResultSet.FetchAbsolute(position: Integer): boolean;
861 > begin
862 >  CheckActive;
863 >  Result := FResults.FStatement.Fetch(ftAbsolute,position);
864 >  if Result then
865 >    RowChange;
866 > end;
867 >
868 > function TResultSet.FetchRelative(offset: Integer): boolean;
869 > begin
870 >  CheckActive;
871 >  Result := FResults.FStatement.Fetch(ftRelative,offset);
872 >  if Result then
873 >    RowChange;
874 > end;
875 >
876 > function TResultSet.GetCursorName: AnsiString;
877 > begin
878 >  Result := FResults.FStatement.FCursor;
879   end;
880  
881   function TResultSet.GetTransaction: ITransaction;
# Line 554 | Line 883 | begin
883    Result := FResults.FTransaction;
884   end;
885  
886 + function TResultSet.IsBof: boolean;
887 + begin
888 +  Result := FResults.FStatement.FBof;
889 + end;
890 +
891   function TResultSet.IsEof: boolean;
892   begin
893    Result := FResults.FStatement.FEof;
# Line 582 | Line 916 | end;
916  
917   procedure TIBXINPUTSQLDA.FreeMessageBuffer;
918   begin
585  if FCurMetaData <> nil then
586  begin
587    FCurMetaData.release;
588    FCurMetaData := nil;
589  end;
919    if FMessageBuffer <> nil then
920    begin
921      FreeMem(FMessageBuffer);
# Line 595 | Line 924 | begin
924    FMsgLength := 0;
925   end;
926  
927 < function TIBXINPUTSQLDA.GetMessageBuffer: PChar;
927 > procedure TIBXINPUTSQLDA.FreeCurMetaData;
928 > begin
929 >  if FCurMetaData <> nil then
930 >  begin
931 >    FCurMetaData.release;
932 >    FCurMetaData := nil;
933 >  end;
934 > end;
935 >
936 > function TIBXINPUTSQLDA.GetMessageBuffer: PByte;
937   begin
938    PackBuffer;
939    Result := FMessageBuffer;
# Line 603 | Line 941 | end;
941  
942   function TIBXINPUTSQLDA.GetMetaData: Firebird.IMessageMetadata;
943   begin
944 <  PackBuffer;
944 >  BuildMetadata;
945    Result := FCurMetaData;
946   end;
947  
# Line 613 | Line 951 | begin
951    Result := FMsgLength;
952   end;
953  
954 < procedure TIBXINPUTSQLDA.PackBuffer;
954 > procedure TIBXINPUTSQLDA.BuildMetadata;
955   var Builder: Firebird.IMetadataBuilder;
956      i: integer;
957   begin
958 <  if FMsgLength > 0 then Exit;
959 <
622 <  with Firebird30ClientAPI do
958 >  if (FCurMetaData = nil) and (Count > 0) then
959 >  with FFirebird30ClientAPI do
960    begin
961 <    Builder := inherited MetaData.getBuilder(StatusIntf);
961 >    Builder := FFirebird30ClientAPI.MasterIntf.getMetadataBuilder(StatusIntf,Count);
962      Check4DataBaseError;
963      try
964        for i := 0 to Count - 1 do
965        with TIBXSQLVar(Column[i]) do
966        begin
967 <        Builder.setType(StatusIntf,i,FSQLType);
967 >        Builder.setType(StatusIntf,i,FSQLType+1);
968          Check4DataBaseError;
969          Builder.setSubType(StatusIntf,i,FSQLSubType);
970          Check4DataBaseError;
971 <        Builder.setLength(StatusIntf,i,FDataLength);
971 > //        writeln('Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength);
972 >        if FSQLType = SQL_VARYING then
973 >        begin
974 >          {The datalength can be greater than the metadata size when SQLType has been overridden to text}
975 >          if (GetDataLength > GetSize) and CanChangeMetaData then
976 >            Builder.setLength(StatusIntf,i,GetDataLength)
977 >          else
978 >            Builder.setLength(StatusIntf,i,GetSize)
979 >        end
980 >        else
981 >          Builder.setLength(StatusIntf,i,GetDataLength);
982          Check4DataBaseError;
983          Builder.setCharSet(StatusIntf,i,GetCharSetID);
984          Check4DataBaseError;
# Line 643 | Line 990 | begin
990      finally
991        Builder.release;
992      end;
993 +  end;
994 + end;
995  
996 + procedure TIBXINPUTSQLDA.PackBuffer;
997 + var i: integer;
998 +    P: PByte;
999 + begin
1000 +  BuildMetadata;
1001 +
1002 +  if (FMsgLength = 0) and (FCurMetaData <> nil) then
1003 +  with FFirebird30ClientAPI do
1004 +  begin
1005      FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
1006      Check4DataBaseError;
1007  
# Line 652 | Line 1010 | begin
1010      for i := 0 to Count - 1 do
1011      with TIBXSQLVar(Column[i]) do
1012      begin
1013 +      P := FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i);
1014 + //     writeln('Packbuffer: Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength);
1015 +      if not Modified then
1016 +        IBError(ibxeUninitializedInputParameter,[i,Name]);
1017        if IsNull then
1018 <        FillChar((FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength,0)
1018 >        FillChar(P^,FDataLength,0)
1019        else
1020 <        Move(FSQLData^,(FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength);
1021 <      Check4DataBaseError;
1020 >      if FSQLData <> nil then
1021 >      begin
1022 >        if SQLType = SQL_VARYING then
1023 >        begin
1024 >            EncodeInteger(FDataLength,2,P);
1025 >            Inc(P,2);
1026 >        end
1027 >        else
1028 >        if (SQLType = SQL_BLOB) and (FStatement.FBatch <> nil) then
1029 >        begin
1030 >          FStatement.FBatch.registerBlob(Statusintf,ISC_QUADPtr(FSQLData),ISC_QUADPtr(FSQLData));
1031 >          Check4DatabaseError;
1032 >        end;
1033 >        Move(FSQLData^,P^,FDataLength);
1034 >      end;
1035        if IsNullable then
1036        begin
1037          Move(FNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(FNullIndicator));
# Line 669 | Line 1044 | end;
1044   procedure TIBXINPUTSQLDA.FreeXSQLDA;
1045   begin
1046    inherited FreeXSQLDA;
1047 +  FreeCurMetaData;
1048    FreeMessageBuffer;
1049   end;
1050  
# Line 680 | Line 1056 | end;
1056  
1057   destructor TIBXINPUTSQLDA.Destroy;
1058   begin
1059 <  FreeMessageBuffer;
1059 >  FreeXSQLDA;
1060    inherited Destroy;
1061   end;
1062  
# Line 688 | Line 1064 | procedure TIBXINPUTSQLDA.Bind(aMetaData:
1064   var i: integer;
1065   begin
1066    FMetaData := aMetaData;
1067 <  with Firebird30ClientAPI do
1067 >  with FFirebird30ClientAPI do
1068    begin
1069 <    Count := metadata.getCount(StatusIntf);
1069 >    Count := aMetadata.getCount(StatusIntf);
1070      Check4DataBaseError;
1071      Initialize;
1072  
1073      for i := 0 to Count - 1 do
1074      with TIBXSQLVar(Column[i]) do
1075      begin
1076 <      FSQLType := aMetaData.getType(StatusIntf,i);
1077 <      Check4DataBaseError;
702 <      if FSQLType = SQL_BLOB then
703 <      begin
704 <        FSQLSubType := aMetaData.getSubType(StatusIntf,i);
705 <        Check4DataBaseError;
706 <      end
707 <      else
708 <        FSQLSubType := 0;
709 <      FDataLength := aMetaData.getLength(StatusIntf,i);
710 <      Check4DataBaseError;
711 <      case SQLType of
712 <        SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
713 <        SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
714 <        SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
715 <        begin
716 <          if (FDataLength = 0) then
717 <            { Make sure you get a valid pointer anyway
718 <             select '' from foo }
719 <            IBAlloc(FSQLData, 0, 1)
720 <          else
721 <            IBAlloc(FSQLData, 0, FDataLength)
722 <        end;
723 <        SQL_VARYING:
724 <          IBAlloc(FSQLData, 0, FDataLength + 2);
725 <       else
726 <          IBError(ibxeUnknownSQLDataType, [sqltype and (not 1)])
727 <      end;
728 <      FNullable := aMetaData.isNullable(StatusIntf,i);
729 <      FOwnsSQLData := true;
730 <      Check4DataBaseError;
731 <      FNullIndicator := -1;
1076 >      InitColumnMetaData(aMetaData);
1077 >      SaveMetaData;
1078        if FNullable then
1079          FSQLNullIndicator := @FNullIndicator
1080        else
1081          FSQLNullIndicator := nil;
1082 <      FScale := aMetaData.getScale(StatusIntf,i);
737 <      Check4DataBaseError;
738 <      FCharSetID :=  aMetaData.getCharSet(StatusIntf,i);
739 <      Check4DataBaseError;
1082 >      ColumnSQLDataInit;
1083      end;
1084    end;
1085   end;
# Line 744 | Line 1087 | end;
1087   procedure TIBXINPUTSQLDA.Changed;
1088   begin
1089    inherited Changed;
1090 +  FreeCurMetaData;
1091    FreeMessageBuffer;
1092   end;
1093  
1094 + procedure TIBXINPUTSQLDA.ReInitialise;
1095 + var i: integer;
1096 + begin
1097 +  FreeMessageBuffer;
1098 +  for i := 0 to Count - 1 do
1099 +    TIBXSQLVar(Column[i]).ColumnSQLDataInit;
1100 + end;
1101 +
1102   function TIBXINPUTSQLDA.IsInputDataArea: boolean;
1103   begin
1104    Result := true;
# Line 766 | Line 1118 | procedure TIBXOUTPUTSQLDA.Bind(aMetaData
1118   var i: integer;
1119   begin
1120    FMetaData := aMetaData;
1121 <  with Firebird30ClientAPI do
1121 >  with FFirebird30ClientAPI do
1122    begin
1123      Count := metadata.getCount(StatusIntf);
1124      Check4DataBaseError;
# Line 779 | Line 1131 | begin
1131      for i := 0 to Count - 1 do
1132      with TIBXSQLVar(Column[i]) do
1133      begin
1134 <      FSQLType := aMetaData.getType(StatusIntf,i);
783 <      Check4DataBaseError;
784 <      if FSQLType = SQL_BLOB then
785 <      begin
786 <        FSQLSubType := aMetaData.getSubType(StatusIntf,i);
787 <        Check4DataBaseError;
788 <      end
789 <      else
790 <        FSQLSubType := 0;
791 <      FBlob := nil;
792 <      FArray := nil;
1134 >      InitColumnMetaData(aMetaData);
1135        FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i);
1136        Check4DataBaseError;
795      FDataLength := aMetaData.getLength(StatusIntf,i);
796      Check4DataBaseError;
797      FRelationName := strpas(aMetaData.getRelation(StatusIntf,i));
798      Check4DataBaseError;
799      FFieldName := strpas(aMetaData.getField(StatusIntf,i));
800      Check4DataBaseError;
801      FNullable := aMetaData.isNullable(StatusIntf,i);
802      Check4DataBaseError;
1137        if FNullable then
1138        begin
1139          FSQLNullIndicator := PShort(FMessageBuffer + aMetaData.getNullOffset(StatusIntf,i));
# Line 807 | Line 1141 | begin
1141        end
1142        else
1143          FSQLNullIndicator := nil;
1144 <      FScale := aMetaData.getScale(StatusIntf,i);
1145 <      Check4DataBaseError;
812 <      FCharSetID :=  aMetaData.getCharSet(StatusIntf,i);
813 <      Check4DataBaseError;
1144 >      FBlob := nil;
1145 >      FArrayIntf := nil;
1146      end;
1147    end;
1148    SetUniqueRelationName;
1149   end;
1150  
1151   procedure TIBXOUTPUTSQLDA.GetData(index: integer; var aIsNull: boolean;
1152 <  var len: short; var data: PChar);
1152 >  var len: short; var data: PByte);
1153   begin
1154    with TIBXSQLVAR(Column[index]) do
1155    begin
# Line 826 | Line 1158 | begin
1158      len := FDataLength;
1159      if not IsNull and (FSQLType = SQL_VARYING) then
1160      begin
1161 <      with Firebird30ClientAPI do
1161 >      with FFirebird30ClientAPI do
1162          len := DecodeInteger(data,2);
1163        Inc(Data,2);
1164      end;
# Line 843 | Line 1175 | constructor TIBXSQLDA.Create(aStatement:
1175   begin
1176    inherited Create;
1177    FStatement := aStatement;
1178 +  FFirebird30ClientAPI := aStatement.FFirebird30ClientAPI;
1179    FSize := 0;
1180   //  writeln('Creating ',ClassName);
1181   end;
# Line 903 | Line 1236 | begin
1236      ChangeSeqNo := FStatement.ChangeSeqNo;
1237   end;
1238  
1239 + function TIBXSQLDA.CanChangeMetaData: boolean;
1240 + begin
1241 +  Result := FStatement.FBatch = nil;
1242 + end;
1243 +
1244   procedure TIBXSQLDA.SetCount(Value: Integer);
1245   var
1246    i: Integer;
# Line 934 | Line 1272 | begin
1272      TIBXSQLVAR(Column[i]).FreeSQLData;
1273    for i := 0 to FSize - 1  do
1274      TIBXSQLVAR(Column[i]).Free;
1275 +  FCount := 0;
1276    SetLength(FColumnList,0);
1277    FSize := 0;
1278   end;
# Line 950 | Line 1289 | end;
1289  
1290   { TFB30Statement }
1291  
1292 + procedure TFB30Statement.CheckChangeBatchRowLimit;
1293 + begin
1294 +  if IsInBatchMode then
1295 +    IBError(ibxeInBatchMode,[nil]);
1296 + end;
1297 +
1298   procedure TFB30Statement.CheckHandle;
1299   begin
1300    if FStatementIntf = nil then
1301      IBError(ibxeInvalidStatementHandle,[nil]);
1302   end;
1303  
1304 + procedure TFB30Statement.CheckBatchModeAvailable;
1305 + begin
1306 +  if not HasBatchMode then
1307 +    IBError(ibxeBatchModeNotSupported,[nil]);
1308 +  case SQLStatementType of
1309 +  SQLInsert,
1310 +  SQLUpdate: {OK};
1311 +  else
1312 +     IBError(ibxeInvalidBatchQuery,[GetSQLStatementTypeName]);
1313 +  end;
1314 + end;
1315 +
1316   procedure TFB30Statement.GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults
1317    );
1318   begin
1319 <  with Firebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
1319 >  with FFirebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
1320    begin
1321      StatementIntf.getInfo(StatusIntf,1,BytePtr(@info_request),
1322                       GetBufSize, BytePtr(Buffer));
# Line 967 | Line 1324 | begin
1324    end;
1325   end;
1326  
1327 < procedure TFB30Statement.InternalPrepare;
1327 > function TFB30Statement.GetStatementIntf: IStatement;
1328 > begin
1329 >  Result := self;
1330 > end;
1331 >
1332 > procedure TFB30Statement.InternalPrepare(CursorName: AnsiString);
1333 > var GUID : TGUID;
1334   begin
1335    if FPrepared then
1336      Exit;
1337 +
1338 +  FCursor := CursorName;
1339    if (FSQL = '') then
1340      IBError(ibxeEmptyQuery, [nil]);
1341    try
1342      CheckTransaction(FTransactionIntf);
1343 <    with Firebird30ClientAPI do
1343 >    with FFirebird30ClientAPI do
1344      begin
1345 +      if FCursor = '' then
1346 +      begin
1347 +        CreateGuid(GUID);
1348 +        FCursor := GUIDToString(GUID);
1349 +      end;
1350 +
1351        if FHasParamNames then
1352        begin
1353          if FProcessedSQL = '' then
1354 <          FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1354 >          ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1355          FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf,
1356                              (FTransactionIntf as TFB30Transaction).TransactionIntf,
1357                              Length(FProcessedSQL),
1358 <                            PChar(FProcessedSQL),
1358 >                            PAnsiChar(FProcessedSQL),
1359                              FSQLDialect,
1360                              Firebird.IStatement.PREPARE_PREFETCH_METADATA);
1361        end
# Line 992 | Line 1363 | begin
1363        FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf,
1364                            (FTransactionIntf as TFB30Transaction).TransactionIntf,
1365                            Length(FSQL),
1366 <                          PChar(FSQL),
1366 >                          PAnsiChar(FSQL),
1367                            FSQLDialect,
1368                            Firebird.IStatement.PREPARE_PREFETCH_METADATA);
1369        Check4DataBaseError;
1370        FSQLStatementType := TIBSQLStatementTypes(FStatementIntf.getType(StatusIntf));
1371        Check4DataBaseError;
1372  
1373 +      if FSQLStatementType = SQLSelect then
1374 +      begin
1375 +        FStatementIntf.setCursorName(StatusIntf,PAnsiChar(FCursor));
1376 +        Check4DataBaseError;
1377 +      end;
1378        { Done getting the type }
1379        case FSQLStatementType of
1380          SQLGetSegment,
# Line 1031 | Line 1407 | begin
1407        if (FStatementIntf <> nil) then
1408          FreeHandle;
1409        if E is EIBInterBaseError then
1410 <        raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
1411 <                                       EIBInterBaseError(E).IBErrorCode,
1036 <                                       EIBInterBaseError(E).Message +
1037 <                                       sSQLErrorSeparator + FSQL)
1038 <      else
1039 <        raise;
1410 >        E.Message := E.Message + sSQLErrorSeparator + FSQL;
1411 >      raise;
1412      end;
1413    end;
1414    FPrepared := true;
1415 +
1416    FSingleResults := false;
1417    if RetainInterfaces then
1418    begin
# Line 1057 | Line 1430 | begin
1430   end;
1431  
1432   function TFB30Statement.InternalExecute(aTransaction: ITransaction): IResults;
1433 +
1434 +  procedure ExecuteQuery(outMetaData: Firebird.IMessageMetaData=nil; outBuffer: pointer=nil);
1435 +  begin
1436 +    with FFirebird30ClientAPI do
1437 +    begin
1438 +      SavePerfStats(FBeforeStats);
1439 +      FStatementIntf.execute(StatusIntf,
1440 +                             (aTransaction as TFB30Transaction).TransactionIntf,
1441 +                             FSQLParams.MetaData,
1442 +                             FSQLParams.MessageBuffer,
1443 +                             outMetaData,
1444 +                             outBuffer);
1445 +      Check4DataBaseError;
1446 +      FStatisticsAvailable := SavePerfStats(FAfterStats);
1447 +    end;
1448 +  end;
1449 +
1450 + var Cursor: IResultSet;
1451 +
1452   begin
1453    Result := nil;
1454 +  FBatchCompletion := nil;
1455    FBOF := false;
1456    FEOF := false;
1457    FSingleResults := false;
1458 +  FStatisticsAvailable := false;
1459 +  if IsInBatchMode then
1460 +    IBerror(ibxeInBatchMode,[]);
1461    CheckTransaction(aTransaction);
1462    if not FPrepared then
1463      InternalPrepare;
1464    CheckHandle;
1465    if aTransaction <> FTransactionIntf then
1466      AddMonitor(aTransaction as TFB30Transaction);
1467 <  if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1467 >  if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1468      IBError(ibxeInterfaceOutofDate,[nil]);
1469  
1470 +
1471    try
1472 <    with Firebird30ClientAPI do
1472 >    with FFirebird30ClientAPI do
1473      begin
1077      if FCollectStatistics then
1078      begin
1079        UtilIntf.getPerfCounters(StatusIntf,
1080                      (GetAttachment as TFB30Attachment).AttachmentIntf,
1081                      ISQL_COUNTERS,@FBeforeStats);
1082        Check4DataBaseError;
1083      end;
1084
1474        case FSQLStatementType of
1475        SQLSelect:
1476 <        IBError(ibxeIsAExecuteProcedure,[]);
1476 >       {e.g. Update...returning with a single row in Firebird 5 and later}
1477 >      begin
1478 >        Cursor := InternalOpenCursor(aTransaction,false);
1479 >        if not Cursor.IsEof then
1480 >          Cursor.FetchNext;
1481 >        Result := Cursor; {note only first row}
1482 >        FSingleResults := true;
1483 >      end;
1484  
1485        SQLExecProcedure:
1486        begin
1487 <        FStatementIntf.execute(StatusIntf,
1092 <                               (aTransaction as TFB30Transaction).TransactionIntf,
1093 <                               FSQLParams.MetaData,
1094 <                               FSQLParams.MessageBuffer,
1095 <                               FSQLRecord.MetaData,
1096 <                               FSQLRecord.MessageBuffer);
1097 <        Check4DataBaseError;
1098 <
1487 >        ExecuteQuery(FSQLRecord.MetaData,FSQLRecord.MessageBuffer);
1488          Result := TResults.Create(FSQLRecord);
1489          FSingleResults := true;
1101      end
1102      else
1103        FStatementIntf.execute(StatusIntf,
1104                               (aTransaction as TFB30Transaction).TransactionIntf,
1105                               FSQLParams.MetaData,
1106                               FSQLParams.MessageBuffer,
1107                               nil,
1108                               nil);
1109        Check4DataBaseError;
1490        end;
1491 <      if FCollectStatistics then
1492 <      begin
1493 <        UtilIntf.getPerfCounters(StatusIntf,
1114 <                  (GetAttachment as TFB30Attachment).AttachmentIntf,
1115 <                  ISQL_COUNTERS, @FAfterStats);
1116 <        Check4DataBaseError;
1117 <        FStatisticsAvailable := true;
1491 >
1492 >      else
1493 >        ExecuteQuery;
1494        end;
1495      end;
1496    finally
# Line 1122 | Line 1498 | begin
1498         RemoveMonitor(aTransaction as TFB30Transaction);
1499    end;
1500    FExecTransactionIntf := aTransaction;
1501 +  FSQLRecord.FTransaction := (aTransaction as TFB30Transaction);
1502 +  FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1503    SignalActivity;
1504    Inc(FChangeSeqNo);
1505   end;
1506  
1507 < function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction
1508 <  ): IResultSet;
1507 > function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction;
1508 >  Scrollable: boolean): IResultSet;
1509 > var flags: cardinal;
1510   begin
1511 <  if FSQLStatementType <> SQLSelect then
1511 >  flags := 0;
1512 >  if (FSQLStatementType <> SQLSelect) and not (stHasCursor in getFlags) then
1513     IBError(ibxeIsASelectStatement,[]);
1514  
1515 < CheckTransaction(aTransaction);
1515 >  FBatchCompletion := nil;
1516 >  CheckTransaction(aTransaction);
1517    if not FPrepared then
1518      InternalPrepare;
1519    CheckHandle;
1520    if aTransaction <> FTransactionIntf then
1521      AddMonitor(aTransaction as TFB30Transaction);
1522 <  if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1522 >  if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1523      IBError(ibxeInterfaceOutofDate,[nil]);
1524  
1525 < with Firebird30ClientAPI do
1525 > if Scrollable then
1526 >   flags := Firebird.IStatement.CURSOR_TYPE_SCROLLABLE;
1527 >
1528 > with FFirebird30ClientAPI do
1529   begin
1530     if FCollectStatistics then
1531     begin
# Line 1156 | Line 1540 | begin
1540                            FSQLParams.MetaData,
1541                            FSQLParams.MessageBuffer,
1542                            FSQLRecord.MetaData,
1543 <                          0);
1543 >                          flags);
1544     Check4DataBaseError;
1545  
1546     if FCollectStatistics then
# Line 1181 | Line 1565 | begin
1565   Inc(FChangeSeqNo);
1566   end;
1567  
1568 + procedure TFB30Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean;
1569 +  var processedSQL: AnsiString);
1570 + begin
1571 +  FSQLParams.PreprocessSQL(sql,GenerateParamNames,processedSQL);
1572 + end;
1573 +
1574   procedure TFB30Statement.FreeHandle;
1575   begin
1576    Close;
1577    ReleaseInterfaces;
1578 +  if FBatch <> nil then
1579 +  begin
1580 +    FBatch.release;
1581 +    FBatch := nil;
1582 +  end;
1583    if FStatementIntf <> nil then
1584    begin
1585      FStatementIntf.release;
1586      FStatementIntf := nil;
1587      FPrepared := false;
1588    end;
1589 +  FCursor := '';
1590   end;
1591  
1592   procedure TFB30Statement.InternalClose(Force: boolean);
1593   begin
1594    if (FStatementIntf <> nil) and (SQLStatementType = SQLSelect) and FOpen then
1595    try
1596 <    with Firebird30ClientAPI do
1596 >    with FFirebird30ClientAPI do
1597      begin
1598        if FResultSet <> nil then
1599        begin
# Line 1211 | Line 1607 | begin
1607        if not Force then Check4DataBaseError;
1608      end;
1609    finally
1610 <    if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> FTransactionIntf) then
1610 >    if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> (FTransactionIntf as TFB30Transaction)) then
1611        RemoveMonitor(FSQLRecord.FTransaction);
1612      FOpen := False;
1613      FExecTransactionIntf := nil;
# Line 1221 | Line 1617 | begin
1617    Inc(FChangeSeqNo);
1618   end;
1619  
1620 + function TFB30Statement.SavePerfStats(var Stats: TPerfStatistics): boolean;
1621 + begin
1622 +  Result := false;
1623 +  if FCollectStatistics then
1624 +  with FFirebird30ClientAPI do
1625 +  begin
1626 +    UtilIntf.getPerfCounters(StatusIntf,
1627 +              (GetAttachment as TFB30Attachment).AttachmentIntf,
1628 +              ISQL_COUNTERS, @Stats);
1629 +    Check4DataBaseError;
1630 +    Result := true;
1631 +  end;
1632 + end;
1633 +
1634   constructor TFB30Statement.Create(Attachment: TFB30Attachment;
1635 <  Transaction: ITransaction; sql: string; aSQLDialect: integer);
1635 >  Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1636 >  CursorName: AnsiString);
1637   begin
1638    inherited Create(Attachment,Transaction,sql,aSQLDialect);
1639 +  FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1640    FSQLParams := TIBXINPUTSQLDA.Create(self);
1641    FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1642 <  InternalPrepare;
1642 >  InternalPrepare(CursorName);
1643   end;
1644  
1645   constructor TFB30Statement.CreateWithParameterNames(
1646 <  Attachment: TFB30Attachment; Transaction: ITransaction; sql: string;
1647 <  aSQLDialect: integer; GenerateParamNames: boolean);
1646 >  Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString;
1647 >  aSQLDialect: integer; GenerateParamNames: boolean;
1648 >  CaseSensitiveParams: boolean; CursorName: AnsiString);
1649   begin
1650    inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1651 +  FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1652    FSQLParams := TIBXINPUTSQLDA.Create(self);
1653 +  FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1654    FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1655 <  InternalPrepare;
1655 >  InternalPrepare(CursorName);
1656   end;
1657  
1658   destructor TFB30Statement.Destroy;
# Line 1247 | Line 1662 | begin
1662    if assigned(FSQLRecord) then FSQLRecord.Free;
1663   end;
1664  
1665 < function TFB30Statement.FetchNext: boolean;
1665 > function TFB30Statement.Fetch(FetchType: TFetchType; PosOrOffset: integer
1666 >  ): boolean;
1667   var fetchResult: integer;
1668   begin
1669    result := false;
1670    if not FOpen then
1671      IBError(ibxeSQLClosed, [nil]);
1256  if FEOF then
1257    IBError(ibxeEOF,[nil]);
1672  
1673 <  with Firebird30ClientAPI do
1673 >  with FFirebird30ClientAPI do
1674    begin
1675 <    { Go to the next record... }
1676 <    fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1677 <    if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1678 <    begin
1679 <      FBOF := false;
1680 <      FEOF := true;
1681 <      Exit; {End of File}
1682 <    end
1683 <    else
1684 <    if fetchResult <> Firebird.IStatus.RESULT_OK then
1685 <    begin
1686 <      try
1687 <        IBDataBaseError;
1274 <      except
1275 <        Close;
1276 <        raise;
1675 >    case FetchType of
1676 >    ftNext:
1677 >      begin
1678 >        if FEOF then
1679 >          IBError(ibxeEOF,[nil]);
1680 >        { Go to the next record... }
1681 >        fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1682 >        if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1683 >        begin
1684 >          FBOF := false;
1685 >          FEOF := true;
1686 >          Exit; {End of File}
1687 >        end
1688        end;
1689 <    end
1690 <    else
1689 >
1690 >    ftPrior:
1691 >      begin
1692 >        if FBOF then
1693 >          IBError(ibxeBOF,[nil]);
1694 >        { Go to the next record... }
1695 >        fetchResult := FResultSet.fetchPrior(StatusIntf,FSQLRecord.MessageBuffer);
1696 >        if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1697 >        begin
1698 >          FBOF := true;
1699 >          FEOF := false;
1700 >          Exit; {Top of File}
1701 >        end
1702 >      end;
1703 >
1704 >    ftFirst:
1705 >      fetchResult := FResultSet.fetchFirst(StatusIntf,FSQLRecord.MessageBuffer);
1706 >
1707 >    ftLast:
1708 >      fetchResult := FResultSet.fetchLast(StatusIntf,FSQLRecord.MessageBuffer);
1709 >
1710 >    ftAbsolute:
1711 >      fetchResult := FResultSet.fetchAbsolute(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1712 >
1713 >    ftRelative:
1714 >      fetchResult := FResultSet.fetchRelative(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1715 >    end;
1716 >
1717 >    Check4DataBaseError;
1718 >    if fetchResult <> Firebird.IStatus.RESULT_OK then
1719 >      exit; {result = false}
1720 >
1721 >    {Result OK}
1722 >    FBOF := false;
1723 >    FEOF := false;
1724 >    result := true;
1725 >
1726 >    if FCollectStatistics then
1727      begin
1728 <      FBOF := false;
1729 <      result := true;
1728 >      UtilIntf.getPerfCounters(StatusIntf,
1729 >                              (GetAttachment as TFB30Attachment).AttachmentIntf,
1730 >                              ISQL_COUNTERS,@FAfterStats);
1731 >      Check4DataBaseError;
1732 >      FStatisticsAvailable := true;
1733      end;
1734    end;
1735    FSQLRecord.RowChange;
# Line 1304 | Line 1754 | begin
1754    Result := TMetaData(GetInterface(1));
1755   end;
1756  
1757 < function TFB30Statement.GetPlan: String;
1757 > function TFB30Statement.GetPlan: AnsiString;
1758   begin
1759    CheckHandle;
1760    if (not (FSQLStatementType in [SQLSelect, SQLSelectForUpdate,
# Line 1312 | Line 1762 | begin
1762         SQLUpdate, SQLDelete])) then
1763      result := ''
1764    else
1765 <  with Firebird30ClientAPI do
1765 >  with FFirebird30ClientAPI do
1766    begin
1767      Result := FStatementIntf.getPlan(StatusIntf,true);
1768      Check4DataBaseError;
# Line 1346 | Line 1796 | begin
1796      TSQLParams(GetInterface(0)).RetainInterfaces := aValue;
1797   end;
1798  
1799 + function TFB30Statement.IsInBatchMode: boolean;
1800 + begin
1801 +  Result := FBatch <> nil;
1802 + end;
1803 +
1804 + function TFB30Statement.HasBatchMode: boolean;
1805 + begin
1806 +  Result := GetAttachment.HasBatchMode;
1807 + end;
1808 +
1809 + procedure TFB30Statement.AddToBatch;
1810 + var BatchPB: TXPBParameterBlock;
1811 +
1812 + const SixteenMB = 16 * 1024 * 1024;
1813 + begin
1814 +  FBatchCompletion := nil;
1815 +  if not FPrepared then
1816 +    InternalPrepare;
1817 +  CheckHandle;
1818 +  CheckBatchModeAvailable;
1819 +  with FFirebird30ClientAPI do
1820 +  begin
1821 +    if FBatch = nil then
1822 +    begin
1823 +      {Start Batch}
1824 +      BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH);
1825 +      with FFirebird30ClientAPI do
1826 +      try
1827 +        FBatchBufferSize := FBatchRowLimit * FSQLParams.MetaData.getAlignedLength(StatusIntf);
1828 +        Check4DatabaseError;
1829 +        if FBatchBufferSize < SixteenMB then
1830 +          FBatchBufferSize := SixteenMB;
1831 +        if FBatchBufferSize > 256 * 1024 *1024 {assumed limit} then
1832 +          IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]);
1833 +
1834 +        BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1);
1835 +        BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize);
1836 +        FBatch := FStatementIntf.createBatch(StatusIntf,
1837 +                                             FSQLParams.MetaData,
1838 +                                             BatchPB.getDataLength,
1839 +                                             BatchPB.getBuffer);
1840 +        Check4DataBaseError;
1841 +
1842 +      finally
1843 +        BatchPB.Free;
1844 +      end;
1845 +      FBatchRowCount := 0;
1846 +      FBatchBufferUsed := 0;
1847 +    end;
1848 +
1849 +    Inc(FBatchRowCount);
1850 +    Inc(FBatchBufferUsed,FSQLParams.MetaData.getAlignedLength(StatusIntf));
1851 +    Check4DataBaseError;
1852 +    if FBatchBufferUsed > FBatchBufferSize then
1853 +      raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow),
1854 +                              Format(GetErrorMessage(ibxeBatchRowBufferOverflow),
1855 +                              [FBatchRowCount,FBatchBufferSize]));
1856 +
1857 +    FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer);
1858 +      Check4DataBaseError
1859 +  end;
1860 + end;
1861 +
1862 + function TFB30Statement.ExecuteBatch(aTransaction: ITransaction
1863 +  ): IBatchCompletion;
1864 +
1865 + procedure Check4BatchCompletionError(bc: IBatchCompletion);
1866 + var status: IStatus;
1867 +    RowNo: integer;
1868 + begin
1869 +  status := nil;
1870 +  {Raise an exception if there was an error reported in the BatchCompletion}
1871 +  if (bc <> nil) and bc.getErrorStatus(RowNo,status) then
1872 +    raise EIBInterbaseError.Create(status);
1873 + end;
1874 +
1875 + var cs: Firebird.IBatchCompletionState;
1876 +
1877 + begin
1878 +  Result := nil;
1879 +  if FBatch = nil then
1880 +    IBError(ibxeNotInBatchMode,[]);
1881 +
1882 +  with FFirebird30ClientAPI do
1883 +  begin
1884 +    SavePerfStats(FBeforeStats);
1885 +    if aTransaction = nil then
1886 +      cs := FBatch.execute(StatusIntf,(FTransactionIntf as TFB30Transaction).TransactionIntf)
1887 +    else
1888 +      cs := FBatch.execute(StatusIntf,(aTransaction as TFB30Transaction).TransactionIntf);
1889 +    Check4DataBaseError;
1890 +    FBatchCompletion := TBatchCompletion.Create(FFirebird30ClientAPI,cs);
1891 +    FStatisticsAvailable := SavePerfStats(FAfterStats);
1892 +    FBatch.release;
1893 +    FBatch := nil;
1894 +    Check4BatchCompletionError(FBatchCompletion);
1895 +    Result := FBatchCompletion;
1896 +  end;
1897 + end;
1898 +
1899 + procedure TFB30Statement.CancelBatch;
1900 + begin
1901 +  if FBatch = nil then
1902 +    IBError(ibxeNotInBatchMode,[]);
1903 +  FBatch.release;
1904 +  FBatch := nil;
1905 + end;
1906 +
1907 + function TFB30Statement.GetBatchCompletion: IBatchCompletion;
1908 + begin
1909 +  Result := FBatchCompletion;
1910 + end;
1911 +
1912   function TFB30Statement.IsPrepared: boolean;
1913   begin
1914    Result := FStatementIntf <> nil;
1915   end;
1916  
1917 + function TFB30Statement.GetFlags: TStatementFlags;
1918 + var flags: cardinal;
1919 + begin
1920 +  CheckHandle;
1921 +  Result := [];
1922 +  with FFirebird30ClientAPI do
1923 +  begin
1924 +    flags := FStatementIntf.getFlags(StatusIntf);
1925 +    Check4DataBaseError;
1926 +  end;
1927 +  if flags and Firebird.IStatement.FLAG_HAS_CURSOR <> 0 then
1928 +    Result := Result + [stHasCursor];
1929 +  if flags and Firebird.IStatement.FLAG_REPEAT_EXECUTE <> 0 then
1930 +    Result := Result + [stRepeatExecute];
1931 +  if flags and Firebird.IStatement.CURSOR_TYPE_SCROLLABLE <> 0 then
1932 +    Result := Result + [stScrollable];
1933 + end;
1934 +
1935   end.
1936  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines