ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/FBSQLData.pas
Revision: 353
Committed: Sat Oct 23 14:11:37 2021 UTC (2 years, 5 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/FBSQLData.pas
File size: 90917 byte(s)
Log Message:
Fixes Merged

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