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: 345
Committed: Mon Aug 23 14:22:29 2021 UTC (2 years, 7 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/2.5/FB25Statement.pas
File size: 38769 byte(s)
Log Message:
Merged into public release

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