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