ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/FBSQLData.pas
Revision: 345
Committed: Mon Aug 23 14:22:29 2021 UTC (2 years, 7 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/FBSQLData.pas
File size: 87673 byte(s)
Log Message:
Merged into public release

File Contents

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