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: 350
Committed: Wed Oct 20 14:58:56 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: 40232 byte(s)
Log Message:
Fixed Merged

File Contents

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