ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/3.0/FB30Statement.pas
Revision: 309
Committed: Tue Jul 21 08:00:42 2020 UTC (3 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 39423 byte(s)
Log Message:
Fixes Merged

File Contents

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