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: 347
Committed: Mon Sep 20 22:08:20 2021 UTC (2 years, 6 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/2.5/FB25Statement.pas
File size: 38821 byte(s)
Log Message:
Updated Merged

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