ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/2.5/FB25Statement.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (3 years, 1 month ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/2.5/FB25Statement.pas
File size: 38412 byte(s)
Log Message:
Updated for IBX 4 release

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