ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBSQLData.pas
Revision: 381
Committed: Sat Jan 15 00:06:22 2022 UTC (7 months ago) by tony
File size: 93102 byte(s)
Log Message:
Release Candidate 1
Line File contents
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 FBSQLData;
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 was hacked out of the IBSQL unit and defines a class used as the
74 base for interfaces accessing SQLDAVar data and Array Elements. The abstract
75 methods are used to customise for an SQLDAVar or Array Element. The empty
76 methods are needed for SQL parameters only. The string getters and setters
77 are virtual as SQLVar and Array encodings of string data is different.}
78
79
80 interface
81
82 uses
83 Classes, SysUtils, IBExternals, {$IFDEF WINDOWS} Windows, {$ENDIF} IB, FBActivityMonitor, FBClientAPI,
84 FmtBCD;
85
86 type
87
88 {The IExTimeZoneServices is only available in FB4 and onwards}
89
90 IExTimeZoneServices = interface(ITimeZoneServices)
91 ['{789c2eeb-c4a7-4fed-837e-0cbdef775904}']
92 {encode/decode - used to encode/decode the wire protocol}
93 procedure EncodeTimestampTZ(timestamp: TDateTime; timezoneID: TFBTimeZoneID;
94 bufptr: PByte); overload;
95 procedure EncodeTimestampTZ(timestamp: TDateTime; timezone: AnsiString;
96 bufptr: PByte); overload;
97 procedure EncodeTimeTZ(time: TDateTime; timezoneID: TFBTimeZoneID; OnDate: TDateTime;
98 bufptr: PByte); overload;
99 procedure EncodeTimeTZ(time: TDateTime; timezone: AnsiString; OnDate: TDateTime;
100 bufptr: PByte); overload;
101 procedure DecodeTimestampTZ(bufptr: PByte; var timestamp: TDateTime;
102 var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload;
103 procedure DecodeTimestampTZ(bufptr: PByte; var timestamp: TDateTime;
104 var dstOffset: smallint; var timezone: AnsiString); overload;
105 procedure DecodeTimestampTZEx(bufptr: PByte; var timestamp: TDateTime;
106 var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload;
107 procedure DecodeTimestampTZEx(bufptr: PByte; var timestamp: TDateTime;
108 var dstOffset: smallint; var timezone: AnsiString); overload;
109 procedure DecodeTimeTZ(bufptr: PByte; OnDate: TDateTime; var time: TDateTime;
110 var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload;
111 procedure DecodeTimeTZ(bufptr: PByte; OnDate: TDateTime; var time: TDateTime;
112 var dstOffset: smallint; var timezone: AnsiString); overload;
113 procedure DecodeTimeTZEx(bufptr: PByte; OnDate: TDateTime; var time: TDateTime;
114 var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload;
115 procedure DecodeTimeTZEx(bufptr: PByte; OnDate: TDateTime; var time: TDateTime;
116 var dstOffset: smallint; var timezone: AnsiString); overload;
117 end;
118
119 { TSQLDataItem }
120
121 TSQLDataItem = class(TFBInterfacedObject)
122 private
123 FFirebirdClientAPI: TFBClientAPI;
124 FTimeZoneServices: IExTimeZoneServices;
125 function GetDateFormatStr(IncludeTime: boolean): AnsiString;
126 function GetTimeFormatStr: AnsiString;
127 function GetTimestampFormatStr: AnsiString;
128 procedure SetAsInteger(AValue: Integer);
129 procedure InternalGetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
130 var aTimezone: AnsiString; var aTimeZoneID: TFBTimeZoneID);
131 protected
132 procedure CheckActive; virtual;
133 procedure CheckTZSupport;
134 function GetAttachment: IAttachment; virtual; abstract;
135 function GetTransaction: ITransaction; virtual; abstract;
136 function GetSQLDialect: integer; virtual; abstract;
137 function GetTimeZoneServices: IExTimeZoneServices; virtual;
138 procedure Changed; virtual;
139 procedure Changing; virtual;
140 procedure InternalSetAsString(Value: AnsiString); virtual;
141 function SQLData: PByte; virtual; abstract;
142 function GetDataLength: cardinal; virtual; abstract;
143 function GetCodePage: TSystemCodePage; virtual; abstract;
144 function getCharSetID: cardinal; virtual; abstract;
145 function Transliterate(s: AnsiString; CodePage: TSystemCodePage): RawByteString;
146 procedure SetScale(aValue: integer); virtual;
147 procedure SetDataLength(len: cardinal); virtual;
148 procedure SetSQLType(aValue: cardinal); virtual;
149 property DataLength: cardinal read GetDataLength write SetDataLength;
150 property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
151 public
152 constructor Create(api: TFBClientAPI);
153 function CanChangeMetaData: boolean; virtual;
154 function GetSQLType: cardinal; virtual; abstract; {Current Field Data SQL Type}
155 function GetSQLTypeName: AnsiString; overload;
156 class function GetSQLTypeName(SQLType: cardinal): AnsiString; overload;
157 function GetStrDataLength: short;
158 function getColMetadata: IParamMetaData; virtual; abstract;
159 function GetName: AnsiString; virtual; abstract;
160 function GetScale: integer; virtual; abstract; {Current Field Data scale}
161 function GetAsBoolean: boolean;
162 function GetAsCurrency: Currency;
163 function GetAsInt64: Int64;
164 function GetAsDateTime: TDateTime; overload;
165 procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
166 procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
167 procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
168 procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
169 procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
170 procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
171 function GetAsUTCDateTime: TDateTime;
172 function GetAsDouble: Double;
173 function GetAsFloat: Float;
174 function GetAsLong: Long;
175 function GetAsPointer: Pointer;
176 function GetAsQuad: TISC_QUAD;
177 function GetAsShort: short;
178 function GetAsString: AnsiString; virtual;
179 function GetAsNumeric: IFBNumeric;
180 function GetIsNull: Boolean; virtual;
181 function GetIsNullable: boolean; virtual;
182 function GetAsVariant: Variant;
183 function GetModified: boolean; virtual;
184 function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
185 function GetAsBCD: tBCD;
186 function GetSize: cardinal; virtual; abstract;
187 function GetCharSetWidth: integer; virtual; abstract;
188 procedure SetAsBoolean(AValue: boolean); virtual;
189 procedure SetAsCurrency(Value: Currency); virtual;
190 procedure SetAsInt64(Value: Int64); virtual;
191 procedure SetAsDate(Value: TDateTime); virtual;
192 procedure SetAsLong(Value: Long); virtual;
193 procedure SetAsTime(Value: TDateTime); overload;
194 procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime;aTimeZoneID: TFBTimeZoneID); overload;
195 procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
196 procedure SetAsDateTime(Value: TDateTime); overload;
197 procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
198 procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
199 procedure SetAsUTCDateTime(aUTCTime: TDateTime);
200 procedure SetAsDouble(Value: Double); virtual;
201 procedure SetAsFloat(Value: Float); virtual;
202 procedure SetAsPointer(Value: Pointer);
203 procedure SetAsQuad(Value: TISC_QUAD);
204 procedure SetAsShort(Value: short); virtual;
205 procedure SetAsString(Value: AnsiString); virtual;
206 procedure SetAsVariant(Value: Variant);
207 procedure SetAsNumeric(Value: IFBNumeric); virtual;
208 procedure SetAsBcd(aValue: tBCD); virtual;
209 procedure SetIsNull(Value: Boolean); virtual;
210 procedure SetIsNullable(Value: Boolean); virtual;
211 procedure SetName(aValue: AnsiString); virtual;
212 property AsDate: TDateTime read GetAsDateTime write SetAsDate;
213 property AsBoolean:boolean read GetAsBoolean write SetAsBoolean;
214 property AsTime: TDateTime read GetAsDateTime write SetAsTime;
215 property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
216 property AsDouble: Double read GetAsDouble write SetAsDouble;
217 property AsFloat: Float read GetAsFloat write SetAsFloat;
218 property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
219 property AsInt64: Int64 read GetAsInt64 write SetAsInt64;
220 property AsInteger: Integer read GetAsLong write SetAsInteger;
221 property AsLong: Long read GetAsLong write SetAsLong;
222 property AsPointer: Pointer read GetAsPointer write SetAsPointer;
223 property AsQuad: TISC_QUAD read GetAsQuad write SetAsQuad;
224 property AsShort: short read GetAsShort write SetAsShort;
225 property AsString: AnsiString read GetAsString write SetAsString;
226 property AsVariant: Variant read GetAsVariant write SetAsVariant;
227 property Modified: Boolean read getModified;
228 property IsNull: Boolean read GetIsNull write SetIsNull;
229 property IsNullable: Boolean read GetIsNullable write SetIsNullable;
230 property Scale: integer read GetScale write SetScale;
231 property SQLType: cardinal read GetSQLType write SetSQLType;
232 end;
233
234 TSQLVarData = class;
235
236 TStatementStatus = (ssPrepared, ssExecuteResults, ssCursorOpen, ssBOF, ssEOF);
237
238 { TSQLDataArea }
239
240 TSQLDataArea = class
241 private
242 FCaseSensitiveParams: boolean;
243 function GetColumn(index: integer): TSQLVarData;
244 function GetCount: integer;
245 protected
246 FUniqueRelationName: AnsiString;
247 FColumnList: array of TSQLVarData;
248 function GetStatement: IStatement; virtual; abstract;
249 function GetAttachment: IAttachment; virtual;
250 function GetTransaction: ITransaction; virtual;
251 function GetPrepareSeqNo: integer; virtual; abstract;
252 function GetTransactionSeqNo: integer; virtual; abstract;
253 procedure SetCount(aValue: integer); virtual; abstract;
254 procedure SetUniqueRelationName;
255 public
256 procedure Initialize; virtual;
257 function IsInputDataArea: boolean; virtual; abstract; {Input to Database}
258 procedure PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
259 var sProcessedSQL: AnsiString);
260 function ColumnsInUseCount: integer; virtual;
261 function ColumnByName(Idx: AnsiString): TSQLVarData;
262 function CheckStatementStatus(Request: TStatementStatus): boolean; virtual; abstract;
263 procedure GetData(index: integer; var IsNull: boolean; var len: short;
264 var data: PByte); virtual;
265 procedure RowChange;
266 function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
267 property CaseSensitiveParams: boolean read FCaseSensitiveParams
268 write FCaseSensitiveParams; {Only used when IsInputDataArea true}
269 function CanChangeMetaData: boolean; virtual; abstract;
270 property Count: integer read GetCount;
271 property Column[index: integer]: TSQLVarData read GetColumn; default;
272 property UniqueRelationName: AnsiString read FUniqueRelationName;
273 property Statement: IStatement read GetStatement;
274 property Attachment: IAttachment read GetAttachment;
275 property PrepareSeqNo: integer read GetPrepareSeqNo;
276 property Transaction: ITransaction read GetTransaction;
277 property TransactionSeqNo: integer read GetTransactionSeqNo;
278 end;
279
280 { TSQLVarData }
281
282 TSQLVarData = class
283 private
284 FParent: TSQLDataArea;
285 FName: AnsiString;
286 FIndex: integer;
287 FModified: boolean;
288 FUniqueName: boolean;
289 FVarString: RawByteString;
290 FColMetaData: IParamMetaData;
291 function GetStatement: IStatement;
292 procedure SetName(AValue: AnsiString);
293 protected
294 FArrayIntf: IArray;
295 function GetAttachment: IAttachment;
296 function GetTransaction: ITransaction;
297 function GetSQLType: cardinal; virtual; abstract;
298 function GetSubtype: integer; virtual; abstract;
299 function GetAliasName: AnsiString; virtual; abstract;
300 function GetFieldName: AnsiString; virtual; abstract;
301 function GetOwnerName: AnsiString; virtual; abstract;
302 function GetRelationName: AnsiString; virtual; abstract;
303 function GetScale: integer; virtual; abstract;
304 function GetCharSetID: cardinal; virtual; abstract;
305 function GetCharSetWidth: integer;
306 function GetCodePage: TSystemCodePage;
307 function GetIsNull: Boolean; virtual; abstract;
308 function GetIsNullable: boolean; virtual; abstract;
309 function GetSQLData: PByte; virtual; abstract;
310 function GetDataLength: cardinal; virtual; abstract; {current field length}
311 function GetSize: cardinal; virtual; abstract; {field length as given by metadata}
312 function GetDefaultTextSQLType: cardinal; virtual; abstract;
313 procedure InternalSetSQLType(aValue: cardinal); virtual; abstract;
314 procedure InternalSetScale(aValue: integer); virtual; abstract;
315 procedure InternalSetDataLength(len: cardinal); virtual; abstract;
316 procedure SetIsNull(Value: Boolean); virtual; abstract;
317 procedure SetIsNullable(Value: Boolean); virtual; abstract;
318 procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
319 procedure SetScale(aValue: integer);
320 procedure SetDataLength(len: cardinal);
321 procedure SetSQLType(aValue: cardinal);
322 procedure SetCharSetID(aValue: cardinal); virtual; abstract;
323 procedure SetMetaSize(aValue: cardinal); virtual;
324 public
325 constructor Create(aParent: TSQLDataArea; aIndex: integer);
326 function CanChangeMetaData: boolean;
327 procedure SetString(aValue: AnsiString);
328 procedure Changed; virtual;
329 procedure RowChange; virtual;
330 function GetAsArray: IArray; virtual; abstract;
331 function GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob; virtual; abstract;
332 function CreateBlob: IBlob; virtual; abstract;
333 function GetArrayMetaData: IArrayMetaData; virtual; abstract;
334 function GetBlobMetaData: IBlobMetaData; virtual; abstract;
335 function getColMetadata: IParamMetaData;
336 procedure Initialize; virtual;
337 procedure SaveMetaData;
338 procedure SetArray(AValue: IArray);
339
340 public
341 property AliasName: AnsiString read GetAliasName;
342 property FieldName: AnsiString read GetFieldName;
343 property OwnerName: AnsiString read GetOwnerName;
344 property RelationName: AnsiString read GetRelationName;
345 property Parent: TSQLDataArea read FParent;
346 property Index: integer read FIndex;
347 property Name: AnsiString read FName write SetName;
348 property CharSetID: cardinal read GetCharSetID write SetCharSetID;
349 property CodePage: TSystemCodePage read GetCodePage;
350 property SQLType: cardinal read GetSQLType write SetSQLType;
351 property SQLSubtype: integer read GetSubtype;
352 property SQLData: PByte read GetSQLData;
353 property DataLength: cardinal read GetDataLength write SetDataLength;
354 property IsNull: Boolean read GetIsNull write SetIsNull;
355 property IsNullable: Boolean read GetIsNullable write SetIsNullable;
356 property Scale: integer read GetScale write SetScale;
357 public
358 property Modified: Boolean read FModified;
359 property Statement: IStatement read GetStatement;
360 property UniqueName: boolean read FUniqueName write FUniqueName;
361 end;
362
363 { TColumnMetaData }
364
365 TColumnMetaData = class(TSQLDataItem,IColumnMetaData,IParamMetaData)
366 private
367 FIBXSQLVAR: TSQLVarData;
368 FOwner: IUnknown; {Keep reference to ensure Metadata/statement not discarded}
369 FPrepareSeqNo: integer;
370 FChangeSeqNo: integer;
371 protected
372 procedure CheckActive; override;
373 function SQLData: PByte; override;
374 function GetDataLength: cardinal; override;
375 function GetCodePage: TSystemCodePage; override;
376
377 public
378 constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
379 destructor Destroy; override;
380 function GetSQLDialect: integer; override;
381 function getColMetadata: IParamMetaData; override;
382
383 public
384 {IColumnMetaData}
385 function GetIndex: integer;
386 function GetSQLType: cardinal; override;
387 function getSubtype: integer;
388 function getRelationName: AnsiString;
389 function getOwnerName: AnsiString;
390 function getSQLName: AnsiString; {Name of the column}
391 function getAliasName: AnsiString; {Alias Name of column or Column Name if not alias}
392 function GetName: AnsiString; override; {Disambiguated uppercase Field Name}
393 function GetScale: integer; override;
394 function getCharSetID: cardinal; override;
395 function GetIsNullable: boolean; override;
396 function GetSize: cardinal; override;
397 function GetCharSetWidth: integer; override;
398 function GetArrayMetaData: IArrayMetaData;
399 function GetBlobMetaData: IBlobMetaData;
400 function GetStatement: IStatement;
401 function GetTransaction: ITransaction; override;
402 function GetAttachment: IAttachment; override;
403 property Name: AnsiString read GetName;
404 property Size: cardinal read GetSize;
405 property CharSetID: cardinal read getCharSetID;
406 property SQLSubtype: integer read getSubtype;
407 property IsNullable: Boolean read GetIsNullable;
408 public
409 property Statement: IStatement read GetStatement;
410 end;
411
412 { TIBSQLData }
413
414 TIBSQLData = class(TColumnMetaData,ISQLData)
415 protected
416 procedure CheckActive; override;
417 public
418 function GetIsNull: Boolean; override;
419 function GetAsArray: IArray;
420 function GetAsBlob: IBlob; overload;
421 function GetAsBlob(BPB: IBPB): IBlob; overload;
422 function GetAsString: AnsiString; override;
423 property AsBlob: IBlob read GetAsBlob;
424 end;
425
426 { TSQLParamMetaData }
427
428 TSQLParamMetaData = class(TFBInterfacedObject,IParamMetaData)
429 private
430 FSQLType: cardinal;
431 FSQLSubType: integer;
432 FScale: integer;
433 FCharSetID: cardinal;
434 FNullable: boolean;
435 FSize: cardinal;
436 FCodePage: TSystemCodePage;
437 public
438 constructor Create(src: TSQLVarData);
439 {IParamMetaData}
440 function GetSQLType: cardinal;
441 function GetSQLTypeName: AnsiString;
442 function getSubtype: integer;
443 function getScale: integer;
444 function getCharSetID: cardinal;
445 function getCodePage: TSystemCodePage;
446 function getIsNullable: boolean;
447 function GetSize: cardinal;
448 property SQLType: cardinal read GetSQLType;
449 end;
450
451 { TSQLParam }
452
453 TSQLParam = class(TIBSQLData,ISQLParam,ISQLData)
454 protected
455 procedure CheckActive; override;
456 procedure Changed; override;
457 procedure InternalSetAsString(Value: AnsiString); override;
458 procedure SetScale(aValue: integer); override;
459 procedure SetDataLength(len: cardinal); override;
460 procedure SetSQLType(aValue: cardinal); override;
461 public
462 procedure Clear;
463 function CanChangeMetaData: boolean; override;
464 function getColMetadata: IParamMetaData; override;
465 function GetModified: boolean; override;
466 function GetAsPointer: Pointer;
467 function GetAsString: AnsiString; override;
468 procedure SetName(Value: AnsiString); override;
469 procedure SetIsNull(Value: Boolean); override;
470 procedure SetIsNullable(Value: Boolean); override;
471 procedure SetAsArray(anArray: IArray);
472
473 {overrides}
474 procedure SetAsBoolean(AValue: boolean);
475 procedure SetAsCurrency(AValue: Currency);
476 procedure SetAsInt64(AValue: Int64);
477 procedure SetAsDate(AValue: TDateTime);
478 procedure SetAsLong(AValue: Long);
479 procedure SetAsTime(AValue: TDateTime); overload;
480 procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
481 procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
482 procedure SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
483 procedure SetAsTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
484 procedure SetAsDateTime(AValue: TDateTime); overload;
485 procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
486 procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
487 procedure SetAsDouble(AValue: Double);
488 procedure SetAsFloat(AValue: Float);
489 procedure SetAsPointer(AValue: Pointer);
490 procedure SetAsShort(AValue: Short);
491 procedure SetAsString(AValue: AnsiString); override;
492 procedure SetAsVariant(AValue: Variant);
493 procedure SetAsBlob(aValue: IBlob);
494 procedure SetAsQuad(AValue: TISC_QUAD);
495 procedure SetCharSetID(aValue: cardinal);
496 procedure SetAsBcd(aValue: tBCD);
497 procedure SetAsNumeric(aValue: IFBNumeric);
498
499 property AsBlob: IBlob read GetAsBlob write SetAsBlob;
500 property IsNullable: Boolean read GetIsNullable write SetIsNullable;
501 end;
502
503 { TMetaData }
504
505 TMetaData = class(TInterfaceOwner,IMetaData)
506 private
507 FPrepareSeqNo: integer;
508 FMetaData: TSQLDataArea;
509 FStatement: IStatement; {ensure FStatement not destroyed until no longer needed}
510 procedure CheckActive;
511 public
512 constructor Create(aMetaData: TSQLDataArea);
513 destructor Destroy; override;
514 public
515 {IMetaData}
516 function GetUniqueRelationName: AnsiString;
517 function getCount: integer;
518 function getColumnMetaData(index: integer): IColumnMetaData;
519 function ByName(Idx: AnsiString): IColumnMetaData;
520 end;
521
522 { TSQLParams }
523
524 TSQLParams = class(TInterfaceOwner,ISQLParams)
525 private
526 FPrepareSeqNo: integer;
527 FChangeSeqNo: integer;
528 FSQLParams: TSQLDataArea;
529 FStatement: IStatement; {ensure FStatement not destroyed until no longer needed}
530 procedure CheckActive;
531 public
532 constructor Create(aSQLParams: TSQLDataArea);
533 destructor Destroy; override;
534 public
535 {ISQLParams}
536 function getCount: integer;
537 function getSQLParam(index: integer): ISQLParam;
538 function ByName(Idx: AnsiString): ISQLParam ; virtual;
539 function GetModified: Boolean;
540 function GetHasCaseSensitiveParams: Boolean;
541 function GetStatement: IStatement;
542 function GetTransaction: ITransaction;
543 function GetAttachment: IAttachment;
544 procedure Clear;
545 end;
546
547 { TResults }
548
549 TResults = class(TInterfaceOwner,IResults)
550 private
551 FPrepareSeqNo: integer;
552 FTransactionSeqNo: integer;
553 FChangeSeqNo: integer;
554 FResults: TSQLDataArea;
555 FStatement: IStatement; {ensure FStatement not destroyed until no longer needed}
556 function GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
557 protected
558 procedure CheckActive;
559 public
560 constructor Create(aResults: TSQLDataArea);
561 {IResults}
562 function getCount: integer;
563 function ByName(Idx: AnsiString): ISQLData; virtual;
564 function getSQLData(index: integer): ISQLData;
565 procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
566 function GetStatement: IStatement;
567 function GetTransaction: ITransaction;
568 function GetAttachment: IAttachment;
569 procedure SetRetainInterfaces(aValue: boolean);
570 end;
571
572 implementation
573
574 uses FBMessages, variants, IBUtils, FBTransaction, FBNumeric, DateUtils;
575
576 { TSQLParamMetaData }
577
578 constructor TSQLParamMetaData.Create(src: TSQLVarData);
579 begin
580 inherited Create;
581 FSQLType := src.GetSQLType;
582 FSQLSubType := src.getSubtype;
583 FScale := src.GetScale;
584 FCharSetID := src.getCharSetID;
585 FNullable := src.GetIsNullable;
586 FSize := src.GetSize;
587 FCodePage := src.GetCodePage;
588 end;
589
590 function TSQLParamMetaData.GetSQLType: cardinal;
591 begin
592 Result := FSQLType;
593 end;
594
595 function TSQLParamMetaData.GetSQLTypeName: AnsiString;
596 begin
597 Result := TSQLDataItem.GetSQLTypeName(FSQLType);
598 end;
599
600 function TSQLParamMetaData.getSubtype: integer;
601 begin
602 Result := FSQLSubType;
603 end;
604
605 function TSQLParamMetaData.getScale: integer;
606 begin
607 Result := FScale;
608 end;
609
610 function TSQLParamMetaData.getCharSetID: cardinal;
611 begin
612 Result := FCharSetID;
613 end;
614
615 function TSQLParamMetaData.getCodePage: TSystemCodePage;
616 begin
617 Result := FCodePage;
618 end;
619
620 function TSQLParamMetaData.getIsNullable: boolean;
621 begin
622 Result := FNullable;
623 end;
624
625 function TSQLParamMetaData.GetSize: cardinal;
626 begin
627 Result := FSize;
628 end;
629
630 { TSQLDataArea }
631
632 function TSQLDataArea.GetColumn(index: integer): TSQLVarData;
633 begin
634 if (index < 0) or (index >= Count) then
635 IBError(ibxeInvalidColumnIndex,[nil]);
636 Result := FColumnList[index];
637 end;
638
639 function TSQLDataArea.GetCount: integer;
640 begin
641 Result := Length(FColumnList);
642 end;
643
644 function TSQLDataArea.GetTransaction: ITransaction;
645 begin
646 Result := GetStatement.GetTransaction;
647 end;
648
649 function TSQLDataArea.GetAttachment: IAttachment;
650 begin
651 Result := GetStatement.GetAttachment;
652 end;
653
654 procedure TSQLDataArea.SetUniqueRelationName;
655 var
656 i: Integer;
657 bUnique: Boolean;
658 RelationName: AnsiString;
659 begin
660 bUnique := True;
661 for i := 0 to ColumnsInUseCount - 1 do
662 begin
663 RelationName := Column[i].RelationName;
664
665 {First get the unique relation name, if any}
666
667 if bUnique and (RelationName <> '') then
668 begin
669 if FUniqueRelationName = '' then
670 FUniqueRelationName := RelationName
671 else
672 if RelationName <> FUniqueRelationName then
673 begin
674 FUniqueRelationName := '';
675 bUnique := False;
676 end;
677 end;
678 end;
679 end;
680
681 procedure TSQLDataArea.Initialize;
682 var
683 i: Integer;
684 begin
685 for i := 0 to ColumnsInUseCount - 1 do
686 Column[i].Initialize;
687 end;
688
689 procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
690 var sProcessedSQL: AnsiString);
691
692 var slNames: TStrings;
693
694 procedure SetColumnNames(slNames: TStrings);
695 var i, j: integer;
696 found: boolean;
697 begin
698 found := false;
699 SetCount(slNames.Count);
700 for i := 0 to slNames.Count - 1 do
701 begin
702 Column[i].Name := slNames[i];
703 Column[i].UniqueName := (slNames.Objects[i] <> nil);
704 end;
705 for i := 0 to Count - 1 do
706 begin
707 if not Column[i].UniqueName then
708 begin
709 found := false;
710 for j := i + 1 to Count - 1 do
711 if Column[i].Name = Column[j].Name then
712 begin
713 found := true;
714 break;
715 end;
716 Column[i].UniqueName := not found;
717 end;
718 end;
719 end;
720
721 begin
722 if not IsInputDataArea then
723 IBError(ibxeNotPermitted,[nil]);
724
725 slNames := TStringList.Create;
726 try
727 sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
728 SetColumnNames(slNames);
729 finally
730 slNames.Free;
731 end;
732 end;
733
734 function TSQLDataArea.ColumnsInUseCount: integer;
735 begin
736 Result := Count;
737 end;
738
739 function TSQLDataArea.ColumnByName(Idx: AnsiString): TSQLVarData;
740 var
741 s: AnsiString;
742 i: Integer;
743 begin
744 if not IsInputDataArea or not CaseSensitiveParams then
745 s := AnsiUpperCase(Idx)
746 else
747 s := Idx;
748
749 for i := 0 to Count - 1 do
750 if Column[i].Name = s then
751 begin
752 Result := Column[i];
753 Exit;
754 end;
755 Result := nil;
756 end;
757
758 procedure TSQLDataArea.GetData(index: integer; var IsNull: boolean;
759 var len: short; var data: PByte);
760 begin
761 //Do Nothing
762 end;
763
764 procedure TSQLDataArea.RowChange;
765 var i: integer;
766 begin
767 for i := 0 to Count - 1 do
768 Column[i].RowChange;
769 end;
770
771 {TSQLVarData}
772
773 function TSQLVarData.GetStatement: IStatement;
774 begin
775 Result := FParent.Statement;
776 end;
777
778 procedure TSQLVarData.SetName(AValue: AnsiString);
779 begin
780 if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
781 FName := AnsiUpperCase(AValue)
782 else
783 FName := AValue;
784 end;
785
786 function TSQLVarData.GetAttachment: IAttachment;
787 begin
788 Result := Parent.Attachment;
789 end;
790
791 function TSQLVarData.GetTransaction: ITransaction;
792 begin
793 Result := Parent.Transaction;
794 end;
795
796 function TSQLVarData.GetCharSetWidth: integer;
797 begin
798 result := 1;
799 GetAttachment.CharSetWidth(GetCharSetID,result);
800 end;
801
802 function TSQLVarData.GetCodePage: TSystemCodePage;
803 begin
804 result := CP_NONE;
805 GetAttachment.CharSetID2CodePage(GetCharSetID,result);
806 end;
807
808 procedure TSQLVarData.SetScale(aValue: integer);
809 begin
810 if aValue = Scale then
811 Exit;
812 if not CanChangeMetaData then
813 IBError(ibxeScaleCannotBeChanged,[]);
814 InternalSetScale(aValue);
815 end;
816
817 procedure TSQLVarData.SetDataLength(len: cardinal);
818 begin
819 if len = DataLength then
820 Exit;
821 InternalSetDataLength(len);
822 end;
823
824 procedure TSQLVarData.SetSQLType(aValue: cardinal);
825 begin
826 if aValue = SQLType then
827 Exit;
828 if not CanChangeMetaData then
829 IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(SQLType),
830 TSQLDataItem.GetSQLTypeName(aValue)]);
831 InternalSetSQLType(aValue);
832 end;
833
834 procedure TSQLVarData.SetMetaSize(aValue: cardinal);
835 begin
836 //Ignore
837 end;
838
839 procedure TSQLVarData.SaveMetaData;
840 begin
841 FColMetaData := TSQLParamMetaData.Create(self);
842 end;
843
844 procedure TSQLVarData.SetArray(AValue: IArray);
845 begin
846 FArrayIntf := AValue;
847 end;
848
849 constructor TSQLVarData.Create(aParent: TSQLDataArea; aIndex: integer);
850 begin
851 inherited Create;
852 FParent := aParent;
853 FIndex := aIndex;
854 FUniqueName := true;
855 end;
856
857 function TSQLVarData.CanChangeMetaData: boolean;
858 begin
859 Result := Parent.CanChangeMetaData;
860 end;
861
862 procedure TSQLVarData.SetString(aValue: AnsiString);
863 begin
864 {we take full advantage here of reference counted strings. When setting a string
865 value, a reference is kept in FVarString and a pointer to it placed in the
866 SQLVar. This avoids string copies. Note that PAnsiChar is guaranteed to point to
867 a zero byte when the string is empty, neatly avoiding a nil pointer error.}
868
869 FVarString := aValue;
870 if SQLType = SQL_BLOB then
871 SetMetaSize(GetAttachment.GetInlineBlobLimit);
872 if CanChangeMetaData then
873 SQLType := GetDefaultTextSQLType;
874 Scale := 0;
875 if (SQLType <> SQL_VARYING) and (SQLType <> SQL_TEXT) then
876 IBError(ibxeUnableTosetaTextType,[Index,Name,TSQLDataItem.GetSQLTypeName(SQLType)]);
877 if not CanChangeMetaData and (Length(aValue) > GetSize) then
878 IBError(ibxeStringOverflow,[Length(aValue),DataLength]);
879 SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
880 end;
881
882 procedure TSQLVarData.Changed;
883 begin
884 FModified := true;
885 end;
886
887 procedure TSQLVarData.RowChange;
888 begin
889 FArrayIntf := nil;
890 FModified := false;
891 FVarString := '';
892 end;
893
894 function TSQLVarData.getColMetadata: IParamMetaData;
895 begin
896 Result := FColMetaData;
897 end;
898
899 procedure TSQLVarData.Initialize;
900
901 function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
902 var
903 k: integer;
904 begin
905 for k := 0 to limit do
906 if Parent.Column[k].Name = idx then
907 begin
908 Result := Parent.Column[k];
909 Exit;
910 end;
911 Result := nil;
912 end;
913
914 var
915 j, j_len: Integer;
916 st: AnsiString;
917 sBaseName: AnsiString;
918 begin
919 RowChange;
920
921 {If an output SQLDA then copy the aliasname to the FName. Ensure
922 that they are all upper case only and disambiguated.
923 }
924
925 if not Parent.IsInputDataArea then
926 begin
927 st := Space2Underscore(AnsiUppercase(AliasName));
928 if st = '' then
929 begin
930 sBaseName := 'F_'; {do not localize}
931 j := 1; j_len := 1;
932 st := sBaseName + IntToStr(j);
933 end
934 else
935 begin
936 j := 0; j_len := 0;
937 sBaseName := st;
938 end;
939
940 {Look for other columns with the same name and make unique}
941
942 while FindVarByName(st,Index-1) <> nil do
943 begin
944 Inc(j);
945 j_len := Length(IntToStr(j));
946 if j_len + Length(sBaseName) > 31 then
947 st := system.Copy(sBaseName, 1, 31 - j_len) + IntToStr(j)
948 else
949 st := sBaseName + IntToStr(j);
950 end;
951
952 Name := st;
953 end;
954 end;
955
956 {TSQLDataItem}
957
958 function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
959 begin
960 {$IF declared(DefaultFormatSettings)}
961 with DefaultFormatSettings do
962 {$ELSE}
963 {$IF declared(FormatSettings)}
964 with FormatSettings do
965 {$IFEND}
966 {$IFEND}
967 case GetSQLDialect of
968 1:
969 if IncludeTime then
970 result := ShortDateFormat + ' ' + LongTimeFormat
971 else
972 result := ShortDateFormat;
973 3:
974 result := ShortDateFormat;
975 end;
976 end;
977
978 function TSQLDataItem.GetTimeFormatStr: AnsiString;
979 begin
980 {$IF declared(DefaultFormatSettings)}
981 with DefaultFormatSettings do
982 {$ELSE}
983 {$IF declared(FormatSettings)}
984 with FormatSettings do
985 {$IFEND}
986 {$IFEND}
987 Result := 'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';;
988 end;
989
990 function TSQLDataItem.GetTimestampFormatStr: AnsiString;
991 begin
992 {$IF declared(DefaultFormatSettings)}
993 with DefaultFormatSettings do
994 {$ELSE}
995 {$IF declared(FormatSettings)}
996 with FormatSettings do
997 {$IFEND}
998 {$IFEND}
999 Result := ShortDateFormat + ' ' + 'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';
1000 end;
1001
1002 procedure TSQLDataItem.SetAsInteger(AValue: Integer);
1003 begin
1004 SetAsLong(aValue);
1005 end;
1006
1007 procedure TSQLDataItem.InternalGetAsDateTime(var aDateTime: TDateTime;
1008 var dstOffset: smallint; var aTimezone: AnsiString;
1009 var aTimeZoneID: TFBTimeZoneID);
1010 begin
1011 CheckActive;
1012 aDateTime := 0;
1013 dstOffset := 0;
1014 aTimezone := '';
1015 aTimeZoneID := TimeZoneID_GMT;
1016 if not IsNull then
1017 with FFirebirdClientAPI do
1018 case SQLType of
1019 SQL_TEXT, SQL_VARYING:
1020 if not ParseDateTimeTZString(AsString,aDateTime,aTimeZone) then
1021 IBError(ibxeInvalidDataConversion, [nil]);
1022 SQL_TYPE_DATE:
1023 aDateTime := SQLDecodeDate(SQLData);
1024 SQL_TYPE_TIME:
1025 aDateTime := SQLDecodeTime(SQLData);
1026 SQL_TIMESTAMP:
1027 aDateTime := SQLDecodeDateTime(SQLData);
1028 SQL_TIMESTAMP_TZ:
1029 begin
1030 GetTimeZoneServices.DecodeTimestampTZ(SQLData,aDateTime,dstOffset,aTimeZone);
1031 aTimeZoneID := PISC_TIMESTAMP_TZ(SQLData)^.time_zone;
1032 end;
1033 SQL_TIMESTAMP_TZ_EX:
1034 begin
1035 GetTimeZoneServices.DecodeTimestampTZEx(SQLData,aDateTime,dstOffset,aTimeZone);
1036 aTimeZoneID := PISC_TIMESTAMP_TZ_EX(SQLData)^.time_zone;
1037 end;
1038 SQL_TIME_TZ:
1039 with GetTimeZoneServices do
1040 begin
1041 DecodeTimeTZ(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1042 aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1043 end;
1044 SQL_TIME_TZ_EX:
1045 with GetTimeZoneServices do
1046 begin
1047 DecodeTimeTZEx(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1048 aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1049 end;
1050 else
1051 IBError(ibxeInvalidDataConversion, [nil]);
1052 end;
1053 end;
1054
1055 procedure TSQLDataItem.CheckActive;
1056 begin
1057 //Do nothing by default
1058 end;
1059
1060 procedure TSQLDataItem.CheckTZSupport;
1061 begin
1062 if not FFirebirdClientAPI.HasTimeZoneSupport then
1063 IBError(ibxeNoTimezoneSupport,[]);
1064 end;
1065
1066 function TSQLDataItem.GetTimeZoneServices: IExTimeZoneServices;
1067 begin
1068 if FTimeZoneServices = nil then
1069 begin
1070 if not GetAttachment.HasTimeZoneSupport then
1071 IBError(ibxeNoTimezoneSupport,[]);
1072 GetAttachment.GetTimeZoneServices.QueryInterface(IExTimeZoneServices,FTimeZoneServices);
1073 end;
1074 Result := FTimeZoneServices;
1075 end;
1076
1077 procedure TSQLDataItem.Changed;
1078 begin
1079 //Do nothing by default
1080 end;
1081
1082 procedure TSQLDataItem.Changing;
1083 begin
1084 //Do nothing by default
1085 end;
1086
1087 procedure TSQLDataItem.InternalSetAsString(Value: AnsiString);
1088 begin
1089 //Do nothing by default
1090 end;
1091
1092 function TSQLDataItem.Transliterate(s: AnsiString; CodePage: TSystemCodePage
1093 ): RawByteString;
1094 begin
1095 Result := s;
1096 if StringCodePage(Result) <> CodePage then
1097 SetCodePage(Result,CodePage,CodePage <> CP_NONE);
1098 end;
1099
1100 procedure TSQLDataItem.SetScale(aValue: integer);
1101 begin
1102 //Do nothing by default
1103 end;
1104
1105 procedure TSQLDataItem.SetDataLength(len: cardinal);
1106 begin
1107 //Do nothing by default
1108 end;
1109
1110 procedure TSQLDataItem.SetSQLType(aValue: cardinal);
1111 begin
1112 //Do nothing by default
1113 end;
1114
1115 constructor TSQLDataItem.Create(api: TFBClientAPI);
1116 begin
1117 inherited Create;
1118 FFirebirdClientAPI := api;
1119 end;
1120
1121 function TSQLDataItem.CanChangeMetaData: boolean;
1122 begin
1123 Result := false;
1124 end;
1125
1126 function TSQLDataItem.GetSQLTypeName: AnsiString;
1127 begin
1128 Result := GetSQLTypeName(GetSQLType);
1129 end;
1130
1131 class function TSQLDataItem.GetSQLTypeName(SQLType: cardinal): AnsiString;
1132 begin
1133 Result := 'Unknown';
1134 case SQLType of
1135 SQL_VARYING: Result := 'SQL_VARYING';
1136 SQL_TEXT: Result := 'SQL_TEXT';
1137 SQL_DOUBLE: Result := 'SQL_DOUBLE';
1138 SQL_FLOAT: Result := 'SQL_FLOAT';
1139 SQL_LONG: Result := 'SQL_LONG';
1140 SQL_SHORT: Result := 'SQL_SHORT';
1141 SQL_TIMESTAMP: Result := 'SQL_TIMESTAMP';
1142 SQL_TIMESTAMP_TZ: Result := 'SQL_TIMESTAMP_TZ';
1143 SQL_TIMESTAMP_TZ_EX: Result := 'SQL_TIMESTAMP_TZ_EX';
1144 SQL_BLOB: Result := 'SQL_BLOB';
1145 SQL_D_FLOAT: Result := 'SQL_D_FLOAT';
1146 SQL_ARRAY: Result := 'SQL_ARRAY';
1147 SQL_QUAD: Result := 'SQL_QUAD';
1148 SQL_TYPE_TIME: Result := 'SQL_TYPE_TIME';
1149 SQL_TYPE_DATE: Result := 'SQL_TYPE_DATE';
1150 SQL_INT64: Result := 'SQL_INT64';
1151 SQL_TIME_TZ: Result := 'SQL_TIME_TZ';
1152 SQL_TIME_TZ_EX: Result := 'SQL_TIME_TZ_EX';
1153 SQL_DEC_FIXED: Result := 'SQL_DEC_FIXED';
1154 SQL_DEC16: Result := 'SQL_DEC16';
1155 SQL_DEC34: Result := 'SQL_DEC34';
1156 SQL_INT128: Result := 'SQL_INT128';
1157 SQL_NULL: Result := 'SQL_NULL';
1158 SQL_BOOLEAN: Result := 'SQL_BOOLEAN';
1159 end;
1160 end;
1161
1162 function TSQLDataItem.GetStrDataLength: short;
1163 begin
1164 with FFirebirdClientAPI do
1165 if SQLType = SQL_VARYING then
1166 Result := DecodeInteger(SQLData, 2)
1167 else
1168 Result := DataLength;
1169 end;
1170
1171 function TSQLDataItem.GetAsBoolean: boolean;
1172 begin
1173 CheckActive;
1174 result := false;
1175 if not IsNull then
1176 begin
1177 if SQLType = SQL_BOOLEAN then
1178 result := PByte(SQLData)^ = ISC_TRUE
1179 else
1180 IBError(ibxeInvalidDataConversion, [nil]);
1181 end
1182 end;
1183
1184 function TSQLDataItem.GetAsCurrency: Currency;
1185 begin
1186 CheckActive;
1187 result := 0;
1188 if GetSQLDialect < 3 then
1189 result := GetAsDouble
1190 else begin
1191 if not IsNull then
1192 case SQLType of
1193 SQL_TEXT, SQL_VARYING: begin
1194 try
1195 result := StrtoCurr(AsString);
1196 except
1197 on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
1198 end;
1199 end;
1200 SQL_SHORT:
1201 result := NumericFromRawValues(Int64(PShort(SQLData)^),
1202 Scale).getAsCurrency;
1203 SQL_LONG:
1204 result := NumericFromRawValues(Int64(PLong(SQLData)^),
1205 Scale).getAsCurrency;
1206 SQL_INT64:
1207 result := NumericFromRawValues(PInt64(SQLData)^,
1208 Scale).getAsCurrency;
1209 SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1210 result := Round(AsDouble);
1211
1212 SQL_DEC_FIXED,
1213 SQL_DEC16,
1214 SQL_DEC34,
1215 SQL_INT128:
1216 if not BCDToCurr(GetAsBCD,Result) then
1217 IBError(ibxeInvalidDataConversion, [nil]);
1218
1219 else
1220 IBError(ibxeInvalidDataConversion, [nil]);
1221 end;
1222 end;
1223 end;
1224
1225 function TSQLDataItem.GetAsInt64: Int64;
1226 begin
1227 CheckActive;
1228 result := 0;
1229 if not IsNull then
1230 case SQLType of
1231 SQL_TEXT, SQL_VARYING: begin
1232 try
1233 result := StrToInt64(AsString);
1234 except
1235 on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
1236 end;
1237 end;
1238 SQL_SHORT:
1239 result := NumericFromRawValues(Int64(PShort(SQLData)^),
1240 Scale).getAsInt64;
1241 SQL_LONG:
1242 result := NumericFromRawValues(Int64(PLong(SQLData)^),
1243 Scale).getAsInt64;
1244 SQL_INT64:
1245 result := NumericFromRawValues(PInt64(SQLData)^,
1246 Scale).getAsInt64;
1247 SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1248 result := Round(AsDouble);
1249 else
1250 IBError(ibxeInvalidDataConversion, [nil]);
1251 end;
1252 end;
1253
1254 function TSQLDataItem.GetAsDateTime: TDateTime;
1255 var aTimezone: AnsiString;
1256 aTimeZoneID: TFBTimeZoneID;
1257 dstOffset: smallint;
1258 begin
1259 InternalGetAsDateTime(Result,dstOffset,aTimeZone,aTimeZoneID);
1260 end;
1261
1262 procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime;
1263 var dstOffset: smallint; var aTimezone: AnsiString);
1264 var aTimeZoneID: TFBTimeZoneID;
1265 begin
1266 InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1267 end;
1268
1269 procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
1270 var aTimezoneID: TFBTimeZoneID);
1271 var aTimezone: AnsiString;
1272 begin
1273 InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1274 end;
1275
1276 procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1277 var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1278 var aTimeZone: AnsiString;
1279 begin
1280 CheckActive;
1281 aTime := 0;
1282 dstOffset := 0;
1283 if not IsNull then
1284 with FFirebirdClientAPI do
1285 case SQLType of
1286 SQL_TIME_TZ:
1287 begin
1288 GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1289 aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1290 end;
1291 SQL_TIME_TZ_EX:
1292 begin
1293 GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1294 aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1295 end;
1296 else
1297 IBError(ibxeInvalidDataConversion, [nil]);
1298 end;
1299 end;
1300
1301 procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1302 var aTimezone: AnsiString; OnDate: TDateTime);
1303 begin
1304 CheckActive;
1305 aTime := 0;
1306 dstOffset := 0;
1307 if not IsNull then
1308 with FFirebirdClientAPI do
1309 case SQLType of
1310 SQL_TIME_TZ:
1311 GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1312 SQL_TIME_TZ_EX:
1313 GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1314 else
1315 IBError(ibxeInvalidDataConversion, [nil]);
1316 end;
1317 end;
1318
1319 procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1320 var aTimezoneID: TFBTimeZoneID);
1321 begin
1322 GetAsTime(aTime,dstOffset,aTimeZoneID,GetTimeZoneServices.GetTimeTZDate);
1323 end;
1324
1325 procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1326 var aTimezone: AnsiString);
1327 begin
1328 GetAsTime(aTime,dstOffset,aTimeZone,GetTimeZoneServices.GetTimeTZDate);
1329 end;
1330
1331 function TSQLDataItem.GetAsUTCDateTime: TDateTime;
1332 var aTimezone: AnsiString;
1333 begin
1334 CheckActive;
1335 result := 0;
1336 aTimezone := '';
1337 if not IsNull then
1338 with FFirebirdClientAPI do
1339 case SQLType of
1340 SQL_TEXT, SQL_VARYING:
1341 begin
1342 if not ParseDateTimeTZString(AsString,Result,aTimeZone) then
1343 IBError(ibxeInvalidDataConversion, [nil]);
1344 Result := GetTimeZoneServices.LocalTimeToGMT(Result,aTimeZone);
1345 end;
1346 SQL_TYPE_DATE:
1347 result := SQLDecodeDate(SQLData);
1348 SQL_TYPE_TIME,
1349 SQL_TIME_TZ,
1350 SQL_TIME_TZ_EX:
1351 result := SQLDecodeTime(SQLData);
1352 SQL_TIMESTAMP,
1353 SQL_TIMESTAMP_TZ,
1354 SQL_TIMESTAMP_TZ_EX:
1355 result := SQLDecodeDateTime(SQLData);
1356 else
1357 IBError(ibxeInvalidDataConversion, [nil]);
1358 end;
1359 end;
1360
1361 function TSQLDataItem.GetAsDouble: Double;
1362 begin
1363 CheckActive;
1364 result := 0;
1365 if not IsNull then begin
1366 case SQLType of
1367 SQL_TEXT, SQL_VARYING: begin
1368 try
1369 result := StrToFloat(AsString);
1370 except
1371 on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
1372 end;
1373 end;
1374 SQL_SHORT:
1375 result := NumericFromRawValues(Int64(PShort(SQLData)^),
1376 Scale).getAsDouble;
1377 SQL_LONG:
1378 result := NumericFromRawValues(Int64(PLong(SQLData)^),
1379 Scale).getAsDouble;
1380 SQL_INT64:
1381 result := NumericFromRawValues(PInt64(SQLData)^, Scale).getAsDouble;
1382 SQL_FLOAT:
1383 result := PFloat(SQLData)^;
1384 SQL_DOUBLE, SQL_D_FLOAT:
1385 result := PDouble(SQLData)^;
1386 SQL_DEC_FIXED,
1387 SQL_DEC16,
1388 SQL_DEC34,
1389 SQL_INT128:
1390 Result := BCDToDouble(GetAsBCD);
1391 else
1392 IBError(ibxeInvalidDataConversion, [nil]);
1393 end;
1394 if Scale <> 0 then
1395 result :=
1396 StrToFloat(FloatToStrF(result, fffixed, 15,
1397 Abs(Scale) ));
1398 end;
1399 end;
1400
1401 function TSQLDataItem.GetAsFloat: Float;
1402 begin
1403 CheckActive;
1404 result := 0;
1405 try
1406 result := AsDouble;
1407 except
1408 on E: EOverflow do
1409 IBError(ibxeInvalidDataConversion, [nil]);
1410 end;
1411 end;
1412
1413 function TSQLDataItem.GetAsLong: Long;
1414 begin
1415 CheckActive;
1416 result := 0;
1417 if not IsNull then
1418 case SQLType of
1419 SQL_TEXT, SQL_VARYING: begin
1420 try
1421 result := StrToInt(AsString);
1422 except
1423 on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
1424 end;
1425 end;
1426 SQL_SHORT:
1427 result := NumericFromRawValues(Int64(PShort(SQLData)^),
1428 Scale).getAsInteger;
1429 SQL_LONG:
1430 result := NumericFromRawValues(Int64(PLong(SQLData)^),
1431 Scale).getAsInteger;
1432 SQL_INT64:
1433 result := NumericFromRawValues(PInt64(SQLData)^, Scale).getAsInteger;
1434
1435 SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1436 result := Round(AsDouble);
1437 SQL_DEC_FIXED,
1438 SQL_DEC16,
1439 SQL_DEC34,
1440 SQL_INT128:
1441 Result := BCDToInteger(GetAsBCD);
1442 else
1443 IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1444 end;
1445 end;
1446
1447 function TSQLDataItem.GetAsPointer: Pointer;
1448 begin
1449 CheckActive;
1450 if not IsNull then
1451 result := SQLData
1452 else
1453 result := nil;
1454 end;
1455
1456 function TSQLDataItem.GetAsQuad: TISC_QUAD;
1457 begin
1458 CheckActive;
1459 result.gds_quad_high := 0;
1460 result.gds_quad_low := 0;
1461 if not IsNull then
1462 case SQLType of
1463 SQL_BLOB, SQL_ARRAY, SQL_QUAD:
1464 result := PISC_QUAD(SQLData)^;
1465 else
1466 IBError(ibxeInvalidDataConversion, [nil]);
1467 end;
1468 end;
1469
1470 function TSQLDataItem.GetAsShort: short;
1471 begin
1472 CheckActive;
1473 result := 0;
1474 try
1475 result := AsLong;
1476 except
1477 on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
1478 end;
1479 end;
1480
1481 {Copied from LazUTF8}
1482
1483 function UTF8CodepointSizeFull(p: PAnsiChar): integer;
1484 const TopBitSetMask = $80; {%10000000}
1485 Top2BitsSetMask = $C0; {%11000000}
1486 Top3BitsSetMask = $E0; {%11100000}
1487 Top4BitsSetMask = $F0; {%11110000}
1488 Top5BitsSetMask = $F8; {%11111000}
1489 begin
1490 case p^ of
1491 #0..#191: // %11000000
1492 // regular single byte character (#0 is a character, this is Pascal ;)
1493 Result:=1;
1494 #192..#223: // p^ and %11100000 = %11000000
1495 begin
1496 // could be 2 byte character
1497 if (ord(p[1]) and Top2BitsSetMask) = TopBitSetMask then
1498 Result:=2
1499 else
1500 Result:=1;
1501 end;
1502 #224..#239: // p^ and %11110000 = %11100000
1503 begin
1504 // could be 3 byte character
1505 if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1506 and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask) then
1507 Result:=3
1508 else
1509 Result:=1;
1510 end;
1511 #240..#247: // p^ and %11111000 = %11110000
1512 begin
1513 // could be 4 byte character
1514 if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1515 and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask)
1516 and ((ord(p[3]) and Top2BitsSetMask) = TopBitSetMask) then
1517 Result:=4
1518 else
1519 Result:=1;
1520 end;
1521 else
1522 Result:=1;
1523 end;
1524 end;
1525
1526 {Returns the byte length of a UTF8 string with a fixed charwidth}
1527
1528 function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1529 var i: integer;
1530 cplen: integer;
1531 begin
1532 Result := 0;
1533 for i := 1 to FieldWidth do
1534 begin
1535 cplen := UTF8CodepointSizeFull(p);
1536 Inc(p,cplen);
1537 Inc(Result,cplen);
1538 if Result >= MaxDataLength then
1539 begin
1540 Result := MaxDataLength;
1541 Exit;
1542 end;
1543 end;
1544 end;
1545
1546 function TSQLDataItem.GetAsString: AnsiString;
1547 var
1548 sz: PByte;
1549 str_len: Integer;
1550 rs: RawByteString;
1551 aTimeZone: AnsiString;
1552 aDateTime: TDateTime;
1553 dstOffset: smallint;
1554 begin
1555 CheckActive;
1556 result := '';
1557 { Check null, if so return a default string }
1558 if not IsNull then
1559 with FFirebirdClientAPI do
1560 case SQLType of
1561 SQL_BOOLEAN:
1562 if AsBoolean then
1563 Result := sTrue
1564 else
1565 Result := SFalse;
1566
1567 SQL_TEXT, SQL_VARYING:
1568 begin
1569 sz := SQLData;
1570 if (SQLType = SQL_TEXT) then
1571 begin
1572 if GetCodePage = cp_utf8 then
1573 str_len := GetStrLen(PAnsiChar(sz),GetSize div GetCharSetWidth,DataLength)
1574 else
1575 str_len := DataLength
1576 end
1577 else begin
1578 str_len := DecodeInteger(sz, 2);
1579 Inc(sz, 2);
1580 end;
1581 SetString(rs, PAnsiChar(sz), str_len);
1582 SetCodePage(rs,GetCodePage,false);
1583 Result := rs;
1584 end;
1585
1586 SQL_TYPE_DATE:
1587 Result := DateToStr(GetAsDateTime);
1588 SQL_TIMESTAMP:
1589 Result := FBFormatDateTime(GetTimestampFormatStr,GetAsDateTime);
1590 SQL_TYPE_TIME:
1591 Result := FBFormatDateTime(GetTimeFormatStr,GetAsDateTime);
1592 SQL_TIMESTAMP_TZ,
1593 SQL_TIMESTAMP_TZ_EX:
1594 with GetAttachment.GetTimeZoneServices do
1595 begin
1596 if GetTZTextOption = tzGMT then
1597 Result := FBFormatDateTime(GetTimestampFormatStr,GetAsUTCDateTime)
1598 else
1599 begin
1600 GetAsDateTime(aDateTime,dstOffset,aTimeZone);
1601 if GetTZTextOption = tzOffset then
1602 Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1603 else
1604 Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + aTimeZone;
1605 end;
1606 end;
1607 SQL_TIME_TZ,
1608 SQL_TIME_TZ_EX:
1609 with GetAttachment.GetTimeZoneServices do
1610 begin
1611 if GetTZTextOption = tzGMT then
1612 Result := FBFormatDateTime(GetTimeFormatStr,GetAsUTCDateTime)
1613 else
1614 begin
1615 GetAsTime(aDateTime,dstOffset,aTimeZone,GetTimeTZDate);
1616 if GetTZTextOption = tzOffset then
1617 Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1618 else
1619 Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + aTimeZone;
1620 end;
1621 end;
1622
1623 SQL_SHORT, SQL_LONG:
1624 if Scale = 0 then
1625 result := IntToStr(AsLong)
1626 else if Scale >= (-4) then
1627 result := CurrToStr(AsCurrency)
1628 else
1629 result := FloatToStr(AsDouble);
1630 SQL_INT64:
1631 if Scale = 0 then
1632 result := IntToStr(AsInt64)
1633 else if Scale >= (-4) then
1634 result := CurrToStr(AsCurrency)
1635 else
1636 result := FloatToStr(AsDouble);
1637 SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1638 result := FloatToStr(AsDouble);
1639
1640 SQL_DEC16,
1641 SQL_DEC34:
1642 result := BCDToStr(GetAsBCD);
1643
1644 SQL_DEC_FIXED,
1645 SQL_INT128:
1646 result := Int128ToStr(SQLData,scale);
1647
1648 else
1649 IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1650 end;
1651 end;
1652
1653 function TSQLDataItem.GetAsNumeric: IFBNumeric;
1654 var aValue: Int64;
1655 begin
1656 case SQLType of
1657 SQL_TEXT, SQL_VARYING:
1658 Result := StrToNumeric(GetAsString);
1659
1660 SQL_SHORT:
1661 Result := NumericFromRawValues(PShort(SQLData)^, Scale);
1662
1663 SQL_LONG:
1664 Result := NumericFromRawValues(PLong(SQLData)^, Scale);
1665
1666 SQL_INT64:
1667 Result := NumericFromRawValues(PInt64(SQLData)^, Scale);
1668
1669 SQL_DEC16,
1670 SQL_DEC34,
1671 SQL_DEC_FIXED,
1672 SQL_INT128:
1673 Result := BCDToNumeric(GetAsBCD);
1674
1675 else
1676 IBError(ibxeInvalidDataConversion, [nil]);
1677 end;
1678 end;
1679
1680 function TSQLDataItem.GetIsNull: Boolean;
1681 begin
1682 CheckActive;
1683 Result := false;
1684 end;
1685
1686 function TSQLDataItem.GetIsNullable: boolean;
1687 begin
1688 CheckActive;
1689 Result := false;
1690 end;
1691
1692 function TSQLDataItem.GetAsVariant: Variant;
1693 var ts: TDateTime;
1694 dstOffset: smallint;
1695 timezone: AnsiString;
1696 begin
1697 CheckActive;
1698 if IsNull then
1699 result := NULL
1700 { Check null, if so return a default string }
1701 else case SQLType of
1702 SQL_ARRAY:
1703 result := '(Array)'; {do not localize}
1704 SQL_BLOB,
1705 SQL_TEXT, SQL_VARYING:
1706 result := AsString;
1707 SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
1708 result := AsDateTime;
1709 SQL_TIMESTAMP_TZ,
1710 SQL_TIME_TZ,
1711 SQL_TIMESTAMP_TZ_EX,
1712 SQL_TIME_TZ_EX:
1713 begin
1714 GetAsDateTime(ts,dstOffset,timezone);
1715 result := VarArrayOf([ts,dstOffset,timezone]);
1716 end;
1717 SQL_SHORT, SQL_LONG:
1718 if Scale = 0 then
1719 result := AsLong
1720 else if Scale >= (-4) then
1721 result := AsCurrency
1722 else
1723 result := AsDouble;
1724 SQL_INT64:
1725 if Scale = 0 then
1726 result := AsInt64
1727 else if Scale >= (-4) then
1728 result := AsCurrency
1729 else
1730 result := AsDouble;
1731 SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1732 result := AsDouble;
1733 SQL_BOOLEAN:
1734 result := AsBoolean;
1735 SQL_DEC_FIXED,
1736 SQL_DEC16,
1737 SQL_DEC34,
1738 SQL_INT128:
1739 result := VarFmtBCDCreate(GetAsBcd);
1740 else
1741 IBError(ibxeInvalidDataConversion, [nil]);
1742 end;
1743 end;
1744
1745 function TSQLDataItem.GetModified: boolean;
1746 begin
1747 Result := false;
1748 end;
1749
1750 function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
1751 ): integer;
1752 begin
1753 case DateTimeFormat of
1754 dfTimestamp:
1755 Result := Length(GetTimestampFormatStr);
1756 dfDateTime:
1757 Result := Length(GetDateFormatStr(true));
1758 dfTime:
1759 Result := Length(GetTimeFormatStr);
1760 dfTimestampTZ:
1761 Result := Length(GetTimestampFormatStr) + 6; {assume time offset format}
1762 dfTimeTZ:
1763 Result := Length(GetTimeFormatStr)+ 6;
1764 else
1765 Result := 0;
1766 end;end;
1767
1768 function TSQLDataItem.GetAsBCD: tBCD;
1769
1770 begin
1771 CheckActive;
1772 if IsNull then
1773 with Result do
1774 begin
1775 FillChar(Result,sizeof(Result),0);
1776 Precision := 1;
1777 exit;
1778 end;
1779
1780 case SQLType of
1781 SQL_DEC16,
1782 SQL_DEC34:
1783 with FFirebirdClientAPI do
1784 Result := SQLDecFloatDecode(SQLType, SQLData);
1785
1786 SQL_DEC_FIXED,
1787 SQL_INT128:
1788 with FFirebirdClientAPI do
1789 Result := StrToBCD(Int128ToStr(SQLData,scale));
1790 else
1791 if not CurrToBCD(GetAsCurrency,Result) then
1792 IBError(ibxeBadBCDConversion,[]);
1793 end;
1794 end;
1795
1796
1797 procedure TSQLDataItem.SetIsNull(Value: Boolean);
1798 begin
1799 //ignore unless overridden
1800 end;
1801
1802 procedure TSQLDataItem.SetIsNullable(Value: Boolean);
1803 begin
1804 //ignore unless overridden
1805 end;
1806
1807 procedure TSQLDataItem.SetName(aValue: AnsiString);
1808 begin
1809 //ignore unless overridden
1810 end;
1811
1812 procedure TSQLDataItem.SetAsCurrency(Value: Currency);
1813 begin
1814 CheckActive;
1815 if GetSQLDialect < 3 then
1816 AsDouble := Value
1817 else
1818 if not CanChangeMetaData and ((SQLType <> SQL_INT64) or (Scale <> -4)) then
1819 SetAsNumeric(CurrToNumeric(Value))
1820 else
1821 begin
1822 Changing;
1823 if IsNullable then
1824 IsNull := False;
1825 SQLType := SQL_INT64;
1826 Scale := -4;
1827 DataLength := SizeOf(Int64);
1828 PCurrency(SQLData)^ := Value;
1829 Changed;
1830 end;
1831 end;
1832
1833 procedure TSQLDataItem.SetAsInt64(Value: Int64);
1834 begin
1835 CheckActive;
1836 if not CanChangeMetaData and ((SQLType <> SQL_INT64) or (Scale <> 0)) then
1837 SetAsNumeric(IntToNumeric(Value))
1838 else
1839 begin
1840 Changing;
1841 if IsNullable then
1842 IsNull := False;
1843
1844 SQLType := SQL_INT64;
1845 Scale := 0;
1846 DataLength := SizeOf(Int64);
1847 PInt64(SQLData)^ := Value;
1848 Changed;
1849 end;
1850 end;
1851
1852 procedure TSQLDataItem.SetAsDate(Value: TDateTime);
1853 begin
1854 CheckActive;
1855 if GetSQLDialect < 3 then
1856 begin
1857 AsDateTime := Value;
1858 exit;
1859 end;
1860
1861 Changing;
1862 if IsNullable then
1863 IsNull := False;
1864
1865 SQLType := SQL_TYPE_DATE;
1866 DataLength := SizeOf(ISC_DATE);
1867 with FFirebirdClientAPI do
1868 SQLEncodeDate(Value,SQLData);
1869 Changed;
1870 end;
1871
1872 procedure TSQLDataItem.SetAsTime(Value: TDateTime);
1873 begin
1874 CheckActive;
1875 if GetSQLDialect < 3 then
1876 begin
1877 AsDateTime := Value;
1878 exit;
1879 end;
1880
1881 Changing;
1882 if IsNullable then
1883 IsNull := False;
1884
1885 SQLType := SQL_TYPE_TIME;
1886 DataLength := SizeOf(ISC_TIME);
1887 with FFirebirdClientAPI do
1888 SQLEncodeTime(Value,SQLData);
1889 Changed;
1890 end;
1891
1892 procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
1893 begin
1894 CheckActive;
1895 CheckTZSupport;
1896 if GetSQLDialect < 3 then
1897 begin
1898 AsDateTime := aValue;
1899 exit;
1900 end;
1901
1902 Changing;
1903 if IsNullable then
1904 IsNull := False;
1905
1906 SQLType := SQL_TIME_TZ;
1907 DataLength := SizeOf(ISC_TIME_TZ);
1908 GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZoneID,OnDate,SQLData);
1909 Changed;
1910 end;
1911
1912 procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
1913 begin
1914 CheckActive;
1915 CheckTZSupport;
1916 if GetSQLDialect < 3 then
1917 begin
1918 AsDateTime := aValue;
1919 exit;
1920 end;
1921
1922 Changing;
1923 if IsNullable then
1924 IsNull := False;
1925
1926 SQLType := SQL_TIME_TZ;
1927 DataLength := SizeOf(ISC_TIME_TZ);
1928 GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZone,OnDate,SQLData);
1929 Changed;
1930 end;
1931
1932 procedure TSQLDataItem.SetAsDateTime(Value: TDateTime);
1933 begin
1934 CheckActive;
1935 if IsNullable then
1936 IsNull := False;
1937
1938 Changing;
1939 SQLType := SQL_TIMESTAMP;
1940 DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1941 with FFirebirdClientAPI do
1942 SQLEncodeDateTime(Value,SQLData);
1943 Changed;
1944 end;
1945
1946 procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime;
1947 aTimeZoneID: TFBTimeZoneID);
1948 begin
1949 CheckActive;
1950 CheckTZSupport;
1951 if IsNullable then
1952 IsNull := False;
1953
1954 Changing;
1955 SQLType := SQL_TIMESTAMP_TZ;
1956 DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1957 GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZoneID,SQLData);
1958 Changed;
1959 end;
1960
1961 procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString
1962 );
1963 begin
1964 CheckActive;
1965 CheckTZSupport;
1966 if IsNullable then
1967 IsNull := False;
1968
1969 Changing;
1970 SQLType := SQL_TIMESTAMP_TZ;
1971 DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1972 GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZone,SQLData);
1973 Changed;
1974 end;
1975
1976 procedure TSQLDataItem.SetAsUTCDateTime(aUTCTime: TDateTime);
1977 begin
1978 SetAsDateTime(aUTCTime,TimeZoneID_GMT);
1979 end;
1980
1981 procedure TSQLDataItem.SetAsDouble(Value: Double);
1982 begin
1983 CheckActive;
1984 if not CanChangeMetaData and (SQLType <> SQL_DOUBLE) then
1985 SetAsNumeric(DoubleToNumeric(Value))
1986 else
1987 begin
1988 if IsNullable then
1989 IsNull := False;
1990
1991 Changing;
1992 SQLType := SQL_DOUBLE;
1993 DataLength := SizeOf(Double);
1994 Scale := 0;
1995 PDouble(SQLData)^ := Value;
1996 Changed;
1997 end;
1998 end;
1999
2000 procedure TSQLDataItem.SetAsFloat(Value: Float);
2001 begin
2002 CheckActive;
2003 if not CanChangeMetaData and (SQLType <> SQL_FLOAT) then
2004 SetAsNumeric(DoubleToNumeric(Value))
2005 else
2006 begin
2007 if IsNullable then
2008 IsNull := False;
2009
2010 Changing;
2011 SQLType := SQL_FLOAT;
2012 DataLength := SizeOf(Float);
2013 Scale := 0;
2014 PSingle(SQLData)^ := Value;
2015 Changed;
2016 end;
2017 end;
2018
2019 procedure TSQLDataItem.SetAsLong(Value: Long);
2020 begin
2021 CheckActive;
2022 if not CanChangeMetaData and ((SQLType <> SQL_LONG) or (Scale <> 0)) then
2023 SetAsNumeric(IntToNumeric(Value))
2024 else
2025 begin
2026 if IsNullable then
2027 IsNull := False;
2028
2029 Changing;
2030 SQLType := SQL_LONG;
2031 DataLength := SizeOf(Long);
2032 Scale := 0;
2033 PLong(SQLData)^ := Value;
2034 Changed;
2035 end;
2036 end;
2037
2038 procedure TSQLDataItem.SetAsPointer(Value: Pointer);
2039 begin
2040 CheckActive;
2041 Changing;
2042 if IsNullable and (Value = nil) then
2043 IsNull := True
2044 else
2045 begin
2046 IsNull := False;
2047 SQLType := SQL_TEXT;
2048 Move(Value^, SQLData^, DataLength);
2049 end;
2050 Changed;
2051 end;
2052
2053 procedure TSQLDataItem.SetAsQuad(Value: TISC_QUAD);
2054 begin
2055 CheckActive;
2056 Changing;
2057 if IsNullable then
2058 IsNull := False;
2059 if (SQLType <> SQL_BLOB) and
2060 (SQLType <> SQL_ARRAY) then
2061 IBError(ibxeInvalidDataConversion, [nil]);
2062 DataLength := SizeOf(TISC_QUAD);
2063 PISC_QUAD(SQLData)^ := Value;
2064 Changed;
2065 end;
2066
2067 procedure TSQLDataItem.SetAsShort(Value: short);
2068 begin
2069 CheckActive;
2070 if not CanChangeMetaData and ((SQLType <> SQL_SHORT) or (Scale <> 0)) then
2071 SetAsNumeric(IntToNumeric(Value))
2072 else
2073 begin
2074 Changing;
2075 if IsNullable then
2076 IsNull := False;
2077
2078 SQLType := SQL_SHORT;
2079 DataLength := SizeOf(Short);
2080 Scale := 0;
2081 PShort(SQLData)^ := Value;
2082 Changed;
2083 end;
2084 end;
2085
2086 procedure TSQLDataItem.SetAsString(Value: AnsiString);
2087 begin
2088 InternalSetAsString(Value);
2089 end;
2090
2091 procedure TSQLDataItem.SetAsVariant(Value: Variant);
2092 begin
2093 CheckActive;
2094 if VarIsNull(Value) then
2095 IsNull := True
2096 else
2097 if VarIsArray(Value) then {must be datetime plus timezone}
2098 SetAsDateTime(Value[0],AnsiString(Value[1]))
2099 else case VarType(Value) of
2100 varEmpty, varNull:
2101 IsNull := True;
2102 varSmallint, varInteger, varByte, varLongWord,
2103 varWord, varShortInt, varInt64:
2104 SetAsNumeric(IntToNumeric(Int64(Value)));
2105 varSingle, varDouble:
2106 AsDouble := Value;
2107 varCurrency:
2108 SetAsNumeric(CurrToNumeric(Currency(Value)));
2109 varBoolean:
2110 AsBoolean := Value;
2111 varDate:
2112 AsDateTime := Value;
2113 varOleStr, varString:
2114 AsString := Value;
2115 varArray:
2116 IBError(ibxeNotSupported, [nil]);
2117 varByRef, varDispatch, varError, varUnknown, varVariant:
2118 IBError(ibxeNotPermitted, [nil]);
2119 else
2120 if VarIsFmtBCD(Value) then
2121 SetAsBCD(VarToBCD(Value))
2122 else
2123 IBError(ibxeNotSupported, [nil]);
2124 end;
2125 end;
2126
2127 procedure TSQLDataItem.SetAsNumeric(Value: IFBNumeric);
2128 begin
2129 CheckActive;
2130 Changing;
2131 if IsNullable then
2132 IsNull := False;
2133
2134 if CanChangeMetadata then
2135 begin
2136 {Restore original values}
2137 SQLType := getColMetadata.GetSQLType;
2138 Scale := getColMetadata.getScale;
2139 SetDataLength(getColMetadata.GetSize);
2140 end;
2141
2142 with FFirebirdClientAPI do
2143 case GetSQLType of
2144 SQL_LONG:
2145 PLong(SQLData)^ := SafeInteger(Value.AdjustScaleTo(Scale).getRawValue);
2146 SQL_SHORT:
2147 PShort(SQLData)^ := SafeSmallInt(Value.AdjustScaleTo(Scale).getRawValue);
2148 SQL_INT64:
2149 PInt64(SQLData)^ := Value.AdjustScaleTo(Scale).getRawValue;
2150 SQL_TEXT, SQL_VARYING:
2151 SetAsString(Value.getAsString);
2152 SQL_D_FLOAT,
2153 SQL_DOUBLE:
2154 PDouble(SQLData)^ := Value.getAsDouble;
2155 SQL_FLOAT:
2156 PSingle(SQLData)^ := Value.getAsDouble;
2157 SQL_DEC_FIXED,
2158 SQL_DEC16,
2159 SQL_DEC34:
2160 SQLDecFloatEncode(Value.getAsBCD,SQLType,SQLData);
2161 SQL_INT128:
2162 StrToInt128(Scale,Value.getAsString,SQLData);
2163 else
2164 IBError(ibxeInvalidDataConversion, [nil]);
2165 end;
2166 Changed;
2167 end;
2168
2169 procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2170 begin
2171 CheckActive;
2172 Changing;
2173 if IsNullable then
2174 IsNull := False;
2175
2176 if not CanChangeMetaData then
2177 begin
2178 SetAsNumeric(BCDToNumeric(aValue));
2179 Exit;
2180 end;
2181
2182 with FFirebirdClientAPI do
2183 if aValue.Precision <= 16 then
2184 begin
2185 if not HasDecFloatSupport then
2186 IBError(ibxeDecFloatNotSupported,[]);
2187
2188 SQLType := SQL_DEC16;
2189 DataLength := 8;
2190 SQLDecFloatEncode(aValue,SQLType,SQLData);
2191 end
2192 else
2193 if aValue.Precision <= 34 then
2194 begin
2195 if not HasDecFloatSupport then
2196 IBError(ibxeDecFloatNotSupported,[]);
2197
2198 SQLType := SQL_DEC34;
2199 DataLength := 16;
2200 SQLDecFloatEncode(aValue,SQLType,SQLData);
2201 end
2202 else
2203 if aValue.Precision <= 38 then
2204 begin
2205 if not HasInt128Support then
2206 IBError(ibxeInt128NotSupported,[]);
2207
2208 SQLType := SQL_INT128;
2209 DataLength := 16;
2210 StrToInt128(scale,BcdToStr(aValue),SQLData);
2211 end
2212 else
2213 IBError(ibxeBCDOverflow,[BCDToStr(aValue)]);
2214
2215 Changed;
2216 end;
2217
2218 procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
2219 begin
2220 CheckActive;
2221 Changing;
2222 if IsNullable then
2223 IsNull := False;
2224
2225 SQLType := SQL_BOOLEAN;
2226 DataLength := 1;
2227 Scale := 0;
2228 if AValue then
2229 PByte(SQLData)^ := ISC_TRUE
2230 else
2231 PByte(SQLData)^ := ISC_FALSE;
2232 Changed;
2233 end;
2234
2235 {TColumnMetaData}
2236
2237 procedure TColumnMetaData.CheckActive;
2238 begin
2239 if not FIBXSQLVAR.Parent.StateChanged(FChangeSeqNo) then Exit;
2240
2241 if FPrepareSeqNo < FIBXSQLVAR.Parent.GetPrepareSeqNo then
2242 IBError(ibxeInterfaceOutofDate,[nil]);
2243
2244 if not FIBXSQLVAR.Parent.CheckStatementStatus(ssPrepared) then
2245 IBError(ibxeStatementNotPrepared, [nil]);
2246 end;
2247
2248 function TColumnMetaData.GetAttachment: IAttachment;
2249 begin
2250 Result := FIBXSQLVAR.GetAttachment;
2251 end;
2252
2253 function TColumnMetaData.SQLData: PByte;
2254 begin
2255 Result := FIBXSQLVAR.SQLData;
2256 end;
2257
2258 function TColumnMetaData.GetDataLength: cardinal;
2259 begin
2260 Result := FIBXSQLVAR.DataLength;
2261 end;
2262
2263 function TColumnMetaData.GetCodePage: TSystemCodePage;
2264 begin
2265 Result := FIBXSQLVAR.GetCodePage;
2266 end;
2267
2268 constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
2269 begin
2270 inherited Create(aIBXSQLVAR.GetAttachment.getFirebirdAPI as TFBClientAPI);
2271 FIBXSQLVAR := aIBXSQLVAR;
2272 FOwner := aOwner;
2273 FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
2274 FIBXSQLVAR.Parent.StateChanged(FChangeSeqNo)
2275 end;
2276
2277 destructor TColumnMetaData.Destroy;
2278 begin
2279 (FOwner as TInterfaceOwner).Remove(self);
2280 inherited Destroy;
2281 end;
2282
2283
2284 function TColumnMetaData.GetSQLDialect: integer;
2285 begin
2286 Result := FIBXSQLVAR.GetAttachment.GetSQLDialect;
2287 end;
2288
2289 function TColumnMetaData.getColMetadata: IParamMetaData;
2290 begin
2291 Result := self;
2292 end;
2293
2294 function TColumnMetaData.GetIndex: integer;
2295 begin
2296 Result := FIBXSQLVAR.Index;
2297 end;
2298
2299 function TColumnMetaData.GetSQLType: cardinal;
2300 begin
2301 CheckActive;
2302 result := FIBXSQLVAR.SQLType;
2303 end;
2304
2305 function TColumnMetaData.getSubtype: integer;
2306 begin
2307 CheckActive;
2308 result := FIBXSQLVAR.SQLSubtype;
2309 end;
2310
2311 function TColumnMetaData.getRelationName: AnsiString;
2312 begin
2313 CheckActive;
2314 result := FIBXSQLVAR.RelationName;
2315 end;
2316
2317 function TColumnMetaData.getOwnerName: AnsiString;
2318 begin
2319 CheckActive;
2320 result := FIBXSQLVAR.OwnerName;
2321 end;
2322
2323 function TColumnMetaData.getSQLName: AnsiString;
2324 begin
2325 CheckActive;
2326 result := FIBXSQLVAR.FieldName;
2327 end;
2328
2329 function TColumnMetaData.getAliasName: AnsiString;
2330 begin
2331 CheckActive;
2332 result := FIBXSQLVAR.AliasName;
2333 end;
2334
2335 function TColumnMetaData.GetName: AnsiString;
2336 begin
2337 CheckActive;
2338 Result := FIBXSQLVAR. Name;
2339 end;
2340
2341 function TColumnMetaData.GetScale: integer;
2342 begin
2343 CheckActive;
2344 result := FIBXSQLVAR.Scale;
2345 end;
2346
2347 function TColumnMetaData.getCharSetID: cardinal;
2348 begin
2349 CheckActive;
2350 Result := FIBXSQLVAR.CharSetID;
2351 end;
2352
2353 function TColumnMetaData.GetIsNullable: boolean;
2354 begin
2355 CheckActive;
2356 result := FIBXSQLVAR.IsNullable;
2357 end;
2358
2359 function TColumnMetaData.GetSize: cardinal;
2360 begin
2361 CheckActive;
2362 result := FIBXSQLVAR.GetSize;
2363 end;
2364
2365 function TColumnMetaData.GetCharSetWidth: integer;
2366 begin
2367 CheckActive;
2368 result := FIBXSQLVAR.GetCharSetWidth;
2369 end;
2370
2371 function TColumnMetaData.GetArrayMetaData: IArrayMetaData;
2372 begin
2373 CheckActive;
2374 result := FIBXSQLVAR.GetArrayMetaData;
2375 end;
2376
2377 function TColumnMetaData.GetBlobMetaData: IBlobMetaData;
2378 begin
2379 CheckActive;
2380 result := FIBXSQLVAR.GetBlobMetaData;
2381 end;
2382
2383 function TColumnMetaData.GetStatement: IStatement;
2384 begin
2385 Result := FIBXSQLVAR.GetStatement;
2386 end;
2387
2388 function TColumnMetaData.GetTransaction: ITransaction;
2389 begin
2390 Result := FIBXSQLVAR.GetTransaction;
2391 end;
2392
2393 { TIBSQLData }
2394
2395 procedure TIBSQLData.CheckActive;
2396 begin
2397 if not FIBXSQLVAR.Parent.StateChanged(FChangeSeqNo) then Exit;
2398
2399 inherited CheckActive;
2400
2401 if not FIBXSQLVAR.Parent.CheckStatementStatus(ssCursorOpen) and
2402 not FIBXSQLVAR.Parent.CheckStatementStatus(ssExecuteResults) then
2403 IBError(ibxeSQLClosed, [nil]);
2404
2405 if FIBXSQLVAR.Parent.CheckStatementStatus(ssEOF) then
2406 IBError(ibxeEOF,[nil]);
2407
2408 if FIBXSQLVAR.Parent.CheckStatementStatus(ssBOF) then
2409 IBError(ibxeBOF,[nil]);
2410 end;
2411
2412 function TIBSQLData.GetIsNull: Boolean;
2413 begin
2414 CheckActive;
2415 result := FIBXSQLVAR.IsNull;
2416 end;
2417
2418 function TIBSQLData.GetAsArray: IArray;
2419 begin
2420 CheckActive;
2421 result := FIBXSQLVAR.GetAsArray;
2422 end;
2423
2424 function TIBSQLData.GetAsBlob: IBlob;
2425 begin
2426 CheckActive;
2427 result := FIBXSQLVAR.GetAsBlob(AsQuad,nil);
2428 end;
2429
2430 function TIBSQLData.GetAsBlob(BPB: IBPB): IBlob;
2431 begin
2432 CheckActive;
2433 result := FIBXSQLVAR.GetAsBlob(AsQuad,BPB);
2434 end;
2435
2436 function TIBSQLData.GetAsString: AnsiString;
2437 begin
2438 CheckActive;
2439 Result := '';
2440 { Check null, if so return a default string }
2441 if not IsNull then
2442 case SQLType of
2443 SQL_ARRAY:
2444 result := SArray;
2445 SQL_BLOB:
2446 Result := FIBXSQLVAR.GetAsBlob(AsQuad,nil).GetAsString;
2447 else
2448 Result := inherited GetAsString;
2449 end;
2450 end;
2451
2452 { TSQLParam }
2453
2454 procedure TSQLParam.InternalSetAsString(Value: AnsiString);
2455
2456 procedure DoSetString;
2457 begin
2458 Changing;
2459 FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
2460 Changed;
2461 end;
2462
2463 var b: IBlob;
2464 dt: TDateTime;
2465 timezone: AnsiString;
2466 Int64Value: Int64;
2467 BCDValue: TBCD;
2468 aScale: integer;
2469 begin
2470 CheckActive;
2471 if IsNullable then
2472 IsNull := False;
2473 with FFirebirdClientAPI do
2474 case SQLTYPE of
2475 SQL_BOOLEAN:
2476 if AnsiCompareText(Value,STrue) = 0 then
2477 AsBoolean := true
2478 else
2479 if AnsiCompareText(Value,SFalse) = 0 then
2480 AsBoolean := false
2481 else
2482 IBError(ibxeInvalidDataConversion,[nil]);
2483
2484 SQL_BLOB:
2485 if Length(Value) < GetAttachment.GetInlineBlobLimit then
2486 DoSetString
2487 else
2488 begin
2489 Changing;
2490 b := FIBXSQLVAR.CreateBlob;
2491 b.SetAsString(Value);
2492 AsBlob := b;
2493 Changed;
2494 end;
2495
2496 SQL_VARYING,
2497 SQL_TEXT:
2498 DoSetString;
2499
2500 SQL_SHORT,
2501 SQL_LONG,
2502 SQL_INT64:
2503 if TryStrToNumeric(Value,Int64Value,aScale) then
2504 SetAsNumeric(NumericFromRawValues(Int64Value,aScale))
2505 else
2506 DoSetString;
2507
2508 SQL_DEC_FIXED,
2509 SQL_DEC16,
2510 SQL_DEC34,
2511 SQL_INT128:
2512 if TryStrToBCD(Value,BCDValue) then
2513 SetAsNumeric(BCDToNumeric(BCDValue))
2514 else
2515 DoSetString;
2516
2517 SQL_D_FLOAT,
2518 SQL_DOUBLE,
2519 SQL_FLOAT:
2520 if TryStrToNumeric(Value,Int64Value,aScale) then
2521 SetAsNumeric(NumericFromRawValues(Int64Value,AScale))
2522 else
2523 DoSetString;
2524
2525 SQL_TIMESTAMP:
2526 if TryStrToDateTime(Value,dt) then
2527 SetAsDateTime(dt)
2528 else
2529 DoSetString;
2530
2531 SQL_TYPE_DATE:
2532 if TryStrToDateTime(Value,dt) then
2533 SetAsDate(dt)
2534 else
2535 DoSetString;
2536
2537 SQL_TYPE_TIME:
2538 if TryStrToDateTime(Value,dt) then
2539 SetAsTime(dt)
2540 else
2541 DoSetString;
2542
2543 SQL_TIMESTAMP_TZ,
2544 SQL_TIMESTAMP_TZ_EX:
2545 if ParseDateTimeTZString(value,dt,timezone) then
2546 SetAsDateTime(dt,timezone)
2547 else
2548 DoSetString;
2549
2550 SQL_TIME_TZ,
2551 SQL_TIME_TZ_EX:
2552 if ParseDateTimeTZString(value,dt,timezone,true) then
2553 SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2554 else
2555 DoSetString;
2556
2557 else
2558 IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2559 end;
2560 end;
2561
2562 procedure TSQLParam.CheckActive;
2563 begin
2564 if not FIBXSQLVAR.Parent.StateChanged(FChangeSeqNo) then Exit;
2565
2566 if FPrepareSeqNo < FIBXSQLVAR.Parent.GetPrepareSeqNo then
2567 IBError(ibxeInterfaceOutofDate,[nil]);
2568
2569 if not FIBXSQLVAR.Parent.CheckStatementStatus(ssPrepared) then
2570 IBError(ibxeStatementNotPrepared, [nil]);
2571 end;
2572
2573 procedure TSQLParam.SetScale(aValue: integer);
2574 begin
2575 CheckActive;
2576 FIBXSQLVAR.Scale := aValue;
2577 end;
2578
2579 procedure TSQLParam.SetDataLength(len: cardinal);
2580 begin
2581 CheckActive;
2582 FIBXSQLVAR.DataLength := len;
2583 end;
2584
2585 procedure TSQLParam.SetSQLType(aValue: cardinal);
2586 begin
2587 CheckActive;
2588 FIBXSQLVAR.SQLType := aValue;
2589 end;
2590
2591 procedure TSQLParam.Clear;
2592 begin
2593 IsNull := true;
2594 end;
2595
2596 function TSQLParam.CanChangeMetaData: boolean;
2597 begin
2598 Result := FIBXSQLVAR.CanChangeMetaData;
2599 end;
2600
2601 function TSQLParam.getColMetadata: IParamMetaData;
2602 begin
2603 Result := FIBXSQLVAR.getColMetadata;
2604 end;
2605
2606 function TSQLParam.GetModified: boolean;
2607 begin
2608 CheckActive;
2609 Result := FIBXSQLVAR.Modified;
2610 end;
2611
2612 function TSQLParam.GetAsPointer: Pointer;
2613 begin
2614 IsNull := false; {Assume that we get the pointer in order to set a value}
2615 Changed;
2616 Result := inherited GetAsPointer;
2617 end;
2618
2619 function TSQLParam.GetAsString: AnsiString;
2620 var rs: RawByteString;
2621 begin
2622 Result := '';
2623 if (SQLType = SQL_VARYING) and not IsNull then
2624 {SQLData points to start of string - default is to length word}
2625 begin
2626 CheckActive;
2627 SetString(rs,PAnsiChar(SQLData),DataLength);
2628 SetCodePage(rs,GetCodePage,false);
2629 Result := rs;
2630 end
2631 else
2632 Result := inherited GetAsString;
2633 end;
2634
2635 procedure TSQLParam.SetName(Value: AnsiString);
2636 begin
2637 CheckActive;
2638 FIBXSQLVAR.Name := Value;
2639 end;
2640
2641 procedure TSQLParam.SetIsNull(Value: Boolean);
2642 var i: integer;
2643 begin
2644 CheckActive;
2645 if FIBXSQLVAR.UniqueName then
2646 FIBXSQLVAR.IsNull := Value
2647 else
2648 with FIBXSQLVAR.Parent do
2649 begin
2650 for i := 0 to Count - 1 do
2651 if Column[i].Name = Name then
2652 Column[i].IsNull := Value;
2653 end
2654 end;
2655
2656 procedure TSQLParam.SetIsNullable(Value: Boolean);
2657 var i: integer;
2658 begin
2659 CheckActive;
2660 if FIBXSQLVAR.UniqueName then
2661 FIBXSQLVAR.IsNullable := Value
2662 else
2663 with FIBXSQLVAR.Parent do
2664 begin
2665 for i := 0 to Count - 1 do
2666 if Column[i].Name = Name then
2667 Column[i].IsNullable := Value;
2668 end
2669 end;
2670
2671 procedure TSQLParam.SetAsArray(anArray: IArray);
2672 begin
2673 CheckActive;
2674 if GetSQLType <> SQL_ARRAY then
2675 IBError(ibxeInvalidDataConversion,[nil]);
2676
2677 if not FIBXSQLVAR.UniqueName then
2678 IBError(ibxeDuplicateParamName,[FIBXSQLVAR.Name]);
2679
2680 FIBXSQLVAR.SetArray(anArray); {save array interface}
2681 SetAsQuad(AnArray.GetArrayID);
2682 end;
2683
2684 procedure TSQLParam.Changed;
2685 begin
2686 FIBXSQLVAR.Changed;
2687 end;
2688
2689 procedure TSQLParam.SetAsBoolean(AValue: boolean);
2690 var i: integer;
2691 OldSQLVar: TSQLVarData;
2692 begin
2693 if FIBXSQLVAR.UniqueName then
2694 inherited SetAsBoolean(AValue)
2695 else
2696 with FIBXSQLVAR.Parent do
2697 begin
2698 for i := 0 to Count - 1 do
2699 if Column[i].Name = Name then
2700 begin
2701 OldSQLVar := FIBXSQLVAR;
2702 FIBXSQLVAR := Column[i];
2703 try
2704 inherited SetAsBoolean(AValue);
2705 finally
2706 FIBXSQLVAR := OldSQLVar;
2707 end;
2708 end;
2709 end;
2710 end;
2711
2712 procedure TSQLParam.SetAsCurrency(AValue: Currency);
2713 var i: integer;
2714 OldSQLVar: TSQLVarData;
2715 begin
2716 if FIBXSQLVAR.UniqueName then
2717 inherited SetAsCurrency(AValue)
2718 else
2719 with FIBXSQLVAR.Parent do
2720 begin
2721 for i := 0 to Count - 1 do
2722 if Column[i].Name = Name then
2723 begin
2724 OldSQLVar := FIBXSQLVAR;
2725 FIBXSQLVAR := Column[i];
2726 try
2727 inherited SetAsCurrency(AValue);
2728 finally
2729 FIBXSQLVAR := OldSQLVar;
2730 end;
2731 end;
2732 end;
2733 end;
2734
2735 procedure TSQLParam.SetAsInt64(AValue: Int64);
2736 var i: integer;
2737 OldSQLVar: TSQLVarData;
2738 begin
2739 if FIBXSQLVAR.UniqueName then
2740 inherited SetAsInt64(AValue)
2741 else
2742 with FIBXSQLVAR.Parent do
2743 begin
2744 for i := 0 to Count - 1 do
2745 if Column[i].Name = Name then
2746 begin
2747 OldSQLVar := FIBXSQLVAR;
2748 FIBXSQLVAR := Column[i];
2749 try
2750 inherited SetAsInt64(AValue);
2751 finally
2752 FIBXSQLVAR := OldSQLVar;
2753 end;
2754 end;
2755 end;
2756 end;
2757
2758 procedure TSQLParam.SetAsDate(AValue: TDateTime);
2759 var i: integer;
2760 OldSQLVar: TSQLVarData;
2761 begin
2762 if FIBXSQLVAR.UniqueName then
2763 inherited SetAsDate(AValue)
2764 else
2765 with FIBXSQLVAR.Parent do
2766 begin
2767 for i := 0 to Count - 1 do
2768 if Column[i].Name = Name then
2769 begin
2770 OldSQLVar := FIBXSQLVAR;
2771 FIBXSQLVAR := Column[i];
2772 try
2773 inherited SetAsDate(AValue);
2774 finally
2775 FIBXSQLVAR := OldSQLVar;
2776 end;
2777 end;
2778 end;
2779 end;
2780
2781 procedure TSQLParam.SetAsLong(AValue: Long);
2782 var i: integer;
2783 OldSQLVar: TSQLVarData;
2784 begin
2785 if FIBXSQLVAR.UniqueName then
2786 inherited SetAsLong(AValue)
2787 else
2788 with FIBXSQLVAR.Parent do
2789 begin
2790 for i := 0 to Count - 1 do
2791 if Column[i].Name = Name then
2792 begin
2793 OldSQLVar := FIBXSQLVAR;
2794 FIBXSQLVAR := Column[i];
2795 try
2796 inherited SetAsLong(AValue);
2797 finally
2798 FIBXSQLVAR := OldSQLVar;
2799 end;
2800 end;
2801 end;
2802 end;
2803
2804 procedure TSQLParam.SetAsTime(AValue: TDateTime);
2805 var i: integer;
2806 OldSQLVar: TSQLVarData;
2807 begin
2808 if FIBXSQLVAR.UniqueName then
2809 inherited SetAsTime(AValue)
2810 else
2811 with FIBXSQLVAR.Parent do
2812 begin
2813 for i := 0 to Count - 1 do
2814 if Column[i].Name = Name then
2815 begin
2816 OldSQLVar := FIBXSQLVAR;
2817 FIBXSQLVAR := Column[i];
2818 try
2819 inherited SetAsTime(AValue);
2820 finally
2821 FIBXSQLVAR := OldSQLVar;
2822 end;
2823 end;
2824 end;
2825 end;
2826
2827 procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
2828 var i: integer;
2829 OldSQLVar: TSQLVarData;
2830 begin
2831 if FIBXSQLVAR.UniqueName then
2832 inherited SetAsTime(AValue,OnDate, aTimeZoneID)
2833 else
2834 with FIBXSQLVAR.Parent do
2835 begin
2836 for i := 0 to Count - 1 do
2837 if Column[i].Name = Name then
2838 begin
2839 OldSQLVar := FIBXSQLVAR;
2840 FIBXSQLVAR := Column[i];
2841 try
2842 inherited SetAsTime(AValue,OnDate, aTimeZoneID);
2843 finally
2844 FIBXSQLVAR := OldSQLVar;
2845 end;
2846 end;
2847 end;
2848 end;
2849
2850 procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
2851 var i: integer;
2852 OldSQLVar: TSQLVarData;
2853 begin
2854 if FIBXSQLVAR.UniqueName then
2855 inherited SetAsTime(AValue,OnDate,aTimeZone)
2856 else
2857 with FIBXSQLVAR.Parent do
2858 begin
2859 for i := 0 to Count - 1 do
2860 if Column[i].Name = Name then
2861 begin
2862 OldSQLVar := FIBXSQLVAR;
2863 FIBXSQLVAR := Column[i];
2864 try
2865 inherited SetAsTime(AValue,OnDate,aTimeZone);
2866 finally
2867 FIBXSQLVAR := OldSQLVar;
2868 end;
2869 end;
2870 end;
2871 end;
2872
2873 procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID);
2874 begin
2875 SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZoneID);
2876 end;
2877
2878 procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZone: AnsiString);
2879 begin
2880 SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZone);
2881 end;
2882
2883 procedure TSQLParam.SetAsDateTime(AValue: TDateTime);
2884 var i: integer;
2885 OldSQLVar: TSQLVarData;
2886 begin
2887 if FIBXSQLVAR.UniqueName then
2888 inherited SetAsDateTime(AValue)
2889 else
2890 with FIBXSQLVAR.Parent do
2891 begin
2892 for i := 0 to Count - 1 do
2893 if Column[i].Name = Name then
2894 begin
2895 OldSQLVar := FIBXSQLVAR;
2896 FIBXSQLVAR := Column[i];
2897 try
2898 inherited SetAsDateTime(AValue);
2899 finally
2900 FIBXSQLVAR := OldSQLVar;
2901 end;
2902 end;
2903 end;
2904 end;
2905
2906 procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID
2907 );
2908 var i: integer;
2909 OldSQLVar: TSQLVarData;
2910 begin
2911 if FIBXSQLVAR.UniqueName then
2912 inherited SetAsDateTime(AValue,aTimeZoneID)
2913 else
2914 with FIBXSQLVAR.Parent do
2915 begin
2916 for i := 0 to Count - 1 do
2917 if Column[i].Name = Name then
2918 begin
2919 OldSQLVar := FIBXSQLVAR;
2920 FIBXSQLVAR := Column[i];
2921 try
2922 inherited SetAsDateTime(AValue,aTimeZoneID);
2923 finally
2924 FIBXSQLVAR := OldSQLVar;
2925 end;
2926 end;
2927 end;
2928 end;
2929
2930 procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString);
2931 var i: integer;
2932 OldSQLVar: TSQLVarData;
2933 begin
2934 if FIBXSQLVAR.UniqueName then
2935 inherited SetAsDateTime(AValue,aTimeZone)
2936 else
2937 with FIBXSQLVAR.Parent do
2938 begin
2939 for i := 0 to Count - 1 do
2940 if Column[i].Name = Name then
2941 begin
2942 OldSQLVar := FIBXSQLVAR;
2943 FIBXSQLVAR := Column[i];
2944 try
2945 inherited SetAsDateTime(AValue,aTimeZone);
2946 finally
2947 FIBXSQLVAR := OldSQLVar;
2948 end;
2949 end;
2950 end;
2951 end;
2952
2953 procedure TSQLParam.SetAsDouble(AValue: Double);
2954 var i: integer;
2955 OldSQLVar: TSQLVarData;
2956 begin
2957 if FIBXSQLVAR.UniqueName then
2958 inherited SetAsDouble(AValue)
2959 else
2960 with FIBXSQLVAR.Parent do
2961 begin
2962 for i := 0 to Count - 1 do
2963 if Column[i].Name = Name then
2964 begin
2965 OldSQLVar := FIBXSQLVAR;
2966 FIBXSQLVAR := Column[i];
2967 try
2968 inherited SetAsDouble(AValue);
2969 finally
2970 FIBXSQLVAR := OldSQLVar;
2971 end;
2972 end;
2973 end;
2974 end;
2975
2976 procedure TSQLParam.SetAsFloat(AValue: Float);
2977 var i: integer;
2978 OldSQLVar: TSQLVarData;
2979 begin
2980 if FIBXSQLVAR.UniqueName then
2981 inherited SetAsFloat(AValue)
2982 else
2983 with FIBXSQLVAR.Parent do
2984 begin
2985 for i := 0 to Count - 1 do
2986 if Column[i].Name = Name then
2987 begin
2988 OldSQLVar := FIBXSQLVAR;
2989 FIBXSQLVAR := Column[i];
2990 try
2991 inherited SetAsFloat(AValue);
2992 finally
2993 FIBXSQLVAR := OldSQLVar;
2994 end;
2995 end;
2996 end;
2997 end;
2998
2999 procedure TSQLParam.SetAsPointer(AValue: Pointer);
3000 var i: integer;
3001 OldSQLVar: TSQLVarData;
3002 begin
3003 if FIBXSQLVAR.UniqueName then
3004 inherited SetAsPointer(AValue)
3005 else
3006 with FIBXSQLVAR.Parent do
3007 begin
3008 for i := 0 to Count - 1 do
3009 if Column[i].Name = Name then
3010 begin
3011 OldSQLVar := FIBXSQLVAR;
3012 FIBXSQLVAR := Column[i];
3013 try
3014 inherited SetAsPointer(AValue);
3015 finally
3016 FIBXSQLVAR := OldSQLVar;
3017 end;
3018 end;
3019 end;
3020 end;
3021
3022 procedure TSQLParam.SetAsShort(AValue: Short);
3023 var i: integer;
3024 OldSQLVar: TSQLVarData;
3025 begin
3026 if FIBXSQLVAR.UniqueName then
3027 inherited SetAsShort(AValue)
3028 else
3029 with FIBXSQLVAR.Parent do
3030 begin
3031 for i := 0 to Count - 1 do
3032 if Column[i].Name = Name then
3033 begin
3034 OldSQLVar := FIBXSQLVAR;
3035 FIBXSQLVAR := Column[i];
3036 try
3037 inherited SetAsShort(AValue);
3038 finally
3039 FIBXSQLVAR := OldSQLVar;
3040 end;
3041 end;
3042 end;
3043 end;
3044
3045 procedure TSQLParam.SetAsString(AValue: AnsiString);
3046 var i: integer;
3047 OldSQLVar: TSQLVarData;
3048 begin
3049 if FIBXSQLVAR.UniqueName then
3050 InternalSetAsString(AValue)
3051 else
3052 with FIBXSQLVAR.Parent do
3053 begin
3054 for i := 0 to Count - 1 do
3055 if Column[i].Name = Name then
3056 begin
3057 OldSQLVar := FIBXSQLVAR;
3058 FIBXSQLVAR := Column[i];
3059 try
3060 InternalSetAsString(AValue);
3061 finally
3062 FIBXSQLVAR := OldSQLVar;
3063 end;
3064 end;
3065 end;
3066 end;
3067
3068 procedure TSQLParam.SetAsVariant(AValue: Variant);
3069 var i: integer;
3070 OldSQLVar: TSQLVarData;
3071 begin
3072 if FIBXSQLVAR.UniqueName then
3073 inherited SetAsVariant(AValue)
3074 else
3075 with FIBXSQLVAR.Parent do
3076 begin
3077 for i := 0 to Count - 1 do
3078 if Column[i].Name = Name then
3079 begin
3080 OldSQLVar := FIBXSQLVAR;
3081 FIBXSQLVAR := Column[i];
3082 try
3083 inherited SetAsVariant(AValue);
3084 finally
3085 FIBXSQLVAR := OldSQLVar;
3086 end;
3087 end;
3088 end;
3089 end;
3090
3091 procedure TSQLParam.SetAsBlob(aValue: IBlob);
3092 begin
3093 with FIBXSQLVAR do
3094 if not UniqueName then
3095 IBError(ibxeDuplicateParamName,[Name]);
3096 CheckActive;
3097 Changing;
3098 aValue.Close;
3099 if aValue.GetSubType <> GetSubType then
3100 IBError(ibxeIncompatibleBlob,[GetSubType,aValue.GetSubType]);
3101 AsQuad := aValue.GetBlobID;
3102 Changed;
3103 end;
3104
3105 procedure TSQLParam.SetAsQuad(AValue: TISC_QUAD);
3106 var i: integer;
3107 OldSQLVar: TSQLVarData;
3108 begin
3109 if FIBXSQLVAR.UniqueName then
3110 inherited SetAsQuad(AValue)
3111 else
3112 with FIBXSQLVAR.Parent do
3113 begin
3114 for i := 0 to Count - 1 do
3115 if Column[i].Name = Name then
3116 begin
3117 OldSQLVar := FIBXSQLVAR;
3118 FIBXSQLVAR := Column[i];
3119 try
3120 inherited SetAsQuad(AValue);
3121 finally
3122 FIBXSQLVAR := OldSQLVar;
3123 end;
3124 end;
3125 end;
3126 end;
3127
3128 procedure TSQLParam.SetCharSetID(aValue: cardinal);
3129 begin
3130 FIBXSQLVAR.SetCharSetID(aValue);
3131 end;
3132
3133 procedure TSQLParam.SetAsBcd(aValue: tBCD);
3134 var i: integer;
3135 OldSQLVar: TSQLVarData;
3136 begin
3137 if FIBXSQLVAR.UniqueName then
3138 inherited SetAsBcd(AValue)
3139 else
3140 with FIBXSQLVAR.Parent do
3141 begin
3142 for i := 0 to Count - 1 do
3143 if Column[i].Name = Name then
3144 begin
3145 OldSQLVar := FIBXSQLVAR;
3146 FIBXSQLVAR := Column[i];
3147 try
3148 inherited SetAsBcd(AValue);
3149 finally
3150 FIBXSQLVAR := OldSQLVar;
3151 end;
3152 end;
3153 end;
3154 end;
3155
3156 procedure TSQLParam.SetAsNumeric(aValue: IFBNumeric);
3157 var i: integer;
3158 OldSQLVar: TSQLVarData;
3159 begin
3160 if FIBXSQLVAR.UniqueName then
3161 inherited SetAsNumeric(AValue)
3162 else
3163 with FIBXSQLVAR.Parent do
3164 begin
3165 for i := 0 to Count - 1 do
3166 if Column[i].Name = Name then
3167 begin
3168 OldSQLVar := FIBXSQLVAR;
3169 FIBXSQLVAR := Column[i];
3170 try
3171 inherited SetAsNumeric(AValue);
3172 finally
3173 FIBXSQLVAR := OldSQLVar;
3174 end;
3175 end;
3176 end;
3177 end;
3178
3179 { TMetaData }
3180
3181 procedure TMetaData.CheckActive;
3182 begin
3183 if FPrepareSeqNo < FMetaData.PrepareSeqNo then
3184 IBError(ibxeInterfaceOutofDate,[nil]);
3185
3186 if not FMetaData.CheckStatementStatus(ssPrepared) then
3187 IBError(ibxeStatementNotPrepared, [nil]);
3188 end;
3189
3190 constructor TMetaData.Create(aMetaData: TSQLDataArea);
3191 begin
3192 inherited Create(aMetaData.Count);
3193 FMetaData := aMetaData;
3194 FStatement := aMetaData.Statement;
3195 FPrepareSeqNo := aMetaData.PrepareSeqNo;
3196 end;
3197
3198 destructor TMetaData.Destroy;
3199 begin
3200 if FStatement <> nil then
3201 (FStatement as TInterfaceOwner).Remove(self);
3202 inherited Destroy;
3203 end;
3204
3205 function TMetaData.GetUniqueRelationName: AnsiString;
3206 begin
3207 CheckActive;
3208 Result := FMetaData.UniqueRelationName;
3209 end;
3210
3211 function TMetaData.getCount: integer;
3212 begin
3213 CheckActive;
3214 Result := FMetaData.ColumnsInUseCount;
3215 end;
3216
3217 function TMetaData.getColumnMetaData(index: integer): IColumnMetaData;
3218 begin
3219 CheckActive;
3220 if (index < 0) or (index >= getCount) then
3221 IBError(ibxeInvalidColumnIndex,[nil]);
3222
3223 if FMetaData.Count = 0 then
3224 Result := nil
3225 else
3226 begin
3227 if not HasInterface(index) then
3228 AddInterface(index,TColumnMetaData.Create(self,FMetaData.Column[index]));
3229 Result := TColumnMetaData(GetInterface(index));
3230 end;
3231 end;
3232
3233 function TMetaData.ByName(Idx: AnsiString): IColumnMetaData;
3234 var aIBXSQLVAR: TSQLVarData;
3235 begin
3236 CheckActive;
3237 aIBXSQLVAR := FMetaData.ColumnByName(Idx);
3238 if aIBXSQLVAR = nil then
3239 IBError(ibxeFieldNotFound,[Idx]);
3240 Result := getColumnMetaData(aIBXSQLVAR.index);
3241 end;
3242
3243 { TSQLParams }
3244
3245 procedure TSQLParams.CheckActive;
3246 begin
3247 if not FSQLParams.StateChanged(FChangeSeqNo) then Exit;
3248
3249 if FPrepareSeqNo < FSQLParams.PrepareSeqNo then
3250 IBError(ibxeInterfaceOutofDate,[nil]);
3251
3252 if not FSQLParams.CheckStatementStatus(ssPrepared) then
3253 IBError(ibxeStatementNotPrepared, [nil]);
3254 end;
3255
3256 constructor TSQLParams.Create(aSQLParams: TSQLDataArea);
3257 begin
3258 inherited Create(aSQLParams.Count);
3259 FSQLParams := aSQLParams;
3260 FStatement := aSQLParams.Statement;
3261 FPrepareSeqNo := aSQLParams.PrepareSeqNo;
3262 FSQLParams.StateChanged(FChangeSeqNo);
3263 end;
3264
3265 destructor TSQLParams.Destroy;
3266 begin
3267 if FStatement <> nil then
3268 (FStatement as TInterfaceOwner).Remove(self);
3269 inherited Destroy;
3270 end;
3271
3272 function TSQLParams.getCount: integer;
3273 begin
3274 CheckActive;
3275 Result := FSQLParams.ColumnsInUseCount;
3276 end;
3277
3278 function TSQLParams.getSQLParam(index: integer): ISQLParam;
3279 begin
3280 CheckActive;
3281 if (index < 0) or (index >= getCount) then
3282 IBError(ibxeInvalidColumnIndex,[nil]);
3283
3284 if getCount = 0 then
3285 Result := nil
3286 else
3287 begin
3288 if not HasInterface(index) then
3289 AddInterface(index, TSQLParam.Create(self,FSQLParams.Column[index]));
3290 Result := TSQLParam(GetInterface(index));
3291 end;
3292 end;
3293
3294 function TSQLParams.ByName(Idx: AnsiString): ISQLParam;
3295 var aIBXSQLVAR: TSQLVarData;
3296 begin
3297 CheckActive;
3298 aIBXSQLVAR := FSQLParams.ColumnByName(Idx);
3299 if aIBXSQLVAR = nil then
3300 IBError(ibxeFieldNotFound,[Idx]);
3301 Result := getSQLParam(aIBXSQLVAR.index);
3302 end;
3303
3304 function TSQLParams.GetModified: Boolean;
3305 var
3306 i: Integer;
3307 begin
3308 CheckActive;
3309 result := False;
3310 with FSQLParams do
3311 for i := 0 to Count - 1 do
3312 if Column[i].Modified then
3313 begin
3314 result := True;
3315 exit;
3316 end;
3317 end;
3318
3319 function TSQLParams.GetHasCaseSensitiveParams: Boolean;
3320 begin
3321 Result := FSQLParams.CaseSensitiveParams;
3322 end;
3323
3324 function TSQLParams.GetStatement: IStatement;
3325 begin
3326 Result := FSQLParams.GetStatement;
3327 end;
3328
3329 function TSQLParams.GetTransaction: ITransaction;
3330 begin
3331 Result := FSQLParams.GetTransaction;
3332 end;
3333
3334 function TSQLParams.GetAttachment: IAttachment;
3335 begin
3336 Result := FSQLParams.GetAttachment;
3337 end;
3338
3339 procedure TSQLParams.Clear;
3340 var i: integer;
3341 begin
3342 for i := 0 to getCount - 1 do
3343 getSQLParam(i).Clear;
3344 end;
3345
3346 { TResults }
3347
3348 procedure TResults.CheckActive;
3349 begin
3350 if not FResults.StateChanged(FChangeSeqNo) then Exit;
3351
3352 if FPrepareSeqNo < FResults.PrepareSeqNo then
3353 IBError(ibxeInterfaceOutofDate,[nil]);
3354
3355 if not FResults.CheckStatementStatus(ssPrepared) then
3356 IBError(ibxeStatementNotPrepared, [nil]);
3357
3358 with GetTransaction do
3359 if not InTransaction or (FResults.TransactionSeqNo <> FTransactionSeqNo) then
3360 IBError(ibxeInterfaceOutofDate,[nil]);
3361 end;
3362
3363 function TResults.GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
3364 var col: TIBSQLData;
3365 begin
3366 if (aIBXSQLVAR.Index < 0) or (aIBXSQLVAR.Index >= getCount) then
3367 IBError(ibxeInvalidColumnIndex,[nil]);
3368
3369 if not HasInterface(aIBXSQLVAR.Index) then
3370 begin
3371 col := TIBSQLData.Create(self,aIBXSQLVAR);
3372 AddInterface(aIBXSQLVAR.Index, col);
3373 end
3374 else
3375 col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3376 Result := col;
3377 end;
3378
3379 constructor TResults.Create(aResults: TSQLDataArea);
3380 begin
3381 inherited Create(aResults.Count);
3382 FResults := aResults;
3383 FStatement := aResults.Statement;
3384 FPrepareSeqNo := aResults.PrepareSeqNo;
3385 FTransactionSeqNo := aResults.TransactionSeqNo;
3386 FResults.StateChanged(FChangeSeqNo);
3387 end;
3388
3389 function TResults.getCount: integer;
3390 begin
3391 CheckActive;
3392 Result := FResults.Count;
3393 end;
3394
3395 function TResults.ByName(Idx: AnsiString): ISQLData;
3396 var col: TSQLVarData;
3397 begin
3398 Result := nil;
3399 CheckActive;
3400 if FResults.CheckStatementStatus(ssBOF) then
3401 IBError(ibxeBOF,[nil]);
3402 if FResults.CheckStatementStatus(ssEOF) then
3403 IBError(ibxeEOF,[nil]);
3404
3405 if FResults.Count > 0 then
3406 begin
3407 col := FResults.ColumnByName(Idx);
3408 if col <> nil then
3409 Result := GetISQLData(col);
3410 end;
3411 end;
3412
3413 function TResults.getSQLData(index: integer): ISQLData;
3414 begin
3415 CheckActive;
3416 if FResults.CheckStatementStatus(ssBOF) then
3417 IBError(ibxeBOF,[nil]);
3418 if FResults.CheckStatementStatus(ssEOF) then
3419 IBError(ibxeEOF,[nil]);
3420 if (index < 0) or (index >= FResults.Count) then
3421 IBError(ibxeInvalidColumnIndex,[nil]);
3422
3423 Result := GetISQLData(FResults.Column[index]);
3424 end;
3425
3426 procedure TResults.GetData(index: integer; var IsNull: boolean; var len: short;
3427 var data: PByte);
3428 begin
3429 CheckActive;
3430 FResults.GetData(index,IsNull, len,data);
3431 end;
3432
3433 function TResults.GetStatement: IStatement;
3434 begin
3435 Result := FStatement;
3436 end;
3437
3438 function TResults.GetTransaction: ITransaction;
3439 begin
3440 Result := FResults.GetTransaction;
3441 end;
3442
3443 function TResults.GetAttachment: IAttachment;
3444 begin
3445 Result := FResults.GetAttachment;
3446 end;
3447
3448 procedure TResults.SetRetainInterfaces(aValue: boolean);
3449 begin
3450 RetainInterfaces := aValue;
3451 end;
3452
3453 end.
3454

Properties

Name Value
svn:eol-style native