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: 349
Committed: Mon Oct 18 08:39:40 2021 UTC (2 years, 5 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/2.5/FB25Statement.pas
File size: 38837 byte(s)
Log Message:
FIxes 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 tony 349 SaveMetaData;
501 tony 45 end;
502    
503     procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
504     begin
505     if Value then
506     begin
507 tony 47 IsNullable := true;
508     FNullIndicator := -1;
509 tony 45 Changed;
510     end
511     else
512     if ((not Value) and IsNullable) then
513     begin
514     FNullIndicator := 0;
515     Changed;
516     end;
517     end;
518    
519     procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
520     begin
521     if (Value <> IsNullable) then
522     begin
523     if Value then
524     begin
525     FXSQLVAR^.sqltype := FXSQLVAR^.sqltype or 1;
526     FNullIndicator := 0;
527     FXSQLVAR^.sqlInd := @FNullIndicator;
528     end
529     else
530     begin
531     FXSQLVAR^.sqltype := FXSQLVAR^.sqltype and (not 1);
532     FXSQLVAR^.sqlind := nil;
533     end;
534     end;
535 tony 68 Changed;
536 tony 45 end;
537    
538 tony 56 procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal);
539 tony 45 begin
540     if FOwnsSQLData then
541     FreeMem(FXSQLVAR^.sqldata);
542     FXSQLVAR^.sqldata := AValue;
543     FXSQLVAR^.sqllen := len;
544     FOwnsSQLData := false;
545 tony 68 Changed;
546 tony 45 end;
547    
548     procedure TIBXSQLVAR.SetScale(aValue: integer);
549     begin
550     FXSQLVAR^.sqlscale := aValue;
551 tony 68 Changed;
552 tony 45 end;
553    
554     procedure TIBXSQLVAR.SetDataLength(len: cardinal);
555     begin
556     if not FOwnsSQLData then
557     FXSQLVAR^.sqldata := nil;
558     FXSQLVAR^.sqllen := len;
559 tony 263 with FFirebird25ClientAPI do
560 tony 45 IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
561     FOwnsSQLData := true;
562 tony 68 Changed;
563 tony 45 end;
564    
565     procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
566     begin
567     FXSQLVAR^.sqltype := aValue or (FXSQLVAR^.sqltype and 1);
568 tony 68 Changed;
569 tony 45 end;
570    
571     procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal);
572     begin
573     if aValue <> GetCharSetID then
574 tony 68 begin
575     case SQLType of
576     SQL_VARYING, SQL_TEXT:
577     FXSQLVAR^.sqlsubtype := (aValue and $FF) or (FXSQLVAR^.sqlsubtype and not $FF);
578 tony 45
579 tony 68 SQL_BLOB,
580     SQL_ARRAY:
581     IBError(ibxeInvalidDataConversion,[nil]);
582     end;
583     Changed;
584 tony 45 end;
585     end;
586    
587 tony 345 function TIBXSQLVAR.GetDefaultTextSQLType: cardinal;
588     begin
589     Result := SQL_TEXT;
590     end;
591    
592 tony 45 constructor TIBXSQLVAR.Create(aParent: TIBXSQLDA; aIndex: integer);
593     begin
594     inherited Create(aParent,aIndex);
595     FStatement := aParent.Statement;
596 tony 263 FFirebird25ClientAPI := aParent.FFirebird25ClientAPI;
597 tony 45 end;
598    
599     procedure TIBXSQLVAR.FreeSQLData;
600     begin
601     if FOwnsSQLData then
602     FreeMem(FXSQLVAR^.sqldata);
603     FXSQLVAR^.sqldata := nil;
604     FOwnsSQLData := true;
605     end;
606    
607     procedure TIBXSQLVAR.RowChange;
608     begin
609     inherited RowChange;
610     FBlob := nil;
611     FArray := nil;
612     end;
613    
614    
615     { TResultSet }
616    
617     constructor TResultSet.Create(aResults: TIBXOUTPUTSQLDA);
618     begin
619     inherited Create(aResults);
620     FResults := aResults;
621     FCursorSeqNo := aResults.FStatement.FCursorSeqNo;
622     end;
623    
624     destructor TResultSet.Destroy;
625     begin
626     Close;
627     inherited Destroy;
628     end;
629    
630     function TResultSet.FetchNext: boolean;
631     var i: integer;
632     begin
633     CheckActive;
634     Result := FResults.FStatement.FetchNext;
635     if Result then
636     for i := 0 to getCount - 1 do
637     FResults.Column[i].RowChange;
638     end;
639    
640 tony 56 function TResultSet.GetCursorName: AnsiString;
641 tony 45 begin
642     Result := FResults.FStatement.FCursor;
643     end;
644    
645     function TResultSet.GetTransaction: ITransaction;
646     begin
647     Result := FResults.GetTransaction;
648     end;
649    
650     function TResultSet.IsEof: boolean;
651     begin
652     Result := FResults.FStatement.FEof;
653     end;
654    
655     procedure TResultSet.Close;
656     begin
657     if FCursorSeqNo = FResults.FStatement.FCursorSeqNo then
658     FResults.FStatement.Close;
659     end;
660    
661     { TIBXINPUTSQLDA }
662    
663     procedure TIBXINPUTSQLDA.Bind;
664     begin
665     if Count = 0 then
666     Count := 1;
667 tony 263 with FFirebird25ClientAPI do
668 tony 45 begin
669     if (FXSQLDA <> nil) then
670     if isc_dsql_describe_bind(StatusVector, @(FStatement.Handle), FStatement.SQLDialect,
671     FXSQLDA) > 0 then
672     IBDataBaseError;
673    
674     if FXSQLDA^.sqld > FXSQLDA^.sqln then
675     begin
676     Count := FXSQLDA^.sqld;
677     if isc_dsql_describe_bind(StatusVector, @(FStatement.Handle), FStatement.SQLDialect,
678     FXSQLDA) > 0 then
679     IBDataBaseError;
680     end
681     else
682     if FXSQLDA^.sqld = 0 then
683     Count := 0;
684     end;
685     Initialize;
686     end;
687    
688     function TIBXINPUTSQLDA.IsInputDataArea: boolean;
689     begin
690     Result := true;
691     end;
692    
693     { TIBXOUTPUTSQLDA }
694    
695     procedure TIBXOUTPUTSQLDA.Bind;
696     begin
697     { Allocate an initial output descriptor (with one column) }
698     Count := 1;
699 tony 263 with FFirebird25ClientAPI do
700 tony 45 begin
701     { Using isc_dsql_describe, get the right size for the columns... }
702     if isc_dsql_describe(StatusVector, @(FStatement.Handle), FStatement.SQLDialect, FXSQLDA) > 0 then
703     IBDataBaseError;
704    
705     if FXSQLDA^.sqld > FXSQLDA^.sqln then
706     begin
707     Count := FXSQLDA^.sqld;
708     if isc_dsql_describe(StatusVector, @(FStatement.Handle), FStatement.SQLDialect, FXSQLDA) > 0 then
709     IBDataBaseError;
710     end
711     else
712     if FXSQLDA^.sqld = 0 then
713     Count := 0;
714     end;
715     Initialize;
716     SetUniqueRelationName;
717     end;
718    
719     function TIBXOUTPUTSQLDA.GetTransaction: TFB25Transaction;
720     begin
721     Result := FTransaction;
722     end;
723    
724     procedure TIBXOUTPUTSQLDA.GetData(index: integer; var aIsNull:boolean; var len: short;
725 tony 56 var data: PByte);
726 tony 45 begin
727     with TIBXSQLVAR(Column[index]), FXSQLVAR^ do
728     begin
729     aIsNull := (sqltype and 1 = 1) and (FNullIndicator = -1);
730     data := sqldata;
731     len := sqllen;
732     if not IsNull and ((sqltype and (not 1)) = SQL_VARYING) then
733     begin
734 tony 263 with FFirebird25ClientAPI do
735 tony 45 len := DecodeInteger(data,2);
736     Inc(data,2);
737     end;
738     end;
739     end;
740    
741     function TIBXOUTPUTSQLDA.IsInputDataArea: boolean;
742     begin
743     Result := false;
744     end;
745    
746     { TIBXSQLDA }
747     constructor TIBXSQLDA.Create(aStatement: TFB25Statement);
748     begin
749     inherited Create;
750     FStatement := aStatement;
751 tony 263 FFirebird25ClientAPI := aStatement.FFirebird25ClientAPI;
752 tony 45 FSize := 0;
753     // writeln('Creating ',ClassName);
754     end;
755    
756     destructor TIBXSQLDA.Destroy;
757     begin
758     FreeXSQLDA;
759     // writeln('Destroying ',ClassName);
760     inherited Destroy;
761     end;
762    
763     function TIBXSQLDA.CheckStatementStatus(Request: TStatementStatus): boolean;
764     begin
765     Result := false;
766     case Request of
767     ssPrepared:
768     Result := FStatement.IsPrepared;
769    
770     ssExecuteResults:
771     Result :=FStatement.FSingleResults;
772    
773     ssCursorOpen:
774     Result := FStatement.FOpen;
775    
776     ssBOF:
777     Result := FStatement.FBOF;
778    
779     ssEOF:
780     Result := FStatement.FEOF;
781     end;
782     end;
783    
784     function TIBXSQLDA.ColumnsInUseCount: integer;
785     begin
786     Result := FCount;
787     end;
788    
789     function TIBXSQLDA.GetRecordSize: Integer;
790     begin
791     result := SizeOf(TIBXSQLDA) + XSQLDA_LENGTH(FSize);
792     end;
793    
794     function TIBXSQLDA.GetXSQLDA: PXSQLDA;
795     begin
796     result := FXSQLDA;
797     end;
798    
799     function TIBXSQLDA.GetTransactionSeqNo: integer;
800     begin
801     Result := FTransactionSeqNo;
802     end;
803    
804     procedure TIBXSQLDA.Initialize;
805     begin
806     if FXSQLDA <> nil then
807     inherited Initialize;
808     end;
809    
810     function TIBXSQLDA.StateChanged(var ChangeSeqNo: integer): boolean;
811     begin
812     Result := FStatement.ChangeSeqNo <> ChangeSeqNo;
813     if Result then
814     ChangeSeqNo := FStatement.ChangeSeqNo;
815     end;
816    
817     function TIBXSQLDA.GetTransaction: TFB25Transaction;
818     begin
819     Result := FStatement.GetTransaction as TFB25Transaction;
820     end;
821    
822     procedure TIBXSQLDA.SetCount(Value: Integer);
823     var
824     i, OldSize: Integer;
825     p : PXSQLVAR;
826     begin
827     FCount := Value;
828     if FCount = 0 then
829     FUniqueRelationName := ''
830     else
831     begin
832     if FSize > 0 then
833     OldSize := XSQLDA_LENGTH(FSize)
834     else
835     OldSize := 0;
836     if Count > FSize then
837     begin
838 tony 263 FFirebird25ClientAPI.IBAlloc(FXSQLDA, OldSize, XSQLDA_LENGTH(Count));
839 tony 45 SetLength(FColumnList, FCount);
840     FXSQLDA^.version := SQLDA_VERSION1;
841     p := @FXSQLDA^.sqlvar[0];
842     for i := 0 to Count - 1 do
843     begin
844     if i >= FSize then
845     FColumnList[i] := TIBXSQLVAR.Create(self,i);
846     TIBXSQLVAR(Column[i]).FXSQLVAR := p;
847 tony 56 p := Pointer(PAnsiChar(p) + sizeof(FXSQLDA^.sqlvar));
848 tony 45 end;
849     FSize := inherited Count;
850     end;
851     if FSize > 0 then
852     begin
853     FXSQLDA^.sqln := Value;
854     FXSQLDA^.sqld := Value;
855     end;
856     end;
857     end;
858    
859     procedure TIBXSQLDA.FreeXSQLDA;
860     var i: integer;
861     begin
862     if FXSQLDA <> nil then
863     begin
864     // writeln('SQLDA Cleanup');
865     for i := 0 to Count - 1 do
866     TIBXSQLVAR(Column[i]).FreeSQLData;
867     FreeMem(FXSQLDA);
868     FXSQLDA := nil;
869     end;
870     for i := 0 to FSize - 1 do
871     TIBXSQLVAR(Column[i]).Free;
872     SetLength(FColumnList,0);
873     FSize := 0;
874     end;
875    
876     function TIBXSQLDA.GetStatement: IStatement;
877     begin
878     Result := FStatement;
879     end;
880    
881     function TIBXSQLDA.GetPrepareSeqNo: integer;
882     begin
883     Result := FStatement.FPrepareSeqNo;
884     end;
885    
886     { TFB25Statement }
887    
888 tony 47 procedure TFB25Statement.GetPerfCounters(var counters: TPerfStatistics);
889     var DBInfo: IDBInformation;
890     i: integer;
891     {$IFDEF UNIX}
892     times: tms;
893     {$ENDIF}
894     begin
895     {$IFDEF UNIX}
896     FpTimes(times);
897     counters[psUserTime] := times.tms_utime;
898     {$ELSE}
899     counters[psUserTime] := 0;
900     {$ENDIF}
901 tony 56 counters[psRealTime] := TimeStampToMSecs(DateTimeToTimeStamp(Now));
902 tony 47
903     DBInfo := GetAttachment.GetDBInformation([isc_info_reads,isc_info_writes,
904     isc_info_fetches, isc_info_num_buffers, isc_info_current_memory,
905     isc_info_max_memory]);
906     if DBInfo <> nil then
907     begin
908     for i := 0 to DBInfo.Count - 1 do
909     with DBInfo[i] do
910     case getItemType of
911     isc_info_reads:
912     counters[psReads] := AsInteger;
913     isc_info_writes:
914     counters[psWrites] := AsInteger;
915     isc_info_fetches:
916     counters[psFetches] := AsInteger;
917     isc_info_num_buffers:
918     counters[psBuffers] := AsInteger;
919     isc_info_current_memory:
920     counters[psCurrentMemory] := AsInteger;
921     isc_info_max_memory:
922     counters[psMaxMemory] := AsInteger;
923     end;
924     end;
925     end;
926    
927 tony 45 procedure TFB25Statement.CheckHandle;
928     begin
929     if FHandle = nil then
930     IBError(ibxeInvalidStatementHandle,[nil]);
931     end;
932    
933     procedure TFB25Statement.GetDsqlInfo(info_request: byte; buffer: ISQLInfoResults
934     );
935     begin
936 tony 263 with FFirebird25ClientAPI, buffer as TSQLInfoResultsBuffer do
937 tony 45 if isc_dsql_sql_info(StatusVector, @(FHandle), 1, @info_request,
938     GetBufSize, Buffer) > 0 then
939     IBDatabaseError;
940     end;
941    
942     procedure TFB25Statement.InternalPrepare;
943     var
944     RB: ISQLInfoResults;
945     TRHandle: TISC_TR_HANDLE;
946     begin
947     if FPrepared then
948     Exit;
949     if (FSQL = '') then
950     IBError(ibxeEmptyQuery, [nil]);
951     try
952     CheckTransaction(FTransactionIntf);
953 tony 263 with FFirebird25ClientAPI do
954 tony 45 begin
955     Call(isc_dsql_alloc_statement2(StatusVector, @(FDBHandle),
956     @FHandle), True);
957     TRHandle := (FTransactionIntf as TFB25Transaction).Handle;
958     if FHasParamNames then
959     begin
960     if FProcessedSQL = '' then
961 tony 263 ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
962 tony 45 Call(isc_dsql_prepare(StatusVector, @(TRHandle), @FHandle, 0,
963 tony 56 PAnsiChar(FProcessedSQL), FSQLDialect, nil), True);
964 tony 45 end
965     else
966     Call(isc_dsql_prepare(StatusVector, @(TRHandle), @FHandle, 0,
967 tony 56 PAnsiChar(FSQL), FSQLDialect, nil), True);
968 tony 45 end;
969     { After preparing the statement, query the stmt type and possibly
970     create a FSQLRecord "holder" }
971     { Get the type of the statement }
972     RB := GetDsqlInfo(isc_info_sql_stmt_type);
973     if RB.Count > 0 then
974     FSQLStatementType := TIBSQLStatementTypes(RB[0].GetAsInteger)
975     else
976     FSQLStatementType := SQLUnknown;
977    
978     case FSQLStatementType of
979     SQLGetSegment,
980     SQLPutSegment,
981     SQLStartTransaction: begin
982     FreeHandle;
983     IBError(ibxeNotPermitted, [nil]);
984     end;
985     SQLCommit,
986     SQLRollback,
987     SQLDDL, SQLSetGenerator,
988     SQLInsert, SQLUpdate, SQLDelete, SQLSelect, SQLSelectForUpdate,
989     SQLExecProcedure:
990     begin
991     {set up input sqlda}
992     FSQLParams.Bind;
993    
994     {setup output sqlda}
995     if FSQLStatementType in [SQLSelect, SQLSelectForUpdate,
996     SQLExecProcedure] then
997     FSQLRecord.Bind;
998     end;
999     end;
1000     except
1001     on E: Exception do begin
1002     if (FHandle <> nil) then
1003     FreeHandle;
1004     if E is EIBInterBaseError then
1005 tony 315 E.Message := E.Message + sSQLErrorSeparator + FSQL;
1006     raise;
1007 tony 45 end;
1008     end;
1009     FPrepared := true;
1010     FSingleResults := false;
1011     if RetainInterfaces then
1012     begin
1013     SetRetainInterfaces(false);
1014     SetRetainInterfaces(true);
1015     end;
1016     Inc(FPrepareSeqNo);
1017     Inc(FChangeSeqNo);
1018     with FTransactionIntf as TFB25Transaction do
1019     begin
1020     FSQLParams.FTransactionSeqNo := TransactionSeqNo;
1021     FSQLRecord.FTransactionSeqNo := TransactionSeqNo;
1022     end;
1023     end;
1024    
1025     function TFB25Statement.InternalExecute(aTransaction: ITransaction): IResults;
1026     var TRHandle: TISC_TR_HANDLE;
1027     begin
1028     Result := nil;
1029     FBOF := false;
1030     FEOF := false;
1031     FSingleResults := false;
1032     CheckTransaction(aTransaction);
1033     if not FPrepared then
1034     InternalPrepare;
1035     CheckHandle;
1036     if aTransaction <> FTransactionIntf then
1037     AddMonitor(aTransaction as TFB25Transaction);
1038 tony 347 if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB25transaction).TransactionSeqNo) then
1039 tony 45 IBError(ibxeInterfaceOutofDate,[nil]);
1040    
1041     try
1042     TRHandle := (aTransaction as TFB25Transaction).Handle;
1043 tony 263 with FFirebird25ClientAPI do
1044 tony 45 begin
1045 tony 47 if FCollectStatistics then
1046     GetPerfCounters(FBeforeStats);
1047 tony 45
1048 tony 47 case FSQLStatementType of
1049     SQLSelect:
1050     IBError(ibxeIsAExecuteProcedure,[]);
1051    
1052     SQLExecProcedure:
1053     begin
1054     Call(isc_dsql_execute2(StatusVector,
1055     @(TRHandle),
1056     @FHandle,
1057     SQLDialect,
1058     FSQLParams.AsXSQLDA,
1059     FSQLRecord.AsXSQLDA), True);
1060     Result := TResults.Create(FSQLRecord);
1061     FSingleResults := true;
1062     end
1063     else
1064     Call(isc_dsql_execute(StatusVector,
1065     @(TRHandle),
1066     @FHandle,
1067     SQLDialect,
1068     FSQLParams.AsXSQLDA), True);
1069    
1070     end;
1071     if FCollectStatistics then
1072     begin
1073     GetPerfCounters(FAfterStats);
1074     FStatisticsAvailable := true;
1075     end;
1076 tony 45 end;
1077     finally
1078     if aTransaction <> FTransactionIntf then
1079     RemoveMonitor(aTransaction as TFB25Transaction);
1080     end;
1081     FExecTransactionIntf := aTransaction;
1082 tony 111 FSQLRecord.FTransaction := aTransaction as TFB25Transaction;
1083     FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1084 tony 45 Inc(FChangeSeqNo);
1085     end;
1086    
1087     function TFB25Statement.InternalOpenCursor(aTransaction: ITransaction
1088     ): IResultSet;
1089     var TRHandle: TISC_TR_HANDLE;
1090     GUID : TGUID;
1091     begin
1092     if FSQLStatementType <> SQLSelect then
1093     IBError(ibxeIsASelectStatement,[]);
1094    
1095     CheckTransaction(aTransaction);
1096     if not FPrepared then
1097     InternalPrepare;
1098     CheckHandle;
1099     if aTransaction <> FTransactionIntf then
1100     AddMonitor(aTransaction as TFB25Transaction);
1101 tony 347 if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB25transaction).TransactionSeqNo) then
1102 tony 45 IBError(ibxeInterfaceOutofDate,[nil]);
1103    
1104 tony 263 with FFirebird25ClientAPI do
1105 tony 45 begin
1106 tony 47 if FCollectStatistics then
1107     GetPerfCounters(FBeforeStats);
1108    
1109 tony 45 TRHandle := (aTransaction as TFB25Transaction).Handle;
1110     Call(isc_dsql_execute2(StatusVector,
1111     @(TRHandle),
1112     @FHandle,
1113     SQLDialect,
1114     FSQLParams.AsXSQLDA,
1115     nil), True);
1116     if FCursor = '' then
1117     begin
1118     CreateGuid(GUID);
1119     FCursor := GUIDToString(GUID);
1120     Call(
1121 tony 56 isc_dsql_set_cursor_name(StatusVector, @FHandle, PAnsiChar(FCursor), 0),
1122 tony 45 True);
1123     end;
1124 tony 47
1125     if FCollectStatistics then
1126     begin
1127     GetPerfCounters(FAfterStats);
1128     FStatisticsAvailable := true;
1129     end;
1130 tony 45 end;
1131     Inc(FCursorSeqNo);
1132     FSingleResults := false;
1133     FOpen := True;
1134     FExecTransactionIntf := aTransaction;
1135     FBOF := true;
1136     FEOF := false;
1137     FSQLRecord.FTransaction := aTransaction as TFB25Transaction;
1138     FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1139     Result := TResultSet.Create(FSQLRecord);
1140     Inc(FChangeSeqNo);
1141     end;
1142    
1143 tony 263 procedure TFB25Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean;
1144     var processedSQL: AnsiString);
1145     begin
1146     FSQLParams.PreprocessSQL(sql,GenerateParamNames, processedSQL);
1147     end;
1148    
1149 tony 45 procedure TFB25Statement.FreeHandle;
1150     var
1151     isc_res: ISC_STATUS;
1152     begin
1153     Close;
1154     ReleaseInterfaces;
1155     try
1156     if FHandle <> nil then
1157 tony 263 with FFirebird25ClientAPI do
1158 tony 45 begin
1159     isc_res :=
1160     Call(isc_dsql_free_statement(StatusVector, @FHandle, DSQL_drop), False);
1161     if (StatusVector^ = 1) and (isc_res > 0) and (isc_res <> isc_bad_stmt_handle) then
1162     IBDataBaseError;
1163     end;
1164     finally
1165     FHandle := nil;
1166     FCursor := '';
1167     FPrepared := false;
1168     end;
1169     end;
1170    
1171     procedure TFB25Statement.InternalClose(Force: boolean);
1172     var
1173     isc_res: ISC_STATUS;
1174     begin
1175     if (FHandle <> nil) and (SQLStatementType = SQLSelect) and FOpen then
1176     try
1177 tony 263 with FFirebird25ClientAPI do
1178 tony 45 begin
1179     isc_res := Call(
1180     isc_dsql_free_statement(StatusVector, @FHandle, DSQL_close),
1181     False);
1182     if not Force and (StatusVector^ = 1) and (isc_res > 0) and
1183     not getStatus.CheckStatusVector(
1184     [isc_bad_stmt_handle, isc_dsql_cursor_close_err]) then
1185     IBDatabaseError;
1186     end;
1187     finally
1188 tony 56 if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> (FTransactionIntf as TFB25Transaction)) then
1189 tony 45 RemoveMonitor(FSQLRecord.FTransaction);
1190     FOpen := False;
1191     FExecTransactionIntf := nil;
1192     FSQLRecord.FTransaction := nil;
1193     Inc(FChangeSeqNo);
1194     end;
1195     end;
1196    
1197     constructor TFB25Statement.Create(Attachment: TFB25Attachment;
1198 tony 56 Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1199 tony 45 begin
1200     inherited Create(Attachment,Transaction,sql,aSQLDialect);
1201     FDBHandle := Attachment.Handle;
1202 tony 263 FFirebird25ClientAPI := Attachment.Firebird25ClientAPI;
1203     OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
1204 tony 45 FSQLParams := TIBXINPUTSQLDA.Create(self);
1205     FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1206     InternalPrepare;
1207     end;
1208    
1209 tony 270 constructor TFB25Statement.CreateWithParameterNames(
1210     Attachment: TFB25Attachment; Transaction: ITransaction; sql: AnsiString;
1211     aSQLDialect: integer; GenerateParamNames: boolean;
1212     CaseSensitiveParams: boolean);
1213 tony 45 begin
1214     inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1215     FDBHandle := Attachment.Handle;
1216 tony 263 FFirebird25ClientAPI := Attachment.Firebird25ClientAPI;
1217     OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
1218 tony 45 FSQLParams := TIBXINPUTSQLDA.Create(self);
1219 tony 270 FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1220 tony 45 FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1221     InternalPrepare;
1222     end;
1223    
1224     destructor TFB25Statement.Destroy;
1225     begin
1226     inherited Destroy;
1227     if assigned(FSQLParams) then FSQLParams.Free;
1228     if assigned(FSQLRecord) then FSQLRecord.Free;
1229     end;
1230    
1231     function TFB25Statement.FetchNext: boolean;
1232     var
1233     fetch_res: ISC_STATUS;
1234     begin
1235     result := false;
1236     if not FOpen then
1237     IBError(ibxeSQLClosed, [nil]);
1238     if FEOF then
1239     IBError(ibxeEOF,[nil]);
1240    
1241 tony 263 with FFirebird25ClientAPI do
1242 tony 45 begin
1243     { Go to the next record... }
1244     fetch_res :=
1245     Call(isc_dsql_fetch(StatusVector, @FHandle, SQLDialect, FSQLRecord.AsXSQLDA), False);
1246     if (fetch_res = 100) or (getStatus.CheckStatusVector([isc_dsql_cursor_err])) then
1247     begin
1248     FBOF := false;
1249     FEOF := true;
1250     Exit; {End of File}
1251     end
1252     else
1253     if (fetch_res > 0) then
1254     begin
1255     try
1256     IBDataBaseError;
1257     except
1258     Close;
1259     raise;
1260     end;
1261     end
1262     else
1263     begin
1264     FBOF := false;
1265     result := true;
1266     end;
1267 tony 209 if FCollectStatistics then
1268     begin
1269     GetPerfCounters(FAfterStats);
1270     FStatisticsAvailable := true;
1271     end;
1272 tony 45 end;
1273     FSQLRecord.RowChange;
1274     if FEOF then
1275     Inc(FChangeSeqNo);
1276     end;
1277    
1278     function TFB25Statement.GetSQLParams: ISQLParams;
1279     begin
1280     CheckHandle;
1281     if not HasInterface(0) then
1282     AddInterface(0,TSQLParams.Create(FSQLParams));
1283     Result := TSQLParams(GetInterface(0));
1284     end;
1285    
1286     function TFB25Statement.GetMetaData: IMetaData;
1287     begin
1288     CheckHandle;
1289     if not HasInterface(1) then
1290     AddInterface(1, TMetaData.Create(FSQLRecord));
1291     Result := TMetaData(GetInterface(1));
1292     end;
1293    
1294 tony 56 function TFB25Statement.GetPlan: AnsiString;
1295 tony 45 var
1296     RB: ISQLInfoResults;
1297     begin
1298     if (not (FSQLStatementType in [SQLSelect, SQLSelectForUpdate,
1299     {TODO: SQLExecProcedure, }
1300     SQLUpdate, SQLDelete])) then
1301     result := ''
1302     else
1303     begin
1304 tony 263 RB := TSQLInfoResultsBuffer.Create(FFirebird25ClientAPI,4*4096);
1305 tony 45 GetDsqlInfo(isc_info_sql_get_plan,RB);
1306     if RB.Count > 0 then
1307     Result := RB[0].GetAsString;
1308     end;
1309     end;
1310    
1311     function TFB25Statement.CreateBlob(column: TColumnMetaData): IBlob;
1312     begin
1313     if assigned(column) and (column.SQLType <> SQL_Blob) then
1314     IBError(ibxeNotABlob,[nil]);
1315     Result := TFB25Blob.Create(GetAttachment as TFB25Attachment,FExecTransactionIntf as TFB25Transaction,
1316     column.GetBlobMetaData,nil);
1317     end;
1318    
1319     function TFB25Statement.CreateArray(column: TColumnMetaData): IArray;
1320     begin
1321     if assigned(column) and (column.SQLType <> SQL_ARRAY) then
1322     IBError(ibxeNotAnArray,[nil]);
1323     Result := TFB25Array.Create(GetAttachment as TFB25Attachment,FExecTransactionIntf as TFB25Transaction,
1324     column.GetArrayMetaData);
1325     end;
1326    
1327     procedure TFB25Statement.SetRetainInterfaces(aValue: boolean);
1328     begin
1329     inherited SetRetainInterfaces(aValue);
1330     if HasInterface(1) then
1331     TMetaData(GetInterface(1)).RetainInterfaces := aValue;
1332     if HasInterface(0) then
1333     TSQLParams(GetInterface(0)).RetainInterfaces := aValue;
1334     end;
1335    
1336     function TFB25Statement.IsPrepared: boolean;
1337     begin
1338     Result := FHandle <> nil;
1339     end;
1340    
1341     end.
1342