ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBSQLData.pas
Revision: 379
Committed: Mon Jan 10 10:08:03 2022 UTC (2 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 92766 byte(s)
Log Message:
set line ending property

File Contents

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

Properties

Name Value
svn:eol-style native