ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBSQLData.pas
Revision: 363
Committed: Tue Dec 7 13:30:05 2021 UTC (2 years, 3 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/branches/journaling/fbintf/client/FBSQLData.pas
File size: 91058 byte(s)
Log Message:
add fbintf

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