ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBSQLData.pas
Revision: 349
Committed: Mon Oct 18 08:39:40 2021 UTC (3 years, 1 month ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/FBSQLData.pas
File size: 90604 byte(s)
Log Message:
FIxes Merged

File Contents

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