ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/3.0/FB30Statement.pas
Revision: 338
Committed: Wed Jun 9 12:07:56 2021 UTC (3 years, 6 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/3.0/FB30Statement.pas
File size: 39547 byte(s)
Log Message:
Merge Fixes

File Contents

# User Rev Content
1 tony 45 (*
2     * Firebird Interface (fbintf). The fbintf components provide a set of
3     * Pascal language bindings for the Firebird API.
4     *
5     * The contents of this file are subject to the Initial Developer's
6     * Public License Version 1.0 (the "License"); you may not use this
7     * file except in compliance with the License. You may obtain a copy
8     * of the License here:
9     *
10     * http://www.firebirdsql.org/index.php?op=doc&id=idpl
11     *
12     * Software distributed under the License is distributed on an "AS
13     * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14     * implied. See the License for the specific language governing rights
15     * and limitations under the License.
16     *
17     * The Initial Developer of the Original Code is Tony Whyman.
18     *
19     * The Original Code is (C) 2016 Tony Whyman, MWA Software
20     * (http://www.mwasoftware.co.uk).
21     *
22     * All Rights Reserved.
23     *
24     * Contributor(s): ______________________________________.
25     *
26     *)
27     unit FB30Statement;
28 tony 56 {$IFDEF MSWINDOWS}
29     {$DEFINE WINDOWS}
30     {$ENDIF}
31 tony 45
32     {$IFDEF FPC}
33 tony 56 {$mode delphi}
34 tony 45 {$codepage UTF8}
35     {$interfaces COM}
36     {$ENDIF}
37    
38     {This unit is hacked from IBSQL and contains the code for managing an XSQLDA and
39     SQLVars, along with statement preparation, execution and cursor management.
40     Most of the SQLVar code has been moved to unit FBSQLData. Client access is
41     provided through interface rather than direct access to the XSQLDA and XSQLVar
42     objects.}
43    
44     {
45     Note on reference counted interfaces.
46     ------------------------------------
47    
48     TFB30Statement manages both an input and an output SQLDA through the TIBXINPUTSQLDA
49     and TIBXOUTPUTSQLDA objects. As pure objects, these are explicitly destroyed
50     when the statement is destroyed.
51    
52     However, IResultSet is an interface and is returned when a cursor is opened and
53     has a reference for the TIBXOUTPUTSQLDA. The user may discard their reference
54     to the IStatement while still using the IResultSet. This would be a problem if t
55     he underlying TFB30Statement object and its TIBXOUTPUTSQLDA is destroyed while
56     still leaving the TIBXResultSet object in place. Calls to (e.g.) FetchNext would fail.
57    
58     To avoid this problem, TResultsSet objects have a reference to the IStatement
59     interface of the TFB30Statement object. Thus, as long as these "copies" exist,
60     the owning statement is not destroyed even if the user discards their reference
61     to the statement. Note: the TFB30Statement does not have a reference to the TIBXResultSet
62     interface. This way circular references are avoided.
63    
64     To avoid and IResultSet interface being kept to long and no longer synchronised
65     with the query, each statement includes a prepare sequence number, incremented
66     each time the query is prepared. When the IResultSet interface is created, it
67     noted the current prepare sequence number. Whe an IResult interface is accessed
68     it checks this number against the statement's current prepare sequence number.
69     If not the same, an error is raised.
70    
71     A similar strategy is used for the IMetaData, IResults and ISQLParams interfaces.
72     }
73    
74     interface
75    
76     uses
77     Classes, SysUtils, Firebird, IB, FBStatement, FB30ClientAPI, FB30Transaction,
78     FB30Attachment,IBExternals, FBSQLData, FBOutputBlock, FBActivityMonitor;
79    
80     type
81    
82     TFB30Statement = class;
83     TIBXSQLDA = class;
84    
85     { TIBXSQLVAR }
86    
87     TIBXSQLVAR = class(TSQLVarData)
88     private
89     FStatement: TFB30Statement;
90 tony 263 FFirebird30ClientAPI: TFB30ClientAPI;
91 tony 45 FBlob: IBlob; {Cache references}
92     FArray: IArray;
93     FNullIndicator: short;
94     FOwnsSQLData: boolean;
95     FBlobMetaData: IBlobMetaData;
96     FArrayMetaData: IArrayMetaData;
97    
98     {SQL Var Type Data}
99     FSQLType: cardinal;
100     FSQLSubType: integer;
101 tony 56 FSQLData: PByte; {Address of SQL Data in Message Buffer}
102 tony 45 FSQLNullIndicator: PShort; {Address of null indicator}
103     FDataLength: integer;
104 tony 315 FMetadataSize: integer;
105 tony 45 FNullable: boolean;
106     FScale: integer;
107     FCharSetID: cardinal;
108 tony 56 FRelationName: AnsiString;
109     FFieldName: AnsiString;
110 tony 45
111     protected
112     function GetSQLType: cardinal; override;
113     function GetSubtype: integer; override;
114 tony 56 function GetAliasName: AnsiString; override;
115     function GetFieldName: AnsiString; override;
116     function GetOwnerName: AnsiString; override;
117     function GetRelationName: AnsiString; override;
118 tony 45 function GetScale: integer; override;
119     function GetCharSetID: cardinal; override;
120     function GetCodePage: TSystemCodePage; override;
121 tony 309 function GetCharSetWidth: integer; override;
122 tony 45 function GetIsNull: Boolean; override;
123     function GetIsNullable: boolean; override;
124 tony 56 function GetSQLData: PByte; override;
125 tony 45 function GetDataLength: cardinal; override;
126 tony 315 function GetSize: cardinal; override;
127 tony 45 procedure SetIsNull(Value: Boolean); override;
128     procedure SetIsNullable(Value: Boolean); override;
129 tony 56 procedure SetSQLData(AValue: PByte; len: cardinal); override;
130 tony 45 procedure SetScale(aValue: integer); override;
131     procedure SetDataLength(len: cardinal); override;
132     procedure SetSQLType(aValue: cardinal); override;
133     procedure SetCharSetID(aValue: cardinal); override;
134    
135     public
136     constructor Create(aParent: TIBXSQLDA; aIndex: integer);
137     procedure Changed; override;
138     procedure RowChange; override;
139     procedure FreeSQLData;
140     function GetAsArray(Array_ID: TISC_QUAD): IArray; override;
141     function GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob; override;
142     function GetArrayMetaData: IArrayMetaData; override;
143     function GetBlobMetaData: IBlobMetaData; override;
144     function CreateBlob: IBlob; override;
145     end;
146    
147     { TIBXSQLDA }
148    
149     TIBXSQLDA = class(TSQLDataArea)
150     private
151     FCount: Integer; {Columns in use - may be less than inherited columns}
152     FSize: Integer; {Number of TIBXSQLVARs in column list}
153     FMetaData: Firebird.IMessageMetadata;
154     FTransactionSeqNo: integer;
155 tony 263 protected
156 tony 45 FStatement: TFB30Statement;
157 tony 263 FFirebird30ClientAPI: TFB30ClientAPI;
158 tony 45 function GetTransactionSeqNo: integer; override;
159     procedure FreeXSQLDA; virtual;
160     function GetStatement: IStatement; override;
161     function GetPrepareSeqNo: integer; override;
162     procedure SetCount(Value: Integer); override;
163     public
164     constructor Create(aStatement: TFB30Statement);
165     destructor Destroy; override;
166     procedure Changed; virtual;
167     function CheckStatementStatus(Request: TStatementStatus): boolean; override;
168     function ColumnsInUseCount: integer; override;
169     function GetTransaction: TFB30Transaction; virtual;
170     procedure Initialize; override;
171     function StateChanged(var ChangeSeqNo: integer): boolean; override;
172     property MetaData: Firebird.IMessageMetadata read FMetaData;
173     property Count: Integer read FCount write SetCount;
174     property Statement: TFB30Statement read FStatement;
175     end;
176    
177     { TIBXINPUTSQLDA }
178    
179     TIBXINPUTSQLDA = class(TIBXSQLDA)
180     private
181 tony 56 FMessageBuffer: PByte; {Message Buffer}
182 tony 45 FMsgLength: integer; {Message Buffer length}
183     FCurMetaData: Firebird.IMessageMetadata;
184     procedure FreeMessageBuffer;
185 tony 56 function GetMessageBuffer: PByte;
186 tony 45 function GetMetaData: Firebird.IMessageMetadata;
187     function GetModified: Boolean;
188     function GetMsgLength: integer;
189 tony 68 procedure BuildMetadata;
190 tony 45 procedure PackBuffer;
191     protected
192     procedure FreeXSQLDA; override;
193     public
194     constructor Create(aStatement: TFB30Statement);
195     destructor Destroy; override;
196     procedure Bind(aMetaData: Firebird.IMessageMetadata);
197     procedure Changed; override;
198     function IsInputDataArea: boolean; override;
199     property MetaData: Firebird.IMessageMetadata read GetMetaData;
200 tony 56 property MessageBuffer: PByte read GetMessageBuffer;
201 tony 45 property MsgLength: integer read GetMsgLength;
202     end;
203    
204     { TIBXOUTPUTSQLDA }
205    
206     TIBXOUTPUTSQLDA = class(TIBXSQLDA)
207     private
208     FTransaction: TFB30Transaction; {transaction used to execute the statement}
209 tony 56 FMessageBuffer: PByte; {Message Buffer}
210 tony 45 FMsgLength: integer; {Message Buffer length}
211     protected
212     procedure FreeXSQLDA; override;
213     public
214     procedure Bind(aMetaData: Firebird.IMessageMetadata);
215     procedure GetData(index: integer; var aIsNull: boolean; var len: short;
216 tony 56 var data: PByte); override;
217 tony 45 function IsInputDataArea: boolean; override;
218 tony 56 property MessageBuffer: PByte read FMessageBuffer;
219 tony 45 property MsgLength: integer read FMsgLength;
220     end;
221    
222     { TResultSet }
223    
224     TResultSet = class(TResults,IResultSet)
225     private
226     FResults: TIBXOUTPUTSQLDA;
227     FCursorSeqNo: integer;
228     public
229     constructor Create(aResults: TIBXOUTPUTSQLDA);
230     destructor Destroy; override;
231     {IResultSet}
232     function FetchNext: boolean;
233 tony 56 function GetCursorName: AnsiString;
234 tony 45 function GetTransaction: ITransaction; override;
235     function IsEof: boolean;
236     procedure Close;
237     end;
238    
239     { TFB30Statement }
240    
241     TFB30Statement = class(TFBStatement,IStatement)
242     private
243     FStatementIntf: Firebird.IStatement;
244 tony 263 FFirebird30ClientAPI: TFB30ClientAPI;
245 tony 45 FSQLParams: TIBXINPUTSQLDA;
246     FSQLRecord: TIBXOUTPUTSQLDA;
247     FResultSet: Firebird.IResultSet;
248     FCursorSeqNo: integer;
249     protected
250     procedure CheckHandle; override;
251     procedure GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults); override;
252     procedure InternalPrepare; override;
253     function InternalExecute(aTransaction: ITransaction): IResults; override;
254     function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override;
255 tony 263 procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override;
256 tony 45 procedure FreeHandle; override;
257     procedure InternalClose(Force: boolean); override;
258     public
259     constructor Create(Attachment: TFB30Attachment; Transaction: ITransaction;
260 tony 56 sql: AnsiString; aSQLDialect: integer);
261 tony 45 constructor CreateWithParameterNames(Attachment: TFB30Attachment; Transaction: ITransaction;
262 tony 270 sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean =false;
263     CaseSensitiveParams: boolean=false);
264 tony 45 destructor Destroy; override;
265     function FetchNext: boolean;
266     property StatementIntf: Firebird.IStatement read FStatementIntf;
267    
268     public
269     {IStatement}
270     function GetSQLParams: ISQLParams; override;
271     function GetMetaData: IMetaData; override;
272 tony 56 function GetPlan: AnsiString;
273 tony 45 function IsPrepared: boolean;
274     function CreateBlob(column: TColumnMetaData): IBlob; override;
275     function CreateArray(column: TColumnMetaData): IArray; override;
276     procedure SetRetainInterfaces(aValue: boolean); override;
277    
278     end;
279    
280     implementation
281    
282 tony 68 uses IBUtils, FBMessages, FBBlob, FB30Blob, variants, FBArray, FB30Array;
283 tony 45
284 tony 47 const
285     ISQL_COUNTERS = 'CurrentMemory, MaxMemory, RealTime, UserTime, Buffers, Reads, Writes, Fetches';
286    
287 tony 45 { TIBXSQLVAR }
288    
289     procedure TIBXSQLVAR.Changed;
290     begin
291     inherited Changed;
292     TIBXSQLDA(Parent).Changed;
293     end;
294    
295     function TIBXSQLVAR.GetSQLType: cardinal;
296     begin
297     Result := FSQLType;
298     end;
299    
300     function TIBXSQLVAR.GetSubtype: integer;
301     begin
302     Result := FSQLSubType;
303     end;
304    
305 tony 56 function TIBXSQLVAR.GetAliasName: AnsiString;
306 tony 45 begin
307 tony 263 with FFirebird30ClientAPI do
308 tony 45 begin
309     result := strpas(TIBXSQLDA(Parent).MetaData.getAlias(StatusIntf,Index));
310     Check4DataBaseError;
311     end;
312     end;
313    
314 tony 56 function TIBXSQLVAR.GetFieldName: AnsiString;
315 tony 45 begin
316     Result := FFieldName;
317     end;
318    
319 tony 56 function TIBXSQLVAR.GetOwnerName: AnsiString;
320 tony 45 begin
321 tony 263 with FFirebird30ClientAPI do
322 tony 45 begin
323     result := strpas(TIBXSQLDA(Parent).MetaData.getOwner(StatusIntf,Index));
324     Check4DataBaseError;
325     end;
326     end;
327    
328 tony 56 function TIBXSQLVAR.GetRelationName: AnsiString;
329 tony 45 begin
330     Result := FRelationName;
331     end;
332    
333     function TIBXSQLVAR.GetScale: integer;
334     begin
335     Result := FScale;
336     end;
337    
338     function TIBXSQLVAR.GetCharSetID: cardinal;
339     begin
340     result := 0;
341     case SQLType of
342     SQL_VARYING, SQL_TEXT:
343     result := FCharSetID;
344    
345     SQL_BLOB:
346     if (SQLSubType = 1) then
347     result := FCharSetID;
348    
349     SQL_ARRAY:
350     if (FRelationName <> '') and (FFieldName <> '') then
351     result := GetArrayMetaData.GetCharSetID
352     else
353     result := FCharSetID;
354     end;
355 tony 60 result := result;
356 tony 45 end;
357    
358     function TIBXSQLVAR.GetCodePage: TSystemCodePage;
359     begin
360     result := CP_NONE;
361 tony 60 with Statement.GetAttachment do
362 tony 45 CharSetID2CodePage(GetCharSetID,result);
363     end;
364    
365 tony 309 function TIBXSQLVAR.GetCharSetWidth: integer;
366     begin
367     result := 1;
368     with Statement.GetAttachment DO
369     CharSetWidth(GetCharSetID,result);
370     end;
371    
372 tony 45 function TIBXSQLVAR.GetIsNull: Boolean;
373     begin
374     Result := IsNullable and (FSQLNullIndicator^ = -1);
375     end;
376    
377     function TIBXSQLVAR.GetIsNullable: boolean;
378     begin
379     Result := FSQLNullIndicator <> nil;
380     end;
381    
382 tony 56 function TIBXSQLVAR.GetSQLData: PByte;
383 tony 45 begin
384     Result := FSQLData;
385     end;
386    
387     function TIBXSQLVAR.GetDataLength: cardinal;
388     begin
389     Result := FDataLength;
390     end;
391    
392 tony 315 function TIBXSQLVAR.GetSize: cardinal;
393     begin
394     Result := FMetadataSize;
395     end;
396    
397 tony 45 function TIBXSQLVAR.GetArrayMetaData: IArrayMetaData;
398     begin
399     if GetSQLType <> SQL_ARRAY then
400     IBError(ibxeInvalidDataConversion,[nil]);
401    
402     if FArrayMetaData = nil then
403     FArrayMetaData := TFB30ArrayMetaData.Create(FStatement.GetAttachment as TFB30Attachment,
404     FStatement.GetTransaction as TFB30Transaction,
405     GetRelationName,GetFieldName);
406     Result := FArrayMetaData;
407     end;
408    
409     function TIBXSQLVAR.GetBlobMetaData: IBlobMetaData;
410     begin
411     if GetSQLType <> SQL_BLOB then
412     IBError(ibxeInvalidDataConversion,[nil]);
413    
414     if FBlobMetaData = nil then
415     FBlobMetaData := TFB30BlobMetaData.Create(FStatement.GetAttachment as TFB30Attachment,
416     FStatement.GetTransaction as TFB30Transaction,
417     GetRelationName,GetFieldName,
418     GetSubType);
419 tony 47 (FBlobMetaData as TFBBlobMetaData).SetCharSetID(GetCharSetID);
420 tony 45 Result := FBlobMetaData;
421     end;
422    
423     procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
424     begin
425     if Value then
426     begin
427     IsNullable := true;
428     FNullIndicator := -1;
429     end
430     else
431     if IsNullable then
432     FNullIndicator := 0;
433 tony 47 Changed;
434 tony 45 end;
435    
436     procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
437     begin
438     if Value = IsNullable then Exit;
439     if Value then
440     begin
441     FSQLNullIndicator := @FNullIndicator;
442     FNullIndicator := 0;
443     end
444     else
445     FSQLNullIndicator := nil;
446 tony 68 Changed;
447 tony 45 end;
448    
449 tony 56 procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal);
450 tony 45 begin
451     if FOwnsSQLData then
452     FreeMem(FSQLData);
453     FSQLData := AValue;
454     FDataLength := len;
455     FOwnsSQLData := false;
456 tony 68 Changed;
457 tony 45 end;
458    
459     procedure TIBXSQLVAR.SetScale(aValue: integer);
460     begin
461     FScale := aValue;
462 tony 68 Changed;
463 tony 45 end;
464    
465     procedure TIBXSQLVAR.SetDataLength(len: cardinal);
466     begin
467     if not FOwnsSQLData then
468     FSQLData := nil;
469     FDataLength := len;
470 tony 263 with FFirebird30ClientAPI do
471 tony 45 IBAlloc(FSQLData, 0, FDataLength);
472     FOwnsSQLData := true;
473 tony 68 Changed;
474 tony 45 end;
475    
476     procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
477     begin
478     FSQLType := aValue;
479 tony 68 Changed;
480 tony 45 end;
481    
482     procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal);
483     begin
484     FCharSetID := aValue;
485 tony 68 Changed;
486 tony 45 end;
487    
488     constructor TIBXSQLVAR.Create(aParent: TIBXSQLDA; aIndex: integer);
489     begin
490     inherited Create(aParent,aIndex);
491     FStatement := aParent.Statement;
492 tony 263 FFirebird30ClientAPI := aParent.FFirebird30ClientAPI;
493 tony 45 end;
494    
495     procedure TIBXSQLVAR.RowChange;
496     begin
497     inherited;
498     FBlob := nil;
499     FArray := nil;
500     end;
501    
502     procedure TIBXSQLVAR.FreeSQLData;
503     begin
504     if FOwnsSQLData then
505     FreeMem(FSQLData);
506     FSQLData := nil;
507     FOwnsSQLData := true;
508     end;
509    
510     function TIBXSQLVAR.GetAsArray(Array_ID: TISC_QUAD): IArray;
511     begin
512     if SQLType <> SQL_ARRAY then
513     IBError(ibxeInvalidDataConversion,[nil]);
514    
515     if IsNull then
516     Result := nil
517     else
518     begin
519     if FArray = nil then
520     FArray := TFB30Array.Create(FStatement.GetAttachment as TFB30Attachment,
521     TIBXSQLDA(Parent).GetTransaction,
522     GetArrayMetaData,Array_ID);
523     Result := FArray;
524     end;
525     end;
526    
527     function TIBXSQLVAR.GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob;
528     begin
529     if FBlob <> nil then
530     Result := FBlob
531     else
532     begin
533     if SQLType <> SQL_BLOB then
534     IBError(ibxeInvalidDataConversion, [nil]);
535     if IsNull then
536     Result := nil
537     else
538     Result := TFB30Blob.Create(FStatement.GetAttachment as TFB30Attachment,
539     TIBXSQLDA(Parent).GetTransaction,
540     GetBlobMetaData,
541     Blob_ID,BPB);
542     FBlob := Result;
543     end;
544     end;
545    
546     function TIBXSQLVAR.CreateBlob: IBlob;
547     begin
548     Result := TFB30Blob.Create(FStatement.GetAttachment as TFB30Attachment,
549     FStatement.GetTransaction as TFB30Transaction,
550     GetSubType,GetCharSetID,nil);
551     end;
552    
553     { TResultSet }
554    
555     constructor TResultSet.Create(aResults: TIBXOUTPUTSQLDA);
556     begin
557     inherited Create(aResults);
558     FResults := aResults;
559     FCursorSeqNo := aResults.FStatement.FCursorSeqNo;
560     end;
561    
562     destructor TResultSet.Destroy;
563     begin
564     Close;
565     inherited Destroy;
566     end;
567    
568     function TResultSet.FetchNext: boolean;
569     var i: integer;
570     begin
571     CheckActive;
572     Result := FResults.FStatement.FetchNext;
573     if Result then
574     for i := 0 to getCount - 1 do
575     FResults.Column[i].RowChange;
576     end;
577    
578 tony 56 function TResultSet.GetCursorName: AnsiString;
579 tony 45 begin
580     IBError(ibxeNotSupported,[nil]);
581     Result := '';
582     end;
583    
584     function TResultSet.GetTransaction: ITransaction;
585     begin
586     Result := FResults.FTransaction;
587     end;
588    
589     function TResultSet.IsEof: boolean;
590     begin
591     Result := FResults.FStatement.FEof;
592     end;
593    
594     procedure TResultSet.Close;
595     begin
596     if FCursorSeqNo = FResults.FStatement.FCursorSeqNo then
597     FResults.FStatement.Close;
598     end;
599    
600     { TIBXINPUTSQLDA }
601    
602     function TIBXINPUTSQLDA.GetModified: Boolean;
603     var
604     i: Integer;
605     begin
606     result := False;
607     for i := 0 to FCount - 1 do
608     if Column[i].Modified then
609     begin
610     result := True;
611     exit;
612     end;
613     end;
614    
615     procedure TIBXINPUTSQLDA.FreeMessageBuffer;
616     begin
617     if FCurMetaData <> nil then
618     begin
619     FCurMetaData.release;
620     FCurMetaData := nil;
621     end;
622     if FMessageBuffer <> nil then
623     begin
624     FreeMem(FMessageBuffer);
625     FMessageBuffer := nil;
626     end;
627     FMsgLength := 0;
628     end;
629    
630 tony 56 function TIBXINPUTSQLDA.GetMessageBuffer: PByte;
631 tony 45 begin
632     PackBuffer;
633     Result := FMessageBuffer;
634     end;
635    
636     function TIBXINPUTSQLDA.GetMetaData: Firebird.IMessageMetadata;
637     begin
638 tony 68 BuildMetadata;
639 tony 45 Result := FCurMetaData;
640     end;
641    
642     function TIBXINPUTSQLDA.GetMsgLength: integer;
643     begin
644     PackBuffer;
645     Result := FMsgLength;
646     end;
647    
648 tony 68 procedure TIBXINPUTSQLDA.BuildMetadata;
649 tony 45 var Builder: Firebird.IMetadataBuilder;
650     i: integer;
651     begin
652 tony 68 if FCurMetaData = nil then
653 tony 263 with FFirebird30ClientAPI do
654 tony 45 begin
655     Builder := inherited MetaData.getBuilder(StatusIntf);
656     Check4DataBaseError;
657     try
658     for i := 0 to Count - 1 do
659     with TIBXSQLVar(Column[i]) do
660     begin
661     Builder.setType(StatusIntf,i,FSQLType);
662     Check4DataBaseError;
663     Builder.setSubType(StatusIntf,i,FSQLSubType);
664     Check4DataBaseError;
665     Builder.setLength(StatusIntf,i,FDataLength);
666     Check4DataBaseError;
667     Builder.setCharSet(StatusIntf,i,GetCharSetID);
668     Check4DataBaseError;
669     Builder.setScale(StatusIntf,i,FScale);
670     Check4DataBaseError;
671     end;
672     FCurMetaData := Builder.getMetadata(StatusIntf);
673     Check4DataBaseError;
674     finally
675     Builder.release;
676     end;
677 tony 68 end;
678     end;
679 tony 45
680 tony 68 procedure TIBXINPUTSQLDA.PackBuffer;
681     var i: integer;
682     begin
683     BuildMetadata;
684    
685     if FMsgLength = 0 then
686 tony 263 with FFirebird30ClientAPI do
687 tony 68 begin
688 tony 45 FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
689     Check4DataBaseError;
690    
691     IBAlloc(FMessageBuffer,0,FMsgLength);
692    
693     for i := 0 to Count - 1 do
694     with TIBXSQLVar(Column[i]) do
695     begin
696 tony 68 if not Modified then
697     IBError(ibxeUninitializedInputParameter,[i,Name]);
698    
699 tony 47 if IsNull then
700     FillChar((FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength,0)
701     else
702 tony 68 if FSQLData <> nil then
703 tony 47 Move(FSQLData^,(FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength);
704 tony 45 Check4DataBaseError;
705     if IsNullable then
706     begin
707     Move(FNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(FNullIndicator));
708     Check4DataBaseError;
709     end;
710     end;
711     end;
712     end;
713    
714     procedure TIBXINPUTSQLDA.FreeXSQLDA;
715     begin
716     inherited FreeXSQLDA;
717     FreeMessageBuffer;
718     end;
719    
720     constructor TIBXINPUTSQLDA.Create(aStatement: TFB30Statement);
721     begin
722     inherited Create(aStatement);
723     FMessageBuffer := nil;
724     end;
725    
726     destructor TIBXINPUTSQLDA.Destroy;
727     begin
728     FreeMessageBuffer;
729     inherited Destroy;
730     end;
731    
732     procedure TIBXINPUTSQLDA.Bind(aMetaData: Firebird.IMessageMetadata);
733     var i: integer;
734     begin
735     FMetaData := aMetaData;
736 tony 263 with FFirebird30ClientAPI do
737 tony 45 begin
738 tony 338 Count := aMetadata.getCount(StatusIntf);
739 tony 45 Check4DataBaseError;
740     Initialize;
741    
742     for i := 0 to Count - 1 do
743     with TIBXSQLVar(Column[i]) do
744     begin
745     FSQLType := aMetaData.getType(StatusIntf,i);
746     Check4DataBaseError;
747     if FSQLType = SQL_BLOB then
748     begin
749     FSQLSubType := aMetaData.getSubType(StatusIntf,i);
750     Check4DataBaseError;
751     end
752     else
753     FSQLSubType := 0;
754     FDataLength := aMetaData.getLength(StatusIntf,i);
755 tony 315 FMetadataSize := FDataLength;
756 tony 45 Check4DataBaseError;
757     case SQLType of
758     SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
759     SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
760 tony 315 SQL_LONG, SQL_INT64, SQL_INT128, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT,
761     SQL_TIMESTAMP_TZ, SQL_TIME_TZ, SQL_DEC_FIXED, SQL_DEC16, SQL_DEC34,
762     SQL_TIMESTAMP_TZ_EX, SQL_TIME_TZ_EX:
763 tony 45 begin
764     if (FDataLength = 0) then
765     { Make sure you get a valid pointer anyway
766     select '' from foo }
767     IBAlloc(FSQLData, 0, 1)
768     else
769     IBAlloc(FSQLData, 0, FDataLength)
770     end;
771 tony 47 SQL_VARYING:
772 tony 45 IBAlloc(FSQLData, 0, FDataLength + 2);
773     else
774     IBError(ibxeUnknownSQLDataType, [sqltype and (not 1)])
775     end;
776     FNullable := aMetaData.isNullable(StatusIntf,i);
777     FOwnsSQLData := true;
778     Check4DataBaseError;
779     FNullIndicator := -1;
780     if FNullable then
781     FSQLNullIndicator := @FNullIndicator
782     else
783     FSQLNullIndicator := nil;
784     FScale := aMetaData.getScale(StatusIntf,i);
785     Check4DataBaseError;
786 tony 60 FCharSetID := aMetaData.getCharSet(StatusIntf,i) and $FF;
787 tony 45 Check4DataBaseError;
788     end;
789     end;
790     end;
791    
792     procedure TIBXINPUTSQLDA.Changed;
793     begin
794     inherited Changed;
795     FreeMessageBuffer;
796     end;
797    
798     function TIBXINPUTSQLDA.IsInputDataArea: boolean;
799     begin
800     Result := true;
801     end;
802    
803     { TIBXOUTPUTSQLDA }
804    
805     procedure TIBXOUTPUTSQLDA.FreeXSQLDA;
806     begin
807     inherited FreeXSQLDA;
808     FreeMem(FMessageBuffer);
809     FMessageBuffer := nil;
810     FMsgLength := 0;
811     end;
812    
813     procedure TIBXOUTPUTSQLDA.Bind(aMetaData: Firebird.IMessageMetadata);
814     var i: integer;
815     begin
816     FMetaData := aMetaData;
817 tony 263 with FFirebird30ClientAPI do
818 tony 45 begin
819     Count := metadata.getCount(StatusIntf);
820     Check4DataBaseError;
821     Initialize;
822    
823     FMsgLength := metaData.getMessageLength(StatusIntf);
824     Check4DataBaseError;
825     IBAlloc(FMessageBuffer,0,FMsgLength);
826    
827     for i := 0 to Count - 1 do
828     with TIBXSQLVar(Column[i]) do
829     begin
830     FSQLType := aMetaData.getType(StatusIntf,i);
831     Check4DataBaseError;
832     if FSQLType = SQL_BLOB then
833     begin
834     FSQLSubType := aMetaData.getSubType(StatusIntf,i);
835     Check4DataBaseError;
836     end
837     else
838     FSQLSubType := 0;
839     FBlob := nil;
840     FArray := nil;
841     FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i);
842     Check4DataBaseError;
843     FDataLength := aMetaData.getLength(StatusIntf,i);
844     Check4DataBaseError;
845 tony 315 FMetadataSize := FDataLength;
846 tony 45 FRelationName := strpas(aMetaData.getRelation(StatusIntf,i));
847     Check4DataBaseError;
848     FFieldName := strpas(aMetaData.getField(StatusIntf,i));
849     Check4DataBaseError;
850     FNullable := aMetaData.isNullable(StatusIntf,i);
851     Check4DataBaseError;
852     if FNullable then
853     begin
854     FSQLNullIndicator := PShort(FMessageBuffer + aMetaData.getNullOffset(StatusIntf,i));
855     Check4DataBaseError;
856     end
857     else
858     FSQLNullIndicator := nil;
859     FScale := aMetaData.getScale(StatusIntf,i);
860     Check4DataBaseError;
861 tony 60 FCharSetID := aMetaData.getCharSet(StatusIntf,i) and $FF;
862 tony 45 Check4DataBaseError;
863     end;
864     end;
865     SetUniqueRelationName;
866     end;
867    
868     procedure TIBXOUTPUTSQLDA.GetData(index: integer; var aIsNull: boolean;
869 tony 56 var len: short; var data: PByte);
870 tony 45 begin
871     with TIBXSQLVAR(Column[index]) do
872     begin
873     aIsNull := FNullable and (FSQLNullIndicator^ = -1);
874     data := FSQLData;
875     len := FDataLength;
876     if not IsNull and (FSQLType = SQL_VARYING) then
877     begin
878 tony 263 with FFirebird30ClientAPI do
879 tony 45 len := DecodeInteger(data,2);
880     Inc(Data,2);
881     end;
882     end;
883     end;
884    
885     function TIBXOUTPUTSQLDA.IsInputDataArea: boolean;
886     begin
887     Result := false;
888     end;
889    
890     { TIBXSQLDA }
891     constructor TIBXSQLDA.Create(aStatement: TFB30Statement);
892     begin
893     inherited Create;
894     FStatement := aStatement;
895 tony 263 FFirebird30ClientAPI := aStatement.FFirebird30ClientAPI;
896 tony 45 FSize := 0;
897     // writeln('Creating ',ClassName);
898     end;
899    
900     destructor TIBXSQLDA.Destroy;
901     begin
902     FreeXSQLDA;
903     // writeln('Destroying ',ClassName);
904     inherited Destroy;
905     end;
906    
907     procedure TIBXSQLDA.Changed;
908     begin
909    
910     end;
911    
912     function TIBXSQLDA.CheckStatementStatus(Request: TStatementStatus): boolean;
913     begin
914     Result := false;
915     case Request of
916     ssPrepared:
917     Result := FStatement.IsPrepared;
918    
919     ssExecuteResults:
920     Result :=FStatement.FSingleResults;
921    
922     ssCursorOpen:
923     Result := FStatement.FOpen;
924    
925     ssBOF:
926     Result := FStatement.FBOF;
927    
928     ssEOF:
929     Result := FStatement.FEOF;
930     end;
931     end;
932    
933     function TIBXSQLDA.ColumnsInUseCount: integer;
934     begin
935     Result := FCount;
936     end;
937    
938     function TIBXSQLDA.GetTransaction: TFB30Transaction;
939     begin
940     Result := FStatement.GetTransaction as TFB30Transaction;
941     end;
942    
943     procedure TIBXSQLDA.Initialize;
944     begin
945     if FMetaData <> nil then
946     inherited Initialize;
947     end;
948    
949     function TIBXSQLDA.StateChanged(var ChangeSeqNo: integer): boolean;
950     begin
951     Result := FStatement.ChangeSeqNo <> ChangeSeqNo;
952     if Result then
953     ChangeSeqNo := FStatement.ChangeSeqNo;
954     end;
955    
956     procedure TIBXSQLDA.SetCount(Value: Integer);
957     var
958     i: Integer;
959     begin
960     FCount := Value;
961     if FCount = 0 then
962     FUniqueRelationName := ''
963     else
964     begin
965     SetLength(FColumnList, FCount);
966     for i := FSize to FCount - 1 do
967     FColumnList[i] := TIBXSQLVAR.Create(self,i);
968     FSize := FCount;
969     end;
970     end;
971    
972     function TIBXSQLDA.GetTransactionSeqNo: integer;
973     begin
974     Result := FTransactionSeqNo;
975     end;
976    
977     procedure TIBXSQLDA.FreeXSQLDA;
978     var i: integer;
979     begin
980     if FMetaData <> nil then
981     FMetaData.release;
982     FMetaData := nil;
983     for i := 0 to Count - 1 do
984     TIBXSQLVAR(Column[i]).FreeSQLData;
985     for i := 0 to FSize - 1 do
986     TIBXSQLVAR(Column[i]).Free;
987     SetLength(FColumnList,0);
988     FSize := 0;
989     end;
990    
991     function TIBXSQLDA.GetStatement: IStatement;
992     begin
993     Result := FStatement;
994     end;
995    
996     function TIBXSQLDA.GetPrepareSeqNo: integer;
997     begin
998     Result := FStatement.FPrepareSeqNo;
999     end;
1000    
1001     { TFB30Statement }
1002    
1003     procedure TFB30Statement.CheckHandle;
1004     begin
1005     if FStatementIntf = nil then
1006     IBError(ibxeInvalidStatementHandle,[nil]);
1007     end;
1008    
1009     procedure TFB30Statement.GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults
1010     );
1011     begin
1012 tony 263 with FFirebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
1013 tony 45 begin
1014     StatementIntf.getInfo(StatusIntf,1,BytePtr(@info_request),
1015     GetBufSize, BytePtr(Buffer));
1016     Check4DataBaseError;
1017     end;
1018     end;
1019    
1020     procedure TFB30Statement.InternalPrepare;
1021     begin
1022     if FPrepared then
1023     Exit;
1024     if (FSQL = '') then
1025     IBError(ibxeEmptyQuery, [nil]);
1026     try
1027     CheckTransaction(FTransactionIntf);
1028 tony 263 with FFirebird30ClientAPI do
1029 tony 45 begin
1030     if FHasParamNames then
1031     begin
1032     if FProcessedSQL = '' then
1033 tony 263 ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1034 tony 45 FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf,
1035     (FTransactionIntf as TFB30Transaction).TransactionIntf,
1036     Length(FProcessedSQL),
1037 tony 56 PAnsiChar(FProcessedSQL),
1038 tony 45 FSQLDialect,
1039     Firebird.IStatement.PREPARE_PREFETCH_METADATA);
1040     end
1041     else
1042     FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf,
1043     (FTransactionIntf as TFB30Transaction).TransactionIntf,
1044     Length(FSQL),
1045 tony 56 PAnsiChar(FSQL),
1046 tony 45 FSQLDialect,
1047     Firebird.IStatement.PREPARE_PREFETCH_METADATA);
1048     Check4DataBaseError;
1049     FSQLStatementType := TIBSQLStatementTypes(FStatementIntf.getType(StatusIntf));
1050     Check4DataBaseError;
1051    
1052     { Done getting the type }
1053     case FSQLStatementType of
1054     SQLGetSegment,
1055     SQLPutSegment,
1056     SQLStartTransaction:
1057     begin
1058     FreeHandle;
1059     IBError(ibxeNotPermitted, [nil]);
1060     end;
1061     SQLCommit,
1062     SQLRollback,
1063     SQLDDL, SQLSetGenerator,
1064     SQLInsert, SQLUpdate, SQLDelete, SQLSelect, SQLSelectForUpdate,
1065     SQLExecProcedure:
1066     begin
1067     {set up input sqlda}
1068     FSQLParams.Bind(FStatementIntf.getInputMetadata(StatusIntf));
1069     Check4DataBaseError;
1070    
1071     {setup output sqlda}
1072     if FSQLStatementType in [SQLSelect, SQLSelectForUpdate,
1073     SQLExecProcedure] then
1074     FSQLRecord.Bind(FStatementIntf.getOutputMetadata(StatusIntf));
1075     Check4DataBaseError;
1076     end;
1077     end;
1078     end;
1079     except
1080     on E: Exception do begin
1081     if (FStatementIntf <> nil) then
1082     FreeHandle;
1083     if E is EIBInterBaseError then
1084 tony 315 E.Message := E.Message + sSQLErrorSeparator + FSQL;
1085     raise;
1086 tony 45 end;
1087     end;
1088     FPrepared := true;
1089     FSingleResults := false;
1090     if RetainInterfaces then
1091     begin
1092     SetRetainInterfaces(false);
1093     SetRetainInterfaces(true);
1094     end;
1095     Inc(FPrepareSeqNo);
1096     with GetTransaction as TFB30Transaction do
1097     begin
1098     FSQLParams.FTransactionSeqNo := TransactionSeqNo;
1099     FSQLRecord.FTransactionSeqNo := TransactionSeqNo;
1100     end;
1101     SignalActivity;
1102     Inc(FChangeSeqNo);
1103     end;
1104    
1105     function TFB30Statement.InternalExecute(aTransaction: ITransaction): IResults;
1106     begin
1107     Result := nil;
1108     FBOF := false;
1109     FEOF := false;
1110     FSingleResults := false;
1111     CheckTransaction(aTransaction);
1112     if not FPrepared then
1113     InternalPrepare;
1114     CheckHandle;
1115     if aTransaction <> FTransactionIntf then
1116     AddMonitor(aTransaction as TFB30Transaction);
1117     if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1118     IBError(ibxeInterfaceOutofDate,[nil]);
1119    
1120     try
1121 tony 263 with FFirebird30ClientAPI do
1122 tony 45 begin
1123 tony 47 if FCollectStatistics then
1124     begin
1125     UtilIntf.getPerfCounters(StatusIntf,
1126     (GetAttachment as TFB30Attachment).AttachmentIntf,
1127     ISQL_COUNTERS,@FBeforeStats);
1128     Check4DataBaseError;
1129     end;
1130 tony 45
1131 tony 47 case FSQLStatementType of
1132     SQLSelect:
1133     IBError(ibxeIsAExecuteProcedure,[]);
1134    
1135     SQLExecProcedure:
1136     begin
1137     FStatementIntf.execute(StatusIntf,
1138     (aTransaction as TFB30Transaction).TransactionIntf,
1139     FSQLParams.MetaData,
1140     FSQLParams.MessageBuffer,
1141     FSQLRecord.MetaData,
1142     FSQLRecord.MessageBuffer);
1143     Check4DataBaseError;
1144    
1145     Result := TResults.Create(FSQLRecord);
1146     FSingleResults := true;
1147     end
1148     else
1149     FStatementIntf.execute(StatusIntf,
1150     (aTransaction as TFB30Transaction).TransactionIntf,
1151     FSQLParams.MetaData,
1152     FSQLParams.MessageBuffer,
1153     nil,
1154     nil);
1155     Check4DataBaseError;
1156     end;
1157     if FCollectStatistics then
1158     begin
1159     UtilIntf.getPerfCounters(StatusIntf,
1160     (GetAttachment as TFB30Attachment).AttachmentIntf,
1161     ISQL_COUNTERS, @FAfterStats);
1162     Check4DataBaseError;
1163     FStatisticsAvailable := true;
1164     end;
1165 tony 45 end;
1166     finally
1167     if aTransaction <> FTransactionIntf then
1168     RemoveMonitor(aTransaction as TFB30Transaction);
1169     end;
1170     FExecTransactionIntf := aTransaction;
1171 tony 111 FSQLRecord.FTransaction := (aTransaction as TFB30Transaction);
1172     FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1173 tony 45 SignalActivity;
1174     Inc(FChangeSeqNo);
1175     end;
1176    
1177     function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction
1178     ): IResultSet;
1179     begin
1180     if FSQLStatementType <> SQLSelect then
1181     IBError(ibxeIsASelectStatement,[]);
1182    
1183     CheckTransaction(aTransaction);
1184     if not FPrepared then
1185     InternalPrepare;
1186     CheckHandle;
1187     if aTransaction <> FTransactionIntf then
1188     AddMonitor(aTransaction as TFB30Transaction);
1189     if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1190     IBError(ibxeInterfaceOutofDate,[nil]);
1191    
1192 tony 263 with FFirebird30ClientAPI do
1193 tony 45 begin
1194 tony 47 if FCollectStatistics then
1195     begin
1196     UtilIntf.getPerfCounters(StatusIntf,
1197     (GetAttachment as TFB30Attachment).AttachmentIntf,
1198     ISQL_COUNTERS, @FBeforeStats);
1199     Check4DataBaseError;
1200     end;
1201    
1202 tony 45 FResultSet := FStatementIntf.openCursor(StatusIntf,
1203     (aTransaction as TFB30Transaction).TransactionIntf,
1204     FSQLParams.MetaData,
1205     FSQLParams.MessageBuffer,
1206     FSQLRecord.MetaData,
1207     0);
1208     Check4DataBaseError;
1209 tony 47
1210     if FCollectStatistics then
1211     begin
1212     UtilIntf.getPerfCounters(StatusIntf,
1213     (GetAttachment as TFB30Attachment).AttachmentIntf,
1214     ISQL_COUNTERS,@FAfterStats);
1215     Check4DataBaseError;
1216     FStatisticsAvailable := true;
1217     end;
1218 tony 45 end;
1219     Inc(FCursorSeqNo);
1220     FSingleResults := false;
1221     FOpen := True;
1222     FExecTransactionIntf := aTransaction;
1223     FBOF := true;
1224     FEOF := false;
1225     FSQLRecord.FTransaction := (aTransaction as TFB30Transaction);
1226     FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1227     Result := TResultSet.Create(FSQLRecord);
1228     SignalActivity;
1229     Inc(FChangeSeqNo);
1230     end;
1231    
1232 tony 263 procedure TFB30Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean;
1233     var processedSQL: AnsiString);
1234     begin
1235     FSQLParams.PreprocessSQL(sql,GenerateParamNames,processedSQL);
1236     end;
1237    
1238 tony 45 procedure TFB30Statement.FreeHandle;
1239     begin
1240     Close;
1241     ReleaseInterfaces;
1242     if FStatementIntf <> nil then
1243     begin
1244     FStatementIntf.release;
1245     FStatementIntf := nil;
1246     FPrepared := false;
1247     end;
1248     end;
1249    
1250     procedure TFB30Statement.InternalClose(Force: boolean);
1251     begin
1252     if (FStatementIntf <> nil) and (SQLStatementType = SQLSelect) and FOpen then
1253     try
1254 tony 263 with FFirebird30ClientAPI do
1255 tony 45 begin
1256     if FResultSet <> nil then
1257     begin
1258     if FSQLRecord.FTransaction.InTransaction and
1259     (FSQLRecord.FTransactionSeqNo = FSQLRecord.FTransaction.TransactionSeqNo) then
1260     FResultSet.close(StatusIntf)
1261     else
1262     FResultSet.release;
1263     end;
1264     FResultSet := nil;
1265     if not Force then Check4DataBaseError;
1266     end;
1267     finally
1268 tony 56 if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> (FTransactionIntf as TFB30Transaction)) then
1269 tony 45 RemoveMonitor(FSQLRecord.FTransaction);
1270     FOpen := False;
1271     FExecTransactionIntf := nil;
1272     FSQLRecord.FTransaction := nil;
1273     end;
1274     SignalActivity;
1275     Inc(FChangeSeqNo);
1276     end;
1277    
1278     constructor TFB30Statement.Create(Attachment: TFB30Attachment;
1279 tony 56 Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1280 tony 45 begin
1281     inherited Create(Attachment,Transaction,sql,aSQLDialect);
1282 tony 263 FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1283 tony 45 FSQLParams := TIBXINPUTSQLDA.Create(self);
1284     FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1285     InternalPrepare;
1286     end;
1287    
1288     constructor TFB30Statement.CreateWithParameterNames(
1289 tony 56 Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString;
1290 tony 270 aSQLDialect: integer; GenerateParamNames: boolean;
1291     CaseSensitiveParams: boolean);
1292 tony 45 begin
1293     inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1294 tony 263 FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1295 tony 45 FSQLParams := TIBXINPUTSQLDA.Create(self);
1296 tony 270 FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1297 tony 45 FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1298     InternalPrepare;
1299     end;
1300    
1301     destructor TFB30Statement.Destroy;
1302     begin
1303     inherited Destroy;
1304     if assigned(FSQLParams) then FSQLParams.Free;
1305     if assigned(FSQLRecord) then FSQLRecord.Free;
1306     end;
1307    
1308     function TFB30Statement.FetchNext: boolean;
1309     var fetchResult: integer;
1310     begin
1311     result := false;
1312     if not FOpen then
1313     IBError(ibxeSQLClosed, [nil]);
1314     if FEOF then
1315     IBError(ibxeEOF,[nil]);
1316    
1317 tony 263 with FFirebird30ClientAPI do
1318 tony 45 begin
1319     { Go to the next record... }
1320     fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1321     if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1322     begin
1323     FBOF := false;
1324     FEOF := true;
1325     Exit; {End of File}
1326     end
1327     else
1328     if fetchResult <> Firebird.IStatus.RESULT_OK then
1329     begin
1330     try
1331     IBDataBaseError;
1332     except
1333     Close;
1334     raise;
1335     end;
1336     end
1337     else
1338     begin
1339     FBOF := false;
1340     result := true;
1341     end;
1342 tony 209 if FCollectStatistics then
1343     begin
1344     UtilIntf.getPerfCounters(StatusIntf,
1345     (GetAttachment as TFB30Attachment).AttachmentIntf,
1346     ISQL_COUNTERS,@FAfterStats);
1347     Check4DataBaseError;
1348     FStatisticsAvailable := true;
1349     end;
1350 tony 45 end;
1351     FSQLRecord.RowChange;
1352     SignalActivity;
1353     if FEOF then
1354     Inc(FChangeSeqNo);
1355     end;
1356    
1357     function TFB30Statement.GetSQLParams: ISQLParams;
1358     begin
1359     CheckHandle;
1360     if not HasInterface(0) then
1361     AddInterface(0,TSQLParams.Create(FSQLParams));
1362     Result := TSQLParams(GetInterface(0));
1363     end;
1364    
1365     function TFB30Statement.GetMetaData: IMetaData;
1366     begin
1367     CheckHandle;
1368     if not HasInterface(1) then
1369     AddInterface(1, TMetaData.Create(FSQLRecord));
1370     Result := TMetaData(GetInterface(1));
1371     end;
1372    
1373 tony 56 function TFB30Statement.GetPlan: AnsiString;
1374 tony 45 begin
1375     CheckHandle;
1376     if (not (FSQLStatementType in [SQLSelect, SQLSelectForUpdate,
1377     {TODO: SQLExecProcedure, }
1378     SQLUpdate, SQLDelete])) then
1379     result := ''
1380     else
1381 tony 263 with FFirebird30ClientAPI do
1382 tony 45 begin
1383     Result := FStatementIntf.getPlan(StatusIntf,true);
1384     Check4DataBaseError;
1385     end;
1386     end;
1387    
1388     function TFB30Statement.CreateBlob(column: TColumnMetaData): IBlob;
1389     begin
1390     if assigned(column) and (column.SQLType <> SQL_Blob) then
1391     IBError(ibxeNotABlob,[nil]);
1392     Result := TFB30Blob.Create(GetAttachment as TFB30Attachment,
1393     GetTransaction as TFB30Transaction,
1394     column.GetBlobMetaData,nil);
1395     end;
1396    
1397     function TFB30Statement.CreateArray(column: TColumnMetaData): IArray;
1398     begin
1399     if assigned(column) and (column.SQLType <> SQL_ARRAY) then
1400     IBError(ibxeNotAnArray,[nil]);
1401     Result := TFB30Array.Create(GetAttachment as TFB30Attachment,
1402     GetTransaction as TFB30Transaction,
1403     column.GetArrayMetaData);
1404     end;
1405    
1406     procedure TFB30Statement.SetRetainInterfaces(aValue: boolean);
1407     begin
1408     inherited SetRetainInterfaces(aValue);
1409     if HasInterface(1) then
1410     TMetaData(GetInterface(1)).RetainInterfaces := aValue;
1411     if HasInterface(0) then
1412     TSQLParams(GetInterface(0)).RetainInterfaces := aValue;
1413     end;
1414    
1415     function TFB30Statement.IsPrepared: boolean;
1416     begin
1417     Result := FStatementIntf <> nil;
1418     end;
1419    
1420     end.
1421