ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBSQLData.pas
Revision: 270
Committed: Fri Jan 18 11:10:37 2019 UTC (5 years, 2 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/FBSQLData.pas
File size: 64477 byte(s)
Log Message:
Fixes merged

File Contents

# User Rev Content
1 tony 45 (*
2     * Firebird Interface (fbintf). The fbintf components provide a set of
3     * Pascal language bindings for the Firebird API. Although predominantly
4     * a new development they include source code taken from IBX and may be
5     * considered a derived product. This software thus also includes the copyright
6     * notice and license conditions from IBX.
7     *
8     * Except for those parts dervied from IBX, contents of this file are subject
9     * to the Initial Developer's Public License Version 1.0 (the "License"); you
10     * may not use this file except in compliance with the License. You may obtain a
11     * copy of the License here:
12     *
13     * http://www.firebirdsql.org/index.php?op=doc&id=idpl
14     *
15     * Software distributed under the License is distributed on an "AS
16     * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
17     * implied. See the License for the specific language governing rights
18     * and limitations under the License.
19     *
20     * The Initial Developer of the Original Code is Tony Whyman.
21     *
22     * The Original Code is (C) 2016 Tony Whyman, MWA Software
23     * (http://www.mwasoftware.co.uk).
24     *
25     * All Rights Reserved.
26     *
27     * Contributor(s): ______________________________________.
28     *
29     *)
30     {************************************************************************}
31     { }
32     { Borland Delphi Visual Component Library }
33     { InterBase Express core components }
34     { }
35     { Copyright (c) 1998-2000 Inprise Corporation }
36     { }
37     { InterBase Express is based in part on the product }
38     { Free IB Components, written by Gregory H. Deatz for }
39     { Hoagland, Longo, Moran, Dunst & Doukas Company. }
40     { Free IB Components is used under license. }
41     { }
42     { The contents of this file are subject to the InterBase }
43     { Public License Version 1.0 (the "License"); you may not }
44     { use this file except in compliance with the License. You }
45     { may obtain a copy of the License at http://www.Inprise.com/IPL.html }
46     { Software distributed under the License is distributed on }
47     { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
48     { express or implied. See the License for the specific language }
49     { governing rights and limitations under the License. }
50     { The Original Code was created by InterBase Software Corporation }
51     { and its successors. }
52     { Portions created by Inprise Corporation are Copyright (C) Inprise }
53     { Corporation. All Rights Reserved. }
54     { Contributor(s): Jeff Overcash }
55     { }
56     { IBX For Lazarus (Firebird Express) }
57     { Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
58     { Portions created by MWA Software are copyright McCallum Whyman }
59     { Associates Ltd 2011 - 2015 }
60     { }
61     {************************************************************************}
62     unit FBSQLData;
63 tony 56 {$IFDEF MSWINDOWS}
64     {$DEFINE WINDOWS}
65     {$ENDIF}
66 tony 45
67     {$IFDEF FPC}
68 tony 56 {$mode delphi}
69 tony 45 {$codepage UTF8}
70     {$interfaces COM}
71     {$ENDIF}
72    
73     { This Unit was hacked out of the IBSQL unit and defines a class used as the
74     base for interfaces accessing SQLDAVar data and Array Elements. The abstract
75     methods are used to customise for an SQLDAVar or Array Element. The empty
76     methods are needed for SQL parameters only. The string getters and setters
77     are virtual as SQLVar and Array encodings of string data is different.}
78    
79    
80     interface
81    
82     uses
83 tony 263 Classes, SysUtils, IBExternals, IBHeader, IB, FBActivityMonitor, FBClientAPI;
84 tony 45
85     type
86    
87     { TSQLDataItem }
88    
89     TSQLDataItem = class(TFBInterfacedObject)
90     private
91 tony 263 FFirebirdClientAPI: TFBClientAPI;
92 tony 45 function AdjustScale(Value: Int64; aScale: Integer): Double;
93     function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
94     function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
95 tony 270 function GetTimestampFormatStr: AnsiString;
96     function GetDateFormatStr(IncludeTime: boolean): AnsiString;
97     function GetTimeFormatStr: AnsiString;
98 tony 45 procedure SetAsInteger(AValue: Integer);
99     protected
100     function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
101     function AdjustScaleFromDouble(Value: Double; aScale: Integer): Int64;
102     procedure CheckActive; virtual;
103     function GetSQLDialect: integer; virtual; abstract;
104     procedure Changed; virtual;
105     procedure Changing; virtual;
106 tony 56 procedure InternalSetAsString(Value: AnsiString); virtual;
107     function SQLData: PByte; virtual; abstract;
108 tony 45 function GetDataLength: cardinal; virtual; abstract;
109     function GetCodePage: TSystemCodePage; virtual; abstract;
110 tony 47 function getCharSetID: cardinal; virtual; abstract;
111 tony 56 function Transliterate(s: AnsiString; CodePage: TSystemCodePage): RawByteString;
112 tony 45 procedure SetScale(aValue: integer); virtual;
113     procedure SetDataLength(len: cardinal); virtual;
114     procedure SetSQLType(aValue: cardinal); virtual;
115     property DataLength: cardinal read GetDataLength write SetDataLength;
116    
117     public
118 tony 263 constructor Create(api: TFBClientAPI);
119 tony 45 function GetSQLType: cardinal; virtual; abstract;
120 tony 56 function GetSQLTypeName: AnsiString; overload;
121     class function GetSQLTypeName(SQLType: short): AnsiString; overload;
122     function GetName: AnsiString; virtual; abstract;
123 tony 45 function GetScale: integer; virtual; abstract;
124     function GetAsBoolean: boolean;
125     function GetAsCurrency: Currency;
126     function GetAsInt64: Int64;
127     function GetAsDateTime: TDateTime;
128     function GetAsDouble: Double;
129     function GetAsFloat: Float;
130     function GetAsLong: Long;
131     function GetAsPointer: Pointer;
132     function GetAsQuad: TISC_QUAD;
133     function GetAsShort: short;
134 tony 56 function GetAsString: AnsiString; virtual;
135 tony 45 function GetIsNull: Boolean; virtual;
136 tony 263 function GetIsNullable: boolean; virtual;
137 tony 45 function GetAsVariant: Variant;
138     function GetModified: boolean; virtual;
139 tony 270 function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
140 tony 45 procedure SetAsBoolean(AValue: boolean); virtual;
141     procedure SetAsCurrency(Value: Currency); virtual;
142     procedure SetAsInt64(Value: Int64); virtual;
143     procedure SetAsDate(Value: TDateTime); virtual;
144     procedure SetAsLong(Value: Long); virtual;
145     procedure SetAsTime(Value: TDateTime); virtual;
146     procedure SetAsDateTime(Value: TDateTime);
147     procedure SetAsDouble(Value: Double); virtual;
148     procedure SetAsFloat(Value: Float); virtual;
149     procedure SetAsPointer(Value: Pointer);
150     procedure SetAsQuad(Value: TISC_QUAD);
151     procedure SetAsShort(Value: short); virtual;
152 tony 56 procedure SetAsString(Value: AnsiString); virtual;
153 tony 45 procedure SetAsVariant(Value: Variant);
154 tony 59 procedure SetAsNumeric(Value: Int64; aScale: integer);
155 tony 45 procedure SetIsNull(Value: Boolean); virtual;
156     procedure SetIsNullable(Value: Boolean); virtual;
157 tony 56 procedure SetName(aValue: AnsiString); virtual;
158 tony 45 property AsDate: TDateTime read GetAsDateTime write SetAsDate;
159     property AsBoolean:boolean read GetAsBoolean write SetAsBoolean;
160     property AsTime: TDateTime read GetAsDateTime write SetAsTime;
161     property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
162     property AsDouble: Double read GetAsDouble write SetAsDouble;
163     property AsFloat: Float read GetAsFloat write SetAsFloat;
164     property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
165     property AsInt64: Int64 read GetAsInt64 write SetAsInt64;
166     property AsInteger: Integer read GetAsLong write SetAsInteger;
167     property AsLong: Long read GetAsLong write SetAsLong;
168     property AsPointer: Pointer read GetAsPointer write SetAsPointer;
169     property AsQuad: TISC_QUAD read GetAsQuad write SetAsQuad;
170     property AsShort: short read GetAsShort write SetAsShort;
171 tony 56 property AsString: AnsiString read GetAsString write SetAsString;
172 tony 45 property AsVariant: Variant read GetAsVariant write SetAsVariant;
173     property Modified: Boolean read getModified;
174     property IsNull: Boolean read GetIsNull write SetIsNull;
175     property IsNullable: Boolean read GetIsNullable write SetIsNullable;
176     property Scale: integer read GetScale write SetScale;
177     property SQLType: cardinal read GetSQLType write SetSQLType;
178     end;
179    
180     TSQLVarData = class;
181    
182     TStatementStatus = (ssPrepared, ssExecuteResults, ssCursorOpen, ssBOF, ssEOF);
183    
184     { TSQLDataArea }
185    
186     TSQLDataArea = class
187     private
188 tony 270 FCaseSensitiveParams: boolean;
189 tony 45 function GetColumn(index: integer): TSQLVarData;
190     function GetCount: integer;
191     protected
192 tony 56 FUniqueRelationName: AnsiString;
193 tony 45 FColumnList: array of TSQLVarData;
194     function GetStatement: IStatement; virtual; abstract;
195     function GetPrepareSeqNo: integer; virtual; abstract;
196     function GetTransactionSeqNo: integer; virtual; abstract;
197     procedure SetCount(aValue: integer); virtual; abstract;
198     procedure SetUniqueRelationName;
199     public
200     procedure Initialize; virtual;
201     function IsInputDataArea: boolean; virtual; abstract; {Input to Database}
202 tony 56 procedure PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
203     var sProcessedSQL: AnsiString);
204 tony 45 function ColumnsInUseCount: integer; virtual;
205 tony 56 function ColumnByName(Idx: AnsiString): TSQLVarData;
206 tony 45 function CheckStatementStatus(Request: TStatementStatus): boolean; virtual; abstract;
207     procedure GetData(index: integer; var IsNull: boolean; var len: short;
208 tony 56 var data: PByte); virtual;
209 tony 45 procedure RowChange;
210     function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
211 tony 270 property CaseSensitiveParams: boolean read FCaseSensitiveParams
212     write FCaseSensitiveParams; {Only used when IsInputDataArea true}
213 tony 45 property Count: integer read GetCount;
214     property Column[index: integer]: TSQLVarData read GetColumn;
215 tony 56 property UniqueRelationName: AnsiString read FUniqueRelationName;
216 tony 45 property Statement: IStatement read GetStatement;
217     property PrepareSeqNo: integer read GetPrepareSeqNo;
218     property TransactionSeqNo: integer read GetTransactionSeqNo;
219     end;
220    
221     { TSQLVarData }
222    
223     TSQLVarData = class
224     private
225     FParent: TSQLDataArea;
226 tony 56 FName: AnsiString;
227 tony 45 FIndex: integer;
228     FModified: boolean;
229     FUniqueName: boolean;
230     FVarString: RawByteString;
231     function GetStatement: IStatement;
232 tony 56 procedure SetName(AValue: AnsiString);
233 tony 45 protected
234     function GetSQLType: cardinal; virtual; abstract;
235     function GetSubtype: integer; virtual; abstract;
236 tony 56 function GetAliasName: AnsiString; virtual; abstract;
237     function GetFieldName: AnsiString; virtual; abstract;
238     function GetOwnerName: AnsiString; virtual; abstract;
239     function GetRelationName: AnsiString; virtual; abstract;
240 tony 45 function GetScale: integer; virtual; abstract;
241     function GetCharSetID: cardinal; virtual; abstract;
242     function GetCodePage: TSystemCodePage; virtual; abstract;
243     function GetIsNull: Boolean; virtual; abstract;
244     function GetIsNullable: boolean; virtual; abstract;
245 tony 56 function GetSQLData: PByte; virtual; abstract;
246 tony 45 function GetDataLength: cardinal; virtual; abstract;
247     procedure SetIsNull(Value: Boolean); virtual; abstract;
248     procedure SetIsNullable(Value: Boolean); virtual; abstract;
249 tony 56 procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
250 tony 45 procedure SetScale(aValue: integer); virtual; abstract;
251     procedure SetDataLength(len: cardinal); virtual; abstract;
252     procedure SetSQLType(aValue: cardinal); virtual; abstract;
253     procedure SetCharSetID(aValue: cardinal); virtual; abstract;
254     public
255     constructor Create(aParent: TSQLDataArea; aIndex: integer);
256 tony 56 procedure SetString(aValue: AnsiString);
257 tony 45 procedure Changed; virtual;
258     procedure RowChange; virtual;
259     function GetAsArray(Array_ID: TISC_QUAD): IArray; virtual; abstract;
260     function GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob; virtual; abstract;
261     function CreateBlob: IBlob; virtual; abstract;
262     function GetArrayMetaData: IArrayMetaData; virtual; abstract;
263     function GetBlobMetaData: IBlobMetaData; virtual; abstract;
264     procedure Initialize; virtual;
265    
266     public
267 tony 56 property AliasName: AnsiString read GetAliasName;
268     property FieldName: AnsiString read GetFieldName;
269     property OwnerName: AnsiString read GetOwnerName;
270     property RelationName: AnsiString read GetRelationName;
271 tony 45 property Parent: TSQLDataArea read FParent;
272     property Index: integer read FIndex;
273 tony 56 property Name: AnsiString read FName write SetName;
274 tony 45 property CharSetID: cardinal read GetCharSetID write SetCharSetID;
275     property SQLType: cardinal read GetSQLType write SetSQLType;
276     property SQLSubtype: integer read GetSubtype;
277 tony 56 property SQLData: PByte read GetSQLData;
278 tony 45 property DataLength: cardinal read GetDataLength write SetDataLength;
279     property IsNull: Boolean read GetIsNull write SetIsNull;
280     property IsNullable: Boolean read GetIsNullable write SetIsNullable;
281     property Scale: integer read GetScale write SetScale;
282     public
283     property Modified: Boolean read FModified;
284     property Statement: IStatement read GetStatement;
285     property UniqueName: boolean read FUniqueName write FUniqueName;
286     end;
287    
288     { TColumnMetaData }
289    
290     TColumnMetaData = class(TSQLDataItem,IColumnMetaData)
291     private
292     FIBXSQLVAR: TSQLVarData;
293     FOwner: IUnknown; {Keep reference to ensure Metadata/statement not discarded}
294     FPrepareSeqNo: integer;
295     FStatement: IStatement;
296     FChangeSeqNo: integer;
297     protected
298     procedure CheckActive; override;
299 tony 56 function SQLData: PByte; override;
300 tony 45 function GetDataLength: cardinal; override;
301     function GetCodePage: TSystemCodePage; override;
302    
303     public
304     constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
305     destructor Destroy; override;
306     function GetSQLDialect: integer; override;
307     property Statement: IStatement read FStatement;
308    
309     public
310     {IColumnMetaData}
311     function GetIndex: integer;
312     function GetSQLType: cardinal; override;
313     function getSubtype: integer;
314 tony 56 function getRelationName: AnsiString;
315     function getOwnerName: AnsiString;
316     function getSQLName: AnsiString; {Name of the column}
317     function getAliasName: AnsiString; {Alias Name of column or Column Name if not alias}
318     function GetName: AnsiString; override; {Disambiguated uppercase Field Name}
319 tony 45 function GetScale: integer; override;
320 tony 47 function getCharSetID: cardinal; override;
321 tony 45 function GetIsNullable: boolean; override;
322     function GetSize: cardinal;
323     function GetArrayMetaData: IArrayMetaData;
324     function GetBlobMetaData: IBlobMetaData;
325 tony 56 property Name: AnsiString read GetName;
326 tony 45 property Size: cardinal read GetSize;
327     property CharSetID: cardinal read getCharSetID;
328     property SQLSubtype: integer read getSubtype;
329     property IsNullable: Boolean read GetIsNullable;
330     end;
331    
332     { TIBSQLData }
333    
334     TIBSQLData = class(TColumnMetaData,ISQLData)
335     protected
336     procedure CheckActive; override;
337     public
338     function GetIsNull: Boolean; override;
339     function GetAsArray: IArray;
340     function GetAsBlob: IBlob; overload;
341     function GetAsBlob(BPB: IBPB): IBlob; overload;
342 tony 56 function GetAsString: AnsiString; override;
343 tony 45 property AsBlob: IBlob read GetAsBlob;
344     end;
345    
346     { TSQLParam }
347    
348     TSQLParam = class(TIBSQLData,ISQLParam)
349     protected
350     procedure CheckActive; override;
351     procedure Changed; override;
352 tony 56 procedure InternalSetAsString(Value: AnsiString); override;
353 tony 45 procedure SetScale(aValue: integer); override;
354     procedure SetDataLength(len: cardinal); override;
355     procedure SetSQLType(aValue: cardinal); override;
356     public
357     procedure Clear;
358     function GetModified: boolean; override;
359     function GetAsPointer: Pointer;
360 tony 56 procedure SetName(Value: AnsiString); override;
361 tony 45 procedure SetIsNull(Value: Boolean); override;
362     procedure SetIsNullable(Value: Boolean); override;
363     procedure SetAsArray(anArray: IArray);
364    
365     {overrides}
366     procedure SetAsBoolean(AValue: boolean);
367     procedure SetAsCurrency(AValue: Currency);
368     procedure SetAsInt64(AValue: Int64);
369     procedure SetAsDate(AValue: TDateTime);
370     procedure SetAsLong(AValue: Long);
371     procedure SetAsTime(AValue: TDateTime);
372     procedure SetAsDateTime(AValue: TDateTime);
373     procedure SetAsDouble(AValue: Double);
374     procedure SetAsFloat(AValue: Float);
375     procedure SetAsPointer(AValue: Pointer);
376     procedure SetAsShort(AValue: Short);
377 tony 56 procedure SetAsString(AValue: AnsiString); override;
378 tony 45 procedure SetAsVariant(AValue: Variant);
379     procedure SetAsBlob(aValue: IBlob);
380     procedure SetAsQuad(AValue: TISC_QUAD);
381     procedure SetCharSetID(aValue: cardinal);
382    
383     property AsBlob: IBlob read GetAsBlob write SetAsBlob;
384     property IsNullable: Boolean read GetIsNullable write SetIsNullable;
385     end;
386    
387     { TMetaData }
388    
389     TMetaData = class(TInterfaceOwner,IMetaData)
390     private
391     FPrepareSeqNo: integer;
392     FMetaData: TSQLDataArea;
393     FStatement: IStatement; {ensure FStatement not destroyed until no longer needed}
394     procedure CheckActive;
395     public
396     constructor Create(aMetaData: TSQLDataArea);
397     destructor Destroy; override;
398     public
399     {IMetaData}
400 tony 56 function GetUniqueRelationName: AnsiString;
401 tony 45 function getCount: integer;
402     function getColumnMetaData(index: integer): IColumnMetaData;
403 tony 56 function ByName(Idx: AnsiString): IColumnMetaData;
404 tony 45 end;
405    
406     { TSQLParams }
407    
408     TSQLParams = class(TInterfaceOwner,ISQLParams)
409     private
410     FPrepareSeqNo: integer;
411     FChangeSeqNo: integer;
412     FSQLParams: TSQLDataArea;
413     FStatement: IStatement; {ensure FStatement not destroyed until no longer needed}
414     procedure CheckActive;
415     public
416     constructor Create(aSQLParams: TSQLDataArea);
417     destructor Destroy; override;
418     public
419     {ISQLParams}
420     function getCount: integer;
421     function getSQLParam(index: integer): ISQLParam;
422 tony 56 function ByName(Idx: AnsiString): ISQLParam ;
423 tony 45 function GetModified: Boolean;
424     end;
425    
426     { TResults }
427    
428     TResults = class(TInterfaceOwner,IResults)
429     private
430     FPrepareSeqNo: integer;
431     FTransactionSeqNo: integer;
432     FChangeSeqNo: integer;
433     FResults: TSQLDataArea;
434     FStatement: IStatement; {ensure FStatement not destroyed until no longer needed}
435     function GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
436     protected
437     procedure CheckActive;
438     public
439     constructor Create(aResults: TSQLDataArea);
440     {IResults}
441     function getCount: integer;
442 tony 56 function ByName(Idx: AnsiString): ISQLData;
443 tony 45 function getSQLData(index: integer): ISQLData;
444 tony 56 procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
445 tony 45 function GetTransaction: ITransaction; virtual;
446     procedure SetRetainInterfaces(aValue: boolean);
447     end;
448    
449     implementation
450    
451 tony 270 uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
452 tony 45
453     { TSQLDataArea }
454    
455     function TSQLDataArea.GetColumn(index: integer): TSQLVarData;
456     begin
457     if (index < 0) or (index >= Count) then
458     IBError(ibxeInvalidColumnIndex,[nil]);
459     Result := FColumnList[index];
460     end;
461    
462     function TSQLDataArea.GetCount: integer;
463     begin
464     Result := Length(FColumnList);
465     end;
466    
467     procedure TSQLDataArea.SetUniqueRelationName;
468     var
469     i: Integer;
470     bUnique: Boolean;
471 tony 56 RelationName: AnsiString;
472 tony 45 begin
473     bUnique := True;
474     for i := 0 to ColumnsInUseCount - 1 do
475     begin
476     RelationName := Column[i].RelationName;
477    
478     {First get the unique relation name, if any}
479    
480     if bUnique and (RelationName <> '') then
481     begin
482     if FUniqueRelationName = '' then
483     FUniqueRelationName := RelationName
484     else
485     if RelationName <> FUniqueRelationName then
486     begin
487     FUniqueRelationName := '';
488     bUnique := False;
489     end;
490     end;
491     end;
492     end;
493    
494     procedure TSQLDataArea.Initialize;
495     var
496     i: Integer;
497     begin
498     for i := 0 to ColumnsInUseCount - 1 do
499     Column[i].Initialize;
500     end;
501    
502 tony 56 procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
503     var sProcessedSQL: AnsiString);
504 tony 45
505 tony 263 var slNames: TStrings;
506 tony 45
507 tony 263 procedure SetColumnNames(slNames: TStrings);
508     var i, j: integer;
509     found: boolean;
510 tony 45 begin
511 tony 263 found := false;
512 tony 45 SetCount(slNames.Count);
513     for i := 0 to slNames.Count - 1 do
514     begin
515     Column[i].Name := slNames[i];
516     Column[i].UniqueName := (slNames.Objects[i] <> nil);
517     end;
518     for i := 0 to Count - 1 do
519     begin
520     if not Column[i].UniqueName then
521     begin
522     found := false;
523     for j := i + 1 to Count - 1 do
524     if Column[i].Name = Column[j].Name then
525     begin
526     found := true;
527     break;
528     end;
529     Column[i].UniqueName := not found;
530     end;
531     end;
532 tony 263 end;
533    
534     begin
535     if not IsInputDataArea then
536     IBError(ibxeNotPermitted,[nil]);
537    
538     slNames := TStringList.Create;
539     try
540     sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
541     SetColumnNames(slNames);
542 tony 45 finally
543     slNames.Free;
544     end;
545     end;
546    
547     function TSQLDataArea.ColumnsInUseCount: integer;
548     begin
549     Result := Count;
550     end;
551    
552 tony 56 function TSQLDataArea.ColumnByName(Idx: AnsiString): TSQLVarData;
553 tony 45 var
554 tony 56 s: AnsiString;
555 tony 45 i: Integer;
556     begin
557 tony 270 if not IsInputDataArea or not CaseSensitiveParams then
558     s := AnsiUpperCase(Idx)
559     else
560 tony 45 s := Idx;
561 tony 270
562 tony 45 for i := 0 to Count - 1 do
563     if Column[i].Name = s then
564     begin
565     Result := Column[i];
566     Exit;
567     end;
568     Result := nil;
569     end;
570    
571     procedure TSQLDataArea.GetData(index: integer; var IsNull: boolean;
572 tony 56 var len: short; var data: PByte);
573 tony 45 begin
574     //Do Nothing
575     end;
576    
577     procedure TSQLDataArea.RowChange;
578     var i: integer;
579     begin
580     for i := 0 to Count - 1 do
581     Column[i].RowChange;
582     end;
583    
584     {TSQLVarData}
585    
586     function TSQLVarData.GetStatement: IStatement;
587     begin
588     Result := FParent.Statement;
589     end;
590    
591 tony 56 procedure TSQLVarData.SetName(AValue: AnsiString);
592 tony 45 begin
593 tony 270 if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
594 tony 45 FName := AnsiUpperCase(AValue)
595     else
596     FName := AValue;
597     end;
598    
599     constructor TSQLVarData.Create(aParent: TSQLDataArea; aIndex: integer);
600     begin
601     inherited Create;
602     FParent := aParent;
603     FIndex := aIndex;
604     FUniqueName := true;
605     end;
606    
607 tony 56 procedure TSQLVarData.SetString(aValue: AnsiString);
608 tony 45 begin
609     {we take full advantage here of reference counted strings. When setting a string
610     value, a reference is kept in FVarString and a pointer to it placed in the
611 tony 56 SQLVar. This avoids string copies. Note that PAnsiChar is guaranteed to point to
612 tony 45 a zero byte when the string is empty, neatly avoiding a nil pointer error.}
613    
614     FVarString := aValue;
615     SQLType := SQL_TEXT;
616 tony 270 Scale := 0;
617 tony 56 SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
618 tony 45 end;
619    
620     procedure TSQLVarData.Changed;
621     begin
622     FModified := true;
623     end;
624    
625     procedure TSQLVarData.RowChange;
626     begin
627     FModified := false;
628     FVarString := '';
629     end;
630    
631     procedure TSQLVarData.Initialize;
632    
633 tony 56 function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
634 tony 45 var
635     k: integer;
636     begin
637     for k := 0 to limit do
638     if Parent.Column[k].Name = idx then
639     begin
640     Result := Parent.Column[k];
641     Exit;
642     end;
643     Result := nil;
644     end;
645    
646     var
647     j, j_len: Integer;
648 tony 56 st: AnsiString;
649     sBaseName: AnsiString;
650 tony 45 begin
651     RowChange;
652    
653     {If an output SQLDA then copy the aliasname to the FName. Ensure
654     that they are all upper case only and disambiguated.
655     }
656    
657     if not Parent.IsInputDataArea then
658     begin
659     st := Space2Underscore(AnsiUppercase(AliasName));
660     if st = '' then
661     begin
662     sBaseName := 'F_'; {do not localize}
663     j := 1; j_len := 1;
664     st := sBaseName + IntToStr(j);
665     end
666     else
667     begin
668     j := 0; j_len := 0;
669     sBaseName := st;
670     end;
671    
672     {Look for other columns with the same name and make unique}
673    
674     while FindVarByName(st,Index-1) <> nil do
675     begin
676     Inc(j);
677     j_len := Length(IntToStr(j));
678     if j_len + Length(sBaseName) > 31 then
679     st := system.Copy(sBaseName, 1, 31 - j_len) + IntToStr(j)
680     else
681     st := sBaseName + IntToStr(j);
682     end;
683    
684     Name := st;
685     end;
686     end;
687    
688     {TSQLDataItem}
689    
690     function TSQLDataItem.AdjustScale(Value: Int64; aScale: Integer): Double;
691     var
692     Scaling : Int64;
693     i: Integer;
694     Val: Double;
695     begin
696     Scaling := 1; Val := Value;
697     if aScale > 0 then
698     begin
699     for i := 1 to aScale do
700     Scaling := Scaling * 10;
701     result := Val * Scaling;
702     end
703     else
704     if aScale < 0 then
705     begin
706     for i := -1 downto aScale do
707     Scaling := Scaling * 10;
708     result := Val / Scaling;
709     end
710     else
711     result := Val;
712     end;
713    
714     function TSQLDataItem.AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
715     var
716     Scaling : Int64;
717     i: Integer;
718     Val: Int64;
719     begin
720     Scaling := 1; Val := Value;
721     if aScale > 0 then begin
722     for i := 1 to aScale do Scaling := Scaling * 10;
723     result := Val * Scaling;
724     end else if aScale < 0 then begin
725     for i := -1 downto aScale do Scaling := Scaling * 10;
726     result := Val div Scaling;
727     end else
728     result := Val;
729     end;
730    
731     function TSQLDataItem.AdjustScaleToCurrency(Value: Int64; aScale: Integer
732     ): Currency;
733     var
734     Scaling : Int64;
735     i : Integer;
736 tony 56 FractionText, PadText, CurrText: AnsiString;
737 tony 45 begin
738     Result := 0;
739     Scaling := 1;
740     PadText := '';
741     if aScale > 0 then
742     begin
743     for i := 1 to aScale do
744     Scaling := Scaling * 10;
745     result := Value * Scaling;
746     end
747     else
748     if aScale < 0 then
749     begin
750     for i := -1 downto aScale do
751     Scaling := Scaling * 10;
752     FractionText := IntToStr(abs(Value mod Scaling));
753     for i := Length(FractionText) to -aScale -1 do
754     PadText := '0' + PadText;
755 tony 56 {$IF declared(DefaultFormatSettings)}
756     with DefaultFormatSettings do
757     {$ELSE}
758     {$IF declared(FormatSettings)}
759     with FormatSettings do
760     {$IFEND}
761     {$IFEND}
762 tony 45 if Value < 0 then
763 tony 56 CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
764 tony 45 else
765 tony 56 CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
766 tony 45 try
767     result := StrToCurr(CurrText);
768     except
769     on E: Exception do
770     IBError(ibxeInvalidDataConversion, [nil]);
771     end;
772     end
773     else
774     result := Value;
775     end;
776    
777 tony 270 function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
778     begin
779     {$IF declared(DefaultFormatSettings)}
780     with DefaultFormatSettings do
781     {$ELSE}
782     {$IF declared(FormatSettings)}
783     with FormatSettings do
784     {$IFEND}
785     {$IFEND}
786     case GetSQLDialect of
787     1:
788     if IncludeTime then
789     result := ShortDateFormat + ' ' + LongTimeFormat
790     else
791     result := ShortDateFormat;
792     3:
793     result := ShortDateFormat;
794     end;
795     end;
796    
797     function TSQLDataItem.GetTimeFormatStr: AnsiString;
798     begin
799     {$IF declared(DefaultFormatSettings)}
800     with DefaultFormatSettings do
801     {$ELSE}
802     {$IF declared(FormatSettings)}
803     with FormatSettings do
804     {$IFEND}
805     {$IFEND}
806     Result := LongTimeFormat;
807     end;
808    
809     function TSQLDataItem.GetTimestampFormatStr: AnsiString;
810     begin
811     {$IF declared(DefaultFormatSettings)}
812     with DefaultFormatSettings do
813     {$ELSE}
814     {$IF declared(FormatSettings)}
815     with FormatSettings do
816     {$IFEND}
817     {$IFEND}
818     Result := ShortDateFormat + ' ' + LongTimeFormat + '.zzz';
819     end;
820    
821 tony 45 procedure TSQLDataItem.SetAsInteger(AValue: Integer);
822     begin
823     SetAsLong(aValue);
824     end;
825    
826     function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
827     ): Int64;
828     var
829     Scaling : Int64;
830     i : Integer;
831     begin
832     Result := 0;
833     Scaling := 1;
834     if aScale < 0 then
835     begin
836     for i := -1 downto aScale do
837     Scaling := Scaling * 10;
838     result := trunc(Value * Scaling);
839     end
840     else
841     if aScale > 0 then
842     begin
843     for i := 1 to aScale do
844     Scaling := Scaling * 10;
845     result := trunc(Value / Scaling);
846     end
847     else
848     result := trunc(Value);
849     end;
850    
851     function TSQLDataItem.AdjustScaleFromDouble(Value: Double; aScale: Integer
852     ): Int64;
853     var
854     Scaling : Int64;
855     i : Integer;
856     begin
857     Result := 0;
858     Scaling := 1;
859     if aScale < 0 then
860     begin
861     for i := -1 downto aScale do
862     Scaling := Scaling * 10;
863     result := trunc(Value * Scaling);
864     end
865     else
866     if aScale > 0 then
867     begin
868     for i := 1 to aScale do
869     Scaling := Scaling * 10;
870     result := trunc(Value / Scaling);
871     end
872     else
873     result := trunc(Value);
874     end;
875    
876     procedure TSQLDataItem.CheckActive;
877     begin
878     //Do nothing by default
879     end;
880    
881     procedure TSQLDataItem.Changed;
882     begin
883     //Do nothing by default
884     end;
885    
886     procedure TSQLDataItem.Changing;
887     begin
888     //Do nothing by default
889     end;
890    
891 tony 56 procedure TSQLDataItem.InternalSetAsString(Value: AnsiString);
892 tony 45 begin
893     //Do nothing by default
894     end;
895    
896 tony 56 function TSQLDataItem.Transliterate(s: AnsiString; CodePage: TSystemCodePage
897 tony 45 ): RawByteString;
898     begin
899     Result := s;
900     if StringCodePage(Result) <> CodePage then
901     SetCodePage(Result,CodePage,CodePage <> CP_NONE);
902     end;
903    
904     procedure TSQLDataItem.SetScale(aValue: integer);
905     begin
906     //Do nothing by default
907     end;
908    
909     procedure TSQLDataItem.SetDataLength(len: cardinal);
910     begin
911     //Do nothing by default
912     end;
913    
914     procedure TSQLDataItem.SetSQLType(aValue: cardinal);
915     begin
916     //Do nothing by default
917     end;
918    
919 tony 263 constructor TSQLDataItem.Create(api: TFBClientAPI);
920     begin
921     inherited Create;
922     FFirebirdClientAPI := api;
923     end;
924    
925 tony 56 function TSQLDataItem.GetSQLTypeName: AnsiString;
926 tony 45 begin
927     Result := GetSQLTypeName(GetSQLType);
928     end;
929    
930 tony 56 class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
931 tony 45 begin
932     Result := 'Unknown';
933     case SQLType of
934     SQL_VARYING: Result := 'SQL_VARYING';
935     SQL_TEXT: Result := 'SQL_TEXT';
936     SQL_DOUBLE: Result := 'SQL_DOUBLE';
937     SQL_FLOAT: Result := 'SQL_FLOAT';
938     SQL_LONG: Result := 'SQL_LONG';
939     SQL_SHORT: Result := 'SQL_SHORT';
940     SQL_TIMESTAMP: Result := 'SQL_TIMESTAMP';
941     SQL_BLOB: Result := 'SQL_BLOB';
942     SQL_D_FLOAT: Result := 'SQL_D_FLOAT';
943     SQL_ARRAY: Result := 'SQL_ARRAY';
944     SQL_QUAD: Result := 'SQL_QUAD';
945     SQL_TYPE_TIME: Result := 'SQL_TYPE_TIME';
946     SQL_TYPE_DATE: Result := 'SQL_TYPE_DATE';
947     SQL_INT64: Result := 'SQL_INT64';
948     end;
949     end;
950    
951     function TSQLDataItem.GetAsBoolean: boolean;
952     begin
953     CheckActive;
954     result := false;
955     if not IsNull then
956     begin
957     if SQLType = SQL_BOOLEAN then
958     result := PByte(SQLData)^ = ISC_TRUE
959     else
960     IBError(ibxeInvalidDataConversion, [nil]);
961     end
962     end;
963    
964     function TSQLDataItem.GetAsCurrency: Currency;
965     begin
966     CheckActive;
967     result := 0;
968     if GetSQLDialect < 3 then
969     result := GetAsDouble
970     else begin
971     if not IsNull then
972     case SQLType of
973     SQL_TEXT, SQL_VARYING: begin
974     try
975     result := StrtoCurr(AsString);
976     except
977     on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
978     end;
979     end;
980     SQL_SHORT:
981     result := AdjustScaleToCurrency(Int64(PShort(SQLData)^),
982     Scale);
983     SQL_LONG:
984     result := AdjustScaleToCurrency(Int64(PLong(SQLData)^),
985     Scale);
986     SQL_INT64:
987     result := AdjustScaleToCurrency(PInt64(SQLData)^,
988     Scale);
989     SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
990     result := Trunc(AsDouble);
991     else
992     IBError(ibxeInvalidDataConversion, [nil]);
993     end;
994     end;
995     end;
996    
997     function TSQLDataItem.GetAsInt64: Int64;
998     begin
999     CheckActive;
1000     result := 0;
1001     if not IsNull then
1002     case SQLType of
1003     SQL_TEXT, SQL_VARYING: begin
1004     try
1005     result := StrToInt64(AsString);
1006     except
1007     on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
1008     end;
1009     end;
1010     SQL_SHORT:
1011     result := AdjustScaleToInt64(Int64(PShort(SQLData)^),
1012     Scale);
1013     SQL_LONG:
1014     result := AdjustScaleToInt64(Int64(PLong(SQLData)^),
1015     Scale);
1016     SQL_INT64:
1017     result := AdjustScaleToInt64(PInt64(SQLData)^,
1018     Scale);
1019     SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1020     result := Trunc(AsDouble);
1021     else
1022     IBError(ibxeInvalidDataConversion, [nil]);
1023     end;
1024     end;
1025    
1026     function TSQLDataItem.GetAsDateTime: TDateTime;
1027     begin
1028     CheckActive;
1029     result := 0;
1030     if not IsNull then
1031 tony 263 with FFirebirdClientAPI do
1032 tony 45 case SQLType of
1033     SQL_TEXT, SQL_VARYING: begin
1034     try
1035     result := StrToDate(AsString);
1036     except
1037     on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]);
1038     end;
1039     end;
1040     SQL_TYPE_DATE:
1041     result := SQLDecodeDate(SQLData);
1042     SQL_TYPE_TIME:
1043     result := SQLDecodeTime(SQLData);
1044     SQL_TIMESTAMP:
1045     result := SQLDecodeDateTime(SQLData);
1046     else
1047     IBError(ibxeInvalidDataConversion, [nil]);
1048     end;
1049     end;
1050    
1051     function TSQLDataItem.GetAsDouble: Double;
1052     begin
1053     CheckActive;
1054     result := 0;
1055     if not IsNull then begin
1056     case SQLType of
1057     SQL_TEXT, SQL_VARYING: begin
1058     try
1059     result := StrToFloat(AsString);
1060     except
1061     on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
1062     end;
1063     end;
1064     SQL_SHORT:
1065     result := AdjustScale(Int64(PShort(SQLData)^),
1066     Scale);
1067     SQL_LONG:
1068     result := AdjustScale(Int64(PLong(SQLData)^),
1069     Scale);
1070     SQL_INT64:
1071     result := AdjustScale(PInt64(SQLData)^, Scale);
1072     SQL_FLOAT:
1073     result := PFloat(SQLData)^;
1074     SQL_DOUBLE, SQL_D_FLOAT:
1075     result := PDouble(SQLData)^;
1076     else
1077     IBError(ibxeInvalidDataConversion, [nil]);
1078     end;
1079     if Scale <> 0 then
1080     result :=
1081     StrToFloat(FloatToStrF(result, fffixed, 15,
1082     Abs(Scale) ));
1083     end;
1084     end;
1085    
1086     function TSQLDataItem.GetAsFloat: Float;
1087     begin
1088     CheckActive;
1089     result := 0;
1090     try
1091     result := AsDouble;
1092     except
1093     on E: EOverflow do
1094     IBError(ibxeInvalidDataConversion, [nil]);
1095     end;
1096     end;
1097    
1098     function TSQLDataItem.GetAsLong: Long;
1099     begin
1100     CheckActive;
1101     result := 0;
1102     if not IsNull then
1103     case SQLType of
1104     SQL_TEXT, SQL_VARYING: begin
1105     try
1106     result := StrToInt(AsString);
1107     except
1108     on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
1109     end;
1110     end;
1111     SQL_SHORT:
1112     result := Trunc(AdjustScale(Int64(PShort(SQLData)^),
1113     Scale));
1114     SQL_LONG:
1115     result := Trunc(AdjustScale(Int64(PLong(SQLData)^),
1116     Scale));
1117     SQL_INT64:
1118     result := Trunc(AdjustScale(PInt64(SQLData)^, Scale));
1119     SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1120     result := Trunc(AsDouble);
1121     else
1122     IBError(ibxeInvalidDataConversion, [nil]);
1123     end;
1124     end;
1125    
1126     function TSQLDataItem.GetAsPointer: Pointer;
1127     begin
1128     CheckActive;
1129     if not IsNull then
1130     result := SQLData
1131     else
1132     result := nil;
1133     end;
1134    
1135     function TSQLDataItem.GetAsQuad: TISC_QUAD;
1136     begin
1137     CheckActive;
1138     result.gds_quad_high := 0;
1139     result.gds_quad_low := 0;
1140     if not IsNull then
1141     case SQLType of
1142     SQL_BLOB, SQL_ARRAY, SQL_QUAD:
1143     result := PISC_QUAD(SQLData)^;
1144     else
1145     IBError(ibxeInvalidDataConversion, [nil]);
1146     end;
1147     end;
1148    
1149     function TSQLDataItem.GetAsShort: short;
1150     begin
1151     CheckActive;
1152     result := 0;
1153     try
1154     result := AsLong;
1155     except
1156     on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
1157     end;
1158     end;
1159    
1160    
1161 tony 56 function TSQLDataItem.GetAsString: AnsiString;
1162 tony 45 var
1163 tony 56 sz: PByte;
1164 tony 45 str_len: Integer;
1165     rs: RawByteString;
1166     begin
1167     CheckActive;
1168     result := '';
1169     { Check null, if so return a default string }
1170     if not IsNull then
1171 tony 263 with FFirebirdClientAPI do
1172 tony 45 case SQLType of
1173     SQL_BOOLEAN:
1174     if AsBoolean then
1175     Result := sTrue
1176     else
1177     Result := SFalse;
1178    
1179     SQL_TEXT, SQL_VARYING:
1180     begin
1181     sz := SQLData;
1182     if (SQLType = SQL_TEXT) then
1183     str_len := DataLength
1184     else begin
1185     str_len := DecodeInteger(SQLData, 2);
1186     Inc(sz, 2);
1187     end;
1188 tony 56 SetString(rs, PAnsiChar(sz), str_len);
1189 tony 45 SetCodePage(rs,GetCodePage,false);
1190 tony 47 if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1191     Result := TrimRight(rs)
1192     else
1193     Result := rs
1194 tony 45 end;
1195     SQL_TYPE_DATE:
1196 tony 270 result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1197 tony 45 SQL_TYPE_TIME :
1198 tony 270 result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1199 tony 45 SQL_TIMESTAMP:
1200 tony 270 result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1201 tony 45 SQL_SHORT, SQL_LONG:
1202     if Scale = 0 then
1203     result := IntToStr(AsLong)
1204     else if Scale >= (-4) then
1205     result := CurrToStr(AsCurrency)
1206     else
1207     result := FloatToStr(AsDouble);
1208     SQL_INT64:
1209     if Scale = 0 then
1210     result := IntToStr(AsInt64)
1211     else if Scale >= (-4) then
1212     result := CurrToStr(AsCurrency)
1213     else
1214     result := FloatToStr(AsDouble);
1215     SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1216     result := FloatToStr(AsDouble);
1217     else
1218     IBError(ibxeInvalidDataConversion, [nil]);
1219     end;
1220     end;
1221    
1222     function TSQLDataItem.GetIsNull: Boolean;
1223     begin
1224     CheckActive;
1225     Result := false;
1226     end;
1227    
1228 tony 270 function TSQLDataItem.GetIsNullable: boolean;
1229 tony 45 begin
1230     CheckActive;
1231     Result := false;
1232     end;
1233    
1234     function TSQLDataItem.GetAsVariant: Variant;
1235     begin
1236     CheckActive;
1237     if IsNull then
1238     result := NULL
1239     { Check null, if so return a default string }
1240     else case SQLType of
1241     SQL_ARRAY:
1242     result := '(Array)'; {do not localize}
1243     SQL_BLOB,
1244     SQL_TEXT, SQL_VARYING:
1245     result := AsString;
1246     SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
1247     result := AsDateTime;
1248     SQL_SHORT, SQL_LONG:
1249     if Scale = 0 then
1250     result := AsLong
1251     else if Scale >= (-4) then
1252     result := AsCurrency
1253     else
1254     result := AsDouble;
1255     SQL_INT64:
1256     if Scale = 0 then
1257     result := AsInt64
1258     else if Scale >= (-4) then
1259     result := AsCurrency
1260     else
1261     result := AsDouble;
1262     SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1263     result := AsDouble;
1264     SQL_BOOLEAN:
1265     result := AsBoolean;
1266     else
1267     IBError(ibxeInvalidDataConversion, [nil]);
1268     end;
1269     end;
1270    
1271     function TSQLDataItem.GetModified: boolean;
1272     begin
1273     Result := false;
1274     end;
1275    
1276 tony 270 function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
1277     ): integer;
1278     begin
1279     case DateTimeFormat of
1280     dfTimestamp:
1281     Result := Length(GetTimestampFormatStr);
1282     dfDateTime:
1283     Result := Length(GetDateFormatStr(true));
1284     dfTime:
1285     Result := Length(GetTimeFormatStr);
1286     else
1287     Result := 0;
1288     end;
1289     end;
1290 tony 45
1291 tony 270
1292 tony 45 procedure TSQLDataItem.SetIsNull(Value: Boolean);
1293     begin
1294     //ignore unless overridden
1295     end;
1296    
1297     procedure TSQLDataItem.SetIsNullable(Value: Boolean);
1298     begin
1299     //ignore unless overridden
1300     end;
1301    
1302 tony 56 procedure TSQLDataItem.SetName(aValue: AnsiString);
1303 tony 45 begin
1304     //ignore unless overridden
1305     end;
1306    
1307     procedure TSQLDataItem.SetAsCurrency(Value: Currency);
1308     begin
1309     CheckActive;
1310     if GetSQLDialect < 3 then
1311     AsDouble := Value
1312     else
1313     begin
1314     Changing;
1315     if IsNullable then
1316     IsNull := False;
1317     SQLType := SQL_INT64;
1318     Scale := -4;
1319     DataLength := SizeOf(Int64);
1320     PCurrency(SQLData)^ := Value;
1321     Changed;
1322     end;
1323     end;
1324    
1325     procedure TSQLDataItem.SetAsInt64(Value: Int64);
1326     begin
1327     CheckActive;
1328     Changing;
1329     if IsNullable then
1330     IsNull := False;
1331    
1332     SQLType := SQL_INT64;
1333     Scale := 0;
1334     DataLength := SizeOf(Int64);
1335     PInt64(SQLData)^ := Value;
1336     Changed;
1337     end;
1338    
1339     procedure TSQLDataItem.SetAsDate(Value: TDateTime);
1340     begin
1341     CheckActive;
1342     if GetSQLDialect < 3 then
1343     begin
1344     AsDateTime := Value;
1345     exit;
1346     end;
1347    
1348     Changing;
1349     if IsNullable then
1350     IsNull := False;
1351    
1352     SQLType := SQL_TYPE_DATE;
1353     DataLength := SizeOf(ISC_DATE);
1354 tony 263 with FFirebirdClientAPI do
1355 tony 45 SQLEncodeDate(Value,SQLData);
1356     Changed;
1357     end;
1358    
1359     procedure TSQLDataItem.SetAsTime(Value: TDateTime);
1360     begin
1361     CheckActive;
1362     if GetSQLDialect < 3 then
1363     begin
1364     AsDateTime := Value;
1365     exit;
1366     end;
1367    
1368     Changing;
1369     if IsNullable then
1370     IsNull := False;
1371    
1372     SQLType := SQL_TYPE_TIME;
1373     DataLength := SizeOf(ISC_TIME);
1374 tony 263 with FFirebirdClientAPI do
1375 tony 45 SQLEncodeTime(Value,SQLData);
1376     Changed;
1377     end;
1378    
1379     procedure TSQLDataItem.SetAsDateTime(Value: TDateTime);
1380     begin
1381     CheckActive;
1382     if IsNullable then
1383     IsNull := False;
1384    
1385     Changing;
1386     SQLType := SQL_TIMESTAMP;
1387 tony 47 DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1388 tony 263 with FFirebirdClientAPI do
1389 tony 45 SQLEncodeDateTime(Value,SQLData);
1390     Changed;
1391     end;
1392    
1393     procedure TSQLDataItem.SetAsDouble(Value: Double);
1394     begin
1395     CheckActive;
1396     if IsNullable then
1397     IsNull := False;
1398    
1399     Changing;
1400     SQLType := SQL_DOUBLE;
1401     DataLength := SizeOf(Double);
1402     Scale := 0;
1403     PDouble(SQLData)^ := Value;
1404     Changed;
1405     end;
1406    
1407     procedure TSQLDataItem.SetAsFloat(Value: Float);
1408     begin
1409     CheckActive;
1410     if IsNullable then
1411     IsNull := False;
1412    
1413     Changing;
1414     SQLType := SQL_FLOAT;
1415     DataLength := SizeOf(Float);
1416     Scale := 0;
1417     PSingle(SQLData)^ := Value;
1418     Changed;
1419     end;
1420    
1421     procedure TSQLDataItem.SetAsLong(Value: Long);
1422     begin
1423     CheckActive;
1424     if IsNullable then
1425     IsNull := False;
1426    
1427     Changing;
1428     SQLType := SQL_LONG;
1429     DataLength := SizeOf(Long);
1430     Scale := 0;
1431     PLong(SQLData)^ := Value;
1432     Changed;
1433     end;
1434    
1435     procedure TSQLDataItem.SetAsPointer(Value: Pointer);
1436     begin
1437     CheckActive;
1438     Changing;
1439     if IsNullable and (Value = nil) then
1440     IsNull := True
1441     else
1442     begin
1443     IsNull := False;
1444     SQLType := SQL_TEXT;
1445     Move(Value^, SQLData^, DataLength);
1446     end;
1447     Changed;
1448     end;
1449    
1450     procedure TSQLDataItem.SetAsQuad(Value: TISC_QUAD);
1451     begin
1452     CheckActive;
1453     Changing;
1454     if IsNullable then
1455     IsNull := False;
1456     if (SQLType <> SQL_BLOB) and
1457     (SQLType <> SQL_ARRAY) then
1458     IBError(ibxeInvalidDataConversion, [nil]);
1459     DataLength := SizeOf(TISC_QUAD);
1460     PISC_QUAD(SQLData)^ := Value;
1461     Changed;
1462     end;
1463    
1464     procedure TSQLDataItem.SetAsShort(Value: short);
1465     begin
1466     CheckActive;
1467     Changing;
1468     if IsNullable then
1469     IsNull := False;
1470    
1471     SQLType := SQL_SHORT;
1472     DataLength := SizeOf(Short);
1473     Scale := 0;
1474     PShort(SQLData)^ := Value;
1475     Changed;
1476     end;
1477    
1478 tony 56 procedure TSQLDataItem.SetAsString(Value: AnsiString);
1479 tony 45 begin
1480     InternalSetAsString(Value);
1481     end;
1482    
1483     procedure TSQLDataItem.SetAsVariant(Value: Variant);
1484     begin
1485     CheckActive;
1486     if VarIsNull(Value) then
1487     IsNull := True
1488     else case VarType(Value) of
1489     varEmpty, varNull:
1490     IsNull := True;
1491     varSmallint, varInteger, varByte,
1492     varWord, varShortInt:
1493     AsLong := Value;
1494     varInt64:
1495     AsInt64 := Value;
1496     varSingle, varDouble:
1497     AsDouble := Value;
1498     varCurrency:
1499     AsCurrency := Value;
1500     varBoolean:
1501     AsBoolean := Value;
1502     varDate:
1503     AsDateTime := Value;
1504     varOleStr, varString:
1505     AsString := Value;
1506     varArray:
1507     IBError(ibxeNotSupported, [nil]);
1508     varByRef, varDispatch, varError, varUnknown, varVariant:
1509     IBError(ibxeNotPermitted, [nil]);
1510     end;
1511     end;
1512    
1513 tony 59 procedure TSQLDataItem.SetAsNumeric(Value: Int64; aScale: integer);
1514     begin
1515     CheckActive;
1516     Changing;
1517     if IsNullable then
1518     IsNull := False;
1519    
1520     SQLType := SQL_INT64;
1521     Scale := aScale;
1522     DataLength := SizeOf(Int64);
1523     PInt64(SQLData)^ := Value;
1524     Changed;
1525     end;
1526    
1527 tony 45 procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
1528     begin
1529     CheckActive;
1530     Changing;
1531     if IsNullable then
1532     IsNull := False;
1533    
1534     SQLType := SQL_BOOLEAN;
1535     DataLength := 1;
1536     Scale := 0;
1537     if AValue then
1538     PByte(SQLData)^ := ISC_TRUE
1539     else
1540     PByte(SQLData)^ := ISC_FALSE;
1541     Changed;
1542     end;
1543    
1544     {TColumnMetaData}
1545    
1546     procedure TColumnMetaData.CheckActive;
1547     begin
1548     if not FIBXSQLVAR.Parent.StateChanged(FChangeSeqNo) then Exit;
1549    
1550     if FPrepareSeqNo < FIBXSQLVAR.Parent.GetPrepareSeqNo then
1551     IBError(ibxeInterfaceOutofDate,[nil]);
1552    
1553     if not FIBXSQLVAR.Parent.CheckStatementStatus(ssPrepared) then
1554     IBError(ibxeStatementNotPrepared, [nil]);
1555     end;
1556    
1557 tony 56 function TColumnMetaData.SQLData: PByte;
1558 tony 45 begin
1559     Result := FIBXSQLVAR.SQLData;
1560     end;
1561    
1562     function TColumnMetaData.GetDataLength: cardinal;
1563     begin
1564     Result := FIBXSQLVAR.DataLength;
1565     end;
1566    
1567     function TColumnMetaData.GetCodePage: TSystemCodePage;
1568     begin
1569     Result := FIBXSQLVAR.GetCodePage;
1570     end;
1571    
1572     constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
1573     begin
1574 tony 263 inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
1575 tony 45 FIBXSQLVAR := aIBXSQLVAR;
1576     FOwner := aOwner;
1577     FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
1578     FIBXSQLVAR.Parent.StateChanged(FChangeSeqNo)
1579     end;
1580    
1581     destructor TColumnMetaData.Destroy;
1582     begin
1583     (FOwner as TInterfaceOwner).Remove(self);
1584     inherited Destroy;
1585     end;
1586    
1587    
1588     function TColumnMetaData.GetSQLDialect: integer;
1589     begin
1590     Result := FIBXSQLVAR.Statement.GetSQLDialect;
1591     end;
1592    
1593     function TColumnMetaData.GetIndex: integer;
1594     begin
1595     Result := FIBXSQLVAR.Index;
1596     end;
1597    
1598     function TColumnMetaData.GetSQLType: cardinal;
1599     begin
1600     CheckActive;
1601     result := FIBXSQLVAR.SQLType;
1602     end;
1603    
1604     function TColumnMetaData.getSubtype: integer;
1605     begin
1606     CheckActive;
1607     result := FIBXSQLVAR.SQLSubtype;
1608     end;
1609    
1610 tony 56 function TColumnMetaData.getRelationName: AnsiString;
1611 tony 45 begin
1612     CheckActive;
1613     result := FIBXSQLVAR.RelationName;
1614     end;
1615    
1616 tony 56 function TColumnMetaData.getOwnerName: AnsiString;
1617 tony 45 begin
1618     CheckActive;
1619     result := FIBXSQLVAR.OwnerName;
1620     end;
1621    
1622 tony 56 function TColumnMetaData.getSQLName: AnsiString;
1623 tony 45 begin
1624     CheckActive;
1625     result := FIBXSQLVAR.FieldName;
1626     end;
1627    
1628 tony 56 function TColumnMetaData.getAliasName: AnsiString;
1629 tony 45 begin
1630     CheckActive;
1631     result := FIBXSQLVAR.AliasName;
1632     end;
1633    
1634 tony 56 function TColumnMetaData.GetName: AnsiString;
1635 tony 45 begin
1636     CheckActive;
1637     Result := FIBXSQLVAR. Name;
1638     end;
1639    
1640     function TColumnMetaData.GetScale: integer;
1641     begin
1642     CheckActive;
1643     result := FIBXSQLVAR.Scale;
1644     end;
1645    
1646     function TColumnMetaData.getCharSetID: cardinal;
1647     begin
1648     CheckActive;
1649     Result := FIBXSQLVAR.CharSetID;
1650     end;
1651    
1652     function TColumnMetaData.GetIsNullable: boolean;
1653     begin
1654     CheckActive;
1655     result := FIBXSQLVAR.IsNullable;
1656     end;
1657    
1658     function TColumnMetaData.GetSize: cardinal;
1659     begin
1660     CheckActive;
1661     result := FIBXSQLVAR.DataLength;
1662     end;
1663    
1664     function TColumnMetaData.GetArrayMetaData: IArrayMetaData;
1665     begin
1666     CheckActive;
1667     result := FIBXSQLVAR.GetArrayMetaData;
1668     end;
1669    
1670     function TColumnMetaData.GetBlobMetaData: IBlobMetaData;
1671     begin
1672     CheckActive;
1673     result := FIBXSQLVAR.GetBlobMetaData;
1674     end;
1675    
1676     { TIBSQLData }
1677    
1678     procedure TIBSQLData.CheckActive;
1679     begin
1680     if not FIBXSQLVAR.Parent.StateChanged(FChangeSeqNo) then Exit;
1681    
1682     inherited CheckActive;
1683    
1684     if not FIBXSQLVAR.Parent.CheckStatementStatus(ssCursorOpen) and
1685     not FIBXSQLVAR.Parent.CheckStatementStatus(ssExecuteResults) then
1686     IBError(ibxeSQLClosed, [nil]);
1687    
1688     if FIBXSQLVAR.Parent.CheckStatementStatus(ssEOF) then
1689     IBError(ibxeEOF,[nil]);
1690    
1691     if FIBXSQLVAR.Parent.CheckStatementStatus(ssBOF) then
1692     IBError(ibxeBOF,[nil]);
1693     end;
1694    
1695     function TIBSQLData.GetIsNull: Boolean;
1696     begin
1697     CheckActive;
1698     result := FIBXSQLVAR.IsNull;
1699     end;
1700    
1701     function TIBSQLData.GetAsArray: IArray;
1702     begin
1703     CheckActive;
1704     result := FIBXSQLVAR.GetAsArray(AsQuad);
1705     end;
1706    
1707     function TIBSQLData.GetAsBlob: IBlob;
1708     begin
1709     CheckActive;
1710     result := FIBXSQLVAR.GetAsBlob(AsQuad,nil);
1711     end;
1712    
1713     function TIBSQLData.GetAsBlob(BPB: IBPB): IBlob;
1714     begin
1715     CheckActive;
1716     result := FIBXSQLVAR.GetAsBlob(AsQuad,BPB);
1717     end;
1718    
1719 tony 56 function TIBSQLData.GetAsString: AnsiString;
1720 tony 45 begin
1721     CheckActive;
1722     Result := '';
1723     { Check null, if so return a default string }
1724     if not IsNull then
1725     case SQLType of
1726     SQL_ARRAY:
1727 tony 47 result := SArray;
1728 tony 45 SQL_BLOB:
1729 tony 47 Result := FIBXSQLVAR.GetAsBlob(AsQuad,nil).GetAsString;
1730 tony 45 else
1731     Result := inherited GetAsString;
1732     end;
1733     end;
1734    
1735     { TSQLParam }
1736    
1737 tony 56 procedure TSQLParam.InternalSetAsString(Value: AnsiString);
1738 tony 270
1739     procedure DoSetString;
1740     begin
1741     Changing;
1742     FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1743     Changed;
1744     end;
1745    
1746 tony 45 var b: IBlob;
1747 tony 59 dt: TDateTime;
1748 tony 270 CurrValue: Currency;
1749     FloatValue: single;
1750 tony 45 begin
1751     CheckActive;
1752     if IsNullable then
1753     IsNull := False;
1754     case SQLTYPE of
1755     SQL_BOOLEAN:
1756 tony 56 if AnsiCompareText(Value,STrue) = 0 then
1757 tony 45 AsBoolean := true
1758     else
1759 tony 56 if AnsiCompareText(Value,SFalse) = 0 then
1760 tony 45 AsBoolean := false
1761     else
1762     IBError(ibxeInvalidDataConversion,[nil]);
1763    
1764     SQL_BLOB:
1765     begin
1766     Changing;
1767     b := FIBXSQLVAR.CreateBlob;
1768     b.SetAsString(Value);
1769     AsBlob := b;
1770     Changed;
1771     end;
1772    
1773     SQL_VARYING,
1774     SQL_TEXT:
1775 tony 270 DoSetString;
1776 tony 45
1777     SQL_SHORT,
1778     SQL_LONG,
1779     SQL_INT64:
1780 tony 270 if TryStrToCurr(Value,CurrValue) then
1781     SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
1782     else
1783     DoSetString;
1784 tony 45
1785     SQL_D_FLOAT,
1786     SQL_DOUBLE,
1787     SQL_FLOAT:
1788 tony 270 if TryStrToFloat(Value,FloatValue) then
1789     SetAsDouble(FloatValue)
1790     else
1791     DoSetString;
1792 tony 45
1793     SQL_TIMESTAMP:
1794 tony 59 if TryStrToDateTime(Value,dt) then
1795     SetAsDateTime(dt)
1796     else
1797 tony 270 DoSetString;
1798 tony 45
1799     SQL_TYPE_DATE:
1800 tony 59 if TryStrToDateTime(Value,dt) then
1801     SetAsDate(dt)
1802     else
1803 tony 270 DoSetString;
1804 tony 45
1805     SQL_TYPE_TIME:
1806 tony 59 if TryStrToDateTime(Value,dt) then
1807     SetAsTime(dt)
1808     else
1809 tony 270 DoSetString;
1810 tony 45
1811     else
1812     IBError(ibxeInvalidDataConversion,[nil]);
1813     end;
1814     end;
1815    
1816     procedure TSQLParam.CheckActive;
1817     begin
1818     if not FIBXSQLVAR.Parent.StateChanged(FChangeSeqNo) then Exit;
1819    
1820     if FPrepareSeqNo < FIBXSQLVAR.Parent.GetPrepareSeqNo then
1821     IBError(ibxeInterfaceOutofDate,[nil]);
1822    
1823     if not FIBXSQLVAR.Parent.CheckStatementStatus(ssPrepared) then
1824     IBError(ibxeStatementNotPrepared, [nil]);
1825     end;
1826    
1827     procedure TSQLParam.SetScale(aValue: integer);
1828     begin
1829     CheckActive;
1830     FIBXSQLVAR.Scale := aValue;
1831     end;
1832    
1833     procedure TSQLParam.SetDataLength(len: cardinal);
1834     begin
1835     CheckActive;
1836     FIBXSQLVAR.DataLength := len;
1837     end;
1838    
1839     procedure TSQLParam.SetSQLType(aValue: cardinal);
1840     begin
1841     CheckActive;
1842     FIBXSQLVAR.SQLType := aValue;
1843     end;
1844    
1845     procedure TSQLParam.Clear;
1846     begin
1847     IsNull := true;
1848     end;
1849    
1850     function TSQLParam.GetModified: boolean;
1851     begin
1852     CheckActive;
1853     Result := FIBXSQLVAR.Modified;
1854     end;
1855    
1856     function TSQLParam.GetAsPointer: Pointer;
1857     begin
1858     IsNull := false; {Assume that we get the pointer in order to set a value}
1859     Changed;
1860     Result := inherited GetAsPointer;
1861     end;
1862    
1863 tony 56 procedure TSQLParam.SetName(Value: AnsiString);
1864 tony 45 begin
1865     CheckActive;
1866     FIBXSQLVAR.Name := Value;
1867     end;
1868    
1869     procedure TSQLParam.SetIsNull(Value: Boolean);
1870     var i: integer;
1871     begin
1872     CheckActive;
1873     if FIBXSQLVAR.UniqueName then
1874     FIBXSQLVAR.IsNull := Value
1875     else
1876     with FIBXSQLVAR.Parent do
1877     begin
1878     for i := 0 to Count - 1 do
1879     if Column[i].Name = Name then
1880     Column[i].IsNull := Value;
1881     end
1882     end;
1883    
1884     procedure TSQLParam.SetIsNullable(Value: Boolean);
1885     var i: integer;
1886     begin
1887     CheckActive;
1888     if FIBXSQLVAR.UniqueName then
1889     FIBXSQLVAR.IsNullable := Value
1890     else
1891     with FIBXSQLVAR.Parent do
1892     begin
1893     for i := 0 to Count - 1 do
1894     if Column[i].Name = Name then
1895     Column[i].IsNullable := Value;
1896     end
1897     end;
1898    
1899     procedure TSQLParam.SetAsArray(anArray: IArray);
1900     begin
1901     CheckActive;
1902     if GetSQLType <> SQL_ARRAY then
1903     IBError(ibxeInvalidDataConversion,[nil]);
1904    
1905     if not FIBXSQLVAR.UniqueName then
1906     IBError(ibxeDuplicateParamName,[FIBXSQLVAR.Name]);
1907    
1908     SetAsQuad(AnArray.GetArrayID);
1909     end;
1910    
1911     procedure TSQLParam.Changed;
1912     begin
1913     FIBXSQLVAR.Changed;
1914     end;
1915    
1916     procedure TSQLParam.SetAsBoolean(AValue: boolean);
1917     var i: integer;
1918     OldSQLVar: TSQLVarData;
1919     begin
1920     if FIBXSQLVAR.UniqueName then
1921     inherited SetAsBoolean(AValue)
1922     else
1923     with FIBXSQLVAR.Parent do
1924     begin
1925     for i := 0 to Count - 1 do
1926     if Column[i].Name = Name then
1927     begin
1928     OldSQLVar := FIBXSQLVAR;
1929     FIBXSQLVAR := Column[i];
1930     try
1931     inherited SetAsBoolean(AValue);
1932     finally
1933     FIBXSQLVAR := OldSQLVar;
1934     end;
1935     end;
1936     end;
1937     end;
1938    
1939     procedure TSQLParam.SetAsCurrency(AValue: Currency);
1940     var i: integer;
1941     OldSQLVar: TSQLVarData;
1942     begin
1943     if FIBXSQLVAR.UniqueName then
1944     inherited SetAsCurrency(AValue)
1945     else
1946     with FIBXSQLVAR.Parent do
1947     begin
1948     for i := 0 to Count - 1 do
1949     if Column[i].Name = Name then
1950     begin
1951     OldSQLVar := FIBXSQLVAR;
1952     FIBXSQLVAR := Column[i];
1953     try
1954     inherited SetAsCurrency(AValue);
1955     finally
1956     FIBXSQLVAR := OldSQLVar;
1957     end;
1958     end;
1959     end;
1960     end;
1961    
1962     procedure TSQLParam.SetAsInt64(AValue: Int64);
1963     var i: integer;
1964     OldSQLVar: TSQLVarData;
1965     begin
1966     if FIBXSQLVAR.UniqueName then
1967     inherited SetAsInt64(AValue)
1968     else
1969     with FIBXSQLVAR.Parent do
1970     begin
1971     for i := 0 to Count - 1 do
1972     if Column[i].Name = Name then
1973     begin
1974     OldSQLVar := FIBXSQLVAR;
1975     FIBXSQLVAR := Column[i];
1976     try
1977     inherited SetAsInt64(AValue);
1978     finally
1979     FIBXSQLVAR := OldSQLVar;
1980     end;
1981     end;
1982     end;
1983     end;
1984    
1985     procedure TSQLParam.SetAsDate(AValue: TDateTime);
1986     var i: integer;
1987     OldSQLVar: TSQLVarData;
1988     begin
1989     if FIBXSQLVAR.UniqueName then
1990     inherited SetAsDate(AValue)
1991     else
1992     with FIBXSQLVAR.Parent do
1993     begin
1994     for i := 0 to Count - 1 do
1995     if Column[i].Name = Name then
1996     begin
1997     OldSQLVar := FIBXSQLVAR;
1998     FIBXSQLVAR := Column[i];
1999     try
2000     inherited SetAsDate(AValue);
2001     finally
2002     FIBXSQLVAR := OldSQLVar;
2003     end;
2004     end;
2005     end;
2006     end;
2007    
2008     procedure TSQLParam.SetAsLong(AValue: Long);
2009     var i: integer;
2010     OldSQLVar: TSQLVarData;
2011     begin
2012     if FIBXSQLVAR.UniqueName then
2013     inherited SetAsLong(AValue)
2014     else
2015     with FIBXSQLVAR.Parent do
2016     begin
2017     for i := 0 to Count - 1 do
2018     if Column[i].Name = Name then
2019     begin
2020     OldSQLVar := FIBXSQLVAR;
2021     FIBXSQLVAR := Column[i];
2022     try
2023     inherited SetAsLong(AValue);
2024     finally
2025     FIBXSQLVAR := OldSQLVar;
2026     end;
2027     end;
2028     end;
2029     end;
2030    
2031     procedure TSQLParam.SetAsTime(AValue: TDateTime);
2032     var i: integer;
2033     OldSQLVar: TSQLVarData;
2034     begin
2035     if FIBXSQLVAR.UniqueName then
2036     inherited SetAsTime(AValue)
2037     else
2038     with FIBXSQLVAR.Parent do
2039     begin
2040     for i := 0 to Count - 1 do
2041     if Column[i].Name = Name then
2042     begin
2043     OldSQLVar := FIBXSQLVAR;
2044     FIBXSQLVAR := Column[i];
2045     try
2046     inherited SetAsTime(AValue);
2047     finally
2048     FIBXSQLVAR := OldSQLVar;
2049     end;
2050     end;
2051     end;
2052     end;
2053    
2054     procedure TSQLParam.SetAsDateTime(AValue: TDateTime);
2055     var i: integer;
2056     OldSQLVar: TSQLVarData;
2057     begin
2058     if FIBXSQLVAR.UniqueName then
2059     inherited SetAsDateTime(AValue)
2060     else
2061     with FIBXSQLVAR.Parent do
2062     begin
2063     for i := 0 to Count - 1 do
2064     if Column[i].Name = Name then
2065     begin
2066     OldSQLVar := FIBXSQLVAR;
2067     FIBXSQLVAR := Column[i];
2068     try
2069     inherited SetAsDateTime(AValue);
2070     finally
2071     FIBXSQLVAR := OldSQLVar;
2072     end;
2073     end;
2074     end;
2075     end;
2076    
2077     procedure TSQLParam.SetAsDouble(AValue: Double);
2078     var i: integer;
2079     OldSQLVar: TSQLVarData;
2080     begin
2081     if FIBXSQLVAR.UniqueName then
2082     inherited SetAsDouble(AValue)
2083     else
2084     with FIBXSQLVAR.Parent do
2085     begin
2086     for i := 0 to Count - 1 do
2087     if Column[i].Name = Name then
2088     begin
2089     OldSQLVar := FIBXSQLVAR;
2090     FIBXSQLVAR := Column[i];
2091     try
2092     inherited SetAsDouble(AValue);
2093     finally
2094     FIBXSQLVAR := OldSQLVar;
2095     end;
2096     end;
2097     end;
2098     end;
2099    
2100     procedure TSQLParam.SetAsFloat(AValue: Float);
2101     var i: integer;
2102     OldSQLVar: TSQLVarData;
2103     begin
2104     if FIBXSQLVAR.UniqueName then
2105     inherited SetAsFloat(AValue)
2106     else
2107     with FIBXSQLVAR.Parent do
2108     begin
2109     for i := 0 to Count - 1 do
2110     if Column[i].Name = Name then
2111     begin
2112     OldSQLVar := FIBXSQLVAR;
2113     FIBXSQLVAR := Column[i];
2114     try
2115     inherited SetAsFloat(AValue);
2116     finally
2117     FIBXSQLVAR := OldSQLVar;
2118     end;
2119     end;
2120     end;
2121     end;
2122    
2123     procedure TSQLParam.SetAsPointer(AValue: Pointer);
2124     var i: integer;
2125     OldSQLVar: TSQLVarData;
2126     begin
2127     if FIBXSQLVAR.UniqueName then
2128     inherited SetAsPointer(AValue)
2129     else
2130     with FIBXSQLVAR.Parent do
2131     begin
2132     for i := 0 to Count - 1 do
2133     if Column[i].Name = Name then
2134     begin
2135     OldSQLVar := FIBXSQLVAR;
2136     FIBXSQLVAR := Column[i];
2137     try
2138     inherited SetAsPointer(AValue);
2139     finally
2140     FIBXSQLVAR := OldSQLVar;
2141     end;
2142     end;
2143     end;
2144     end;
2145    
2146     procedure TSQLParam.SetAsShort(AValue: Short);
2147     var i: integer;
2148     OldSQLVar: TSQLVarData;
2149     begin
2150     if FIBXSQLVAR.UniqueName then
2151     inherited SetAsShort(AValue)
2152     else
2153     with FIBXSQLVAR.Parent do
2154     begin
2155     for i := 0 to Count - 1 do
2156     if Column[i].Name = Name then
2157     begin
2158     OldSQLVar := FIBXSQLVAR;
2159     FIBXSQLVAR := Column[i];
2160     try
2161     inherited SetAsShort(AValue);
2162     finally
2163     FIBXSQLVAR := OldSQLVar;
2164     end;
2165     end;
2166     end;
2167     end;
2168    
2169 tony 56 procedure TSQLParam.SetAsString(AValue: AnsiString);
2170 tony 45 var i: integer;
2171     OldSQLVar: TSQLVarData;
2172     begin
2173     if FIBXSQLVAR.UniqueName then
2174     InternalSetAsString(AValue)
2175     else
2176     with FIBXSQLVAR.Parent do
2177     begin
2178     for i := 0 to Count - 1 do
2179     if Column[i].Name = Name then
2180     begin
2181     OldSQLVar := FIBXSQLVAR;
2182     FIBXSQLVAR := Column[i];
2183     try
2184     InternalSetAsString(AValue);
2185     finally
2186     FIBXSQLVAR := OldSQLVar;
2187     end;
2188     end;
2189     end;
2190     end;
2191    
2192     procedure TSQLParam.SetAsVariant(AValue: Variant);
2193     var i: integer;
2194     OldSQLVar: TSQLVarData;
2195     begin
2196     if FIBXSQLVAR.UniqueName then
2197     inherited SetAsVariant(AValue)
2198     else
2199     with FIBXSQLVAR.Parent do
2200     begin
2201     for i := 0 to Count - 1 do
2202     if Column[i].Name = Name then
2203     begin
2204     OldSQLVar := FIBXSQLVAR;
2205     FIBXSQLVAR := Column[i];
2206     try
2207     inherited SetAsVariant(AValue);
2208     finally
2209     FIBXSQLVAR := OldSQLVar;
2210     end;
2211     end;
2212     end;
2213     end;
2214    
2215     procedure TSQLParam.SetAsBlob(aValue: IBlob);
2216     begin
2217     with FIBXSQLVAR do
2218     if not UniqueName then
2219     IBError(ibxeDuplicateParamName,[Name]);
2220     CheckActive;
2221     Changing;
2222     aValue.Close;
2223     if aValue.GetSubType <> GetSubType then
2224     IBError(ibxeIncompatibleBlob,[GetSubType,aValue.GetSubType]);
2225     AsQuad := aValue.GetBlobID;
2226     Changed;
2227     end;
2228    
2229     procedure TSQLParam.SetAsQuad(AValue: TISC_QUAD);
2230     var i: integer;
2231     OldSQLVar: TSQLVarData;
2232     begin
2233     if FIBXSQLVAR.UniqueName then
2234     inherited SetAsQuad(AValue)
2235     else
2236     with FIBXSQLVAR.Parent do
2237     begin
2238     for i := 0 to Count - 1 do
2239     if Column[i].Name = Name then
2240     begin
2241     OldSQLVar := FIBXSQLVAR;
2242     FIBXSQLVAR := Column[i];
2243     try
2244     inherited SetAsQuad(AValue);
2245     finally
2246     FIBXSQLVAR := OldSQLVar;
2247     end;
2248     end;
2249     end;
2250     end;
2251    
2252     procedure TSQLParam.SetCharSetID(aValue: cardinal);
2253     begin
2254     FIBXSQLVAR.SetCharSetID(aValue);
2255     end;
2256    
2257     { TMetaData }
2258    
2259     procedure TMetaData.CheckActive;
2260     begin
2261     if FPrepareSeqNo < FMetaData.PrepareSeqNo then
2262     IBError(ibxeInterfaceOutofDate,[nil]);
2263    
2264     if not FMetaData.CheckStatementStatus(ssPrepared) then
2265     IBError(ibxeStatementNotPrepared, [nil]);
2266     end;
2267    
2268     constructor TMetaData.Create(aMetaData: TSQLDataArea);
2269     begin
2270     inherited Create(aMetaData.Count);
2271     FMetaData := aMetaData;
2272     FStatement := aMetaData.Statement;
2273     FPrepareSeqNo := aMetaData.PrepareSeqNo;
2274     end;
2275    
2276     destructor TMetaData.Destroy;
2277     begin
2278     (FStatement as TInterfaceOwner).Remove(self);
2279     inherited Destroy;
2280     end;
2281    
2282 tony 56 function TMetaData.GetUniqueRelationName: AnsiString;
2283 tony 45 begin
2284     CheckActive;
2285     Result := FMetaData.UniqueRelationName;
2286     end;
2287    
2288     function TMetaData.getCount: integer;
2289     begin
2290     CheckActive;
2291     Result := FMetaData.ColumnsInUseCount;
2292     end;
2293    
2294     function TMetaData.getColumnMetaData(index: integer): IColumnMetaData;
2295     begin
2296     CheckActive;
2297     if (index < 0) or (index >= getCount) then
2298     IBError(ibxeInvalidColumnIndex,[nil]);
2299    
2300     if FMetaData.Count = 0 then
2301     Result := nil
2302     else
2303     begin
2304     if not HasInterface(index) then
2305     AddInterface(index,TColumnMetaData.Create(self,FMetaData.Column[index]));
2306     Result := TColumnMetaData(GetInterface(index));
2307     end;
2308     end;
2309    
2310 tony 56 function TMetaData.ByName(Idx: AnsiString): IColumnMetaData;
2311 tony 45 var aIBXSQLVAR: TSQLVarData;
2312     begin
2313     CheckActive;
2314     aIBXSQLVAR := FMetaData.ColumnByName(Idx);
2315     if aIBXSQLVAR = nil then
2316     IBError(ibxeFieldNotFound,[Idx]);
2317     Result := getColumnMetaData(aIBXSQLVAR.index);
2318     end;
2319    
2320     { TSQLParams }
2321    
2322     procedure TSQLParams.CheckActive;
2323     begin
2324     if not FSQLParams.StateChanged(FChangeSeqNo) then Exit;
2325    
2326     if FPrepareSeqNo < FSQLParams.PrepareSeqNo then
2327     IBError(ibxeInterfaceOutofDate,[nil]);
2328    
2329     if not FSQLParams.CheckStatementStatus(ssPrepared) then
2330     IBError(ibxeStatementNotPrepared, [nil]);
2331     end;
2332    
2333     constructor TSQLParams.Create(aSQLParams: TSQLDataArea);
2334     begin
2335     inherited Create(aSQLParams.Count);
2336     FSQLParams := aSQLParams;
2337     FStatement := aSQLParams.Statement;
2338     FPrepareSeqNo := aSQLParams.PrepareSeqNo;
2339     FSQLParams.StateChanged(FChangeSeqNo);
2340     end;
2341    
2342     destructor TSQLParams.Destroy;
2343     begin
2344     (FStatement as TInterfaceOwner).Remove(self);
2345     inherited Destroy;
2346     end;
2347    
2348     function TSQLParams.getCount: integer;
2349     begin
2350     CheckActive;
2351     Result := FSQLParams.ColumnsInUseCount;
2352     end;
2353    
2354     function TSQLParams.getSQLParam(index: integer): ISQLParam;
2355     begin
2356     CheckActive;
2357     if (index < 0) or (index >= getCount) then
2358     IBError(ibxeInvalidColumnIndex,[nil]);
2359    
2360     if getCount = 0 then
2361     Result := nil
2362     else
2363     begin
2364     if not HasInterface(index) then
2365     AddInterface(index, TSQLParam.Create(self,FSQLParams.Column[index]));
2366     Result := TSQLParam(GetInterface(index));
2367     end;
2368     end;
2369    
2370 tony 56 function TSQLParams.ByName(Idx: AnsiString): ISQLParam;
2371 tony 45 var aIBXSQLVAR: TSQLVarData;
2372     begin
2373     CheckActive;
2374     aIBXSQLVAR := FSQLParams.ColumnByName(Idx);
2375     if aIBXSQLVAR = nil then
2376     IBError(ibxeFieldNotFound,[Idx]);
2377     Result := getSQLParam(aIBXSQLVAR.index);
2378     end;
2379    
2380     function TSQLParams.GetModified: Boolean;
2381     var
2382     i: Integer;
2383     begin
2384     CheckActive;
2385     result := False;
2386     with FSQLParams do
2387     for i := 0 to Count - 1 do
2388     if Column[i].Modified then
2389     begin
2390     result := True;
2391     exit;
2392     end;
2393     end;
2394    
2395     { TResults }
2396    
2397     procedure TResults.CheckActive;
2398     begin
2399     if not FResults.StateChanged(FChangeSeqNo) then Exit;
2400    
2401     if FPrepareSeqNo < FResults.PrepareSeqNo then
2402     IBError(ibxeInterfaceOutofDate,[nil]);
2403    
2404     if not FResults.CheckStatementStatus(ssPrepared) then
2405     IBError(ibxeStatementNotPrepared, [nil]);
2406    
2407     with GetTransaction as TFBTransaction do
2408     if not InTransaction or (FResults.TransactionSeqNo <> FTransactionSeqNo) then
2409     IBError(ibxeInterfaceOutofDate,[nil]);
2410     end;
2411    
2412     function TResults.GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
2413     begin
2414     if (aIBXSQLVAR.Index < 0) or (aIBXSQLVAR.Index >= getCount) then
2415     IBError(ibxeInvalidColumnIndex,[nil]);
2416    
2417     if not HasInterface(aIBXSQLVAR.Index) then
2418     AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
2419     Result := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
2420     end;
2421    
2422     constructor TResults.Create(aResults: TSQLDataArea);
2423     begin
2424     inherited Create(aResults.Count);
2425     FResults := aResults;
2426     FStatement := aResults.Statement;
2427     FPrepareSeqNo := aResults.PrepareSeqNo;
2428     FTransactionSeqNo := aResults.TransactionSeqNo;
2429     FResults.StateChanged(FChangeSeqNo);
2430     end;
2431    
2432     function TResults.getCount: integer;
2433     begin
2434     CheckActive;
2435     Result := FResults.Count;
2436     end;
2437    
2438 tony 56 function TResults.ByName(Idx: AnsiString): ISQLData;
2439 tony 45 var col: TSQLVarData;
2440     begin
2441     Result := nil;
2442     CheckActive;
2443     if FResults.CheckStatementStatus(ssBOF) then
2444     IBError(ibxeBOF,[nil]);
2445     if FResults.CheckStatementStatus(ssEOF) then
2446     IBError(ibxeEOF,[nil]);
2447    
2448     if FResults.Count > 0 then
2449     begin
2450     col := FResults.ColumnByName(Idx);
2451     if col <> nil then
2452     Result := GetISQLData(col);
2453     end;
2454     end;
2455    
2456     function TResults.getSQLData(index: integer): ISQLData;
2457     begin
2458     CheckActive;
2459     if FResults.CheckStatementStatus(ssBOF) then
2460     IBError(ibxeBOF,[nil]);
2461     if FResults.CheckStatementStatus(ssEOF) then
2462     IBError(ibxeEOF,[nil]);
2463     if (index < 0) or (index >= FResults.Count) then
2464     IBError(ibxeInvalidColumnIndex,[nil]);
2465    
2466     Result := GetISQLData(FResults.Column[index]);
2467     end;
2468    
2469     procedure TResults.GetData(index: integer; var IsNull: boolean; var len: short;
2470 tony 56 var data: PByte);
2471 tony 45 begin
2472     CheckActive;
2473     FResults.GetData(index,IsNull, len,data);
2474     end;
2475    
2476     function TResults.GetTransaction: ITransaction;
2477     begin
2478     Result := FStatement.GetTransaction;
2479     end;
2480    
2481     procedure TResults.SetRetainInterfaces(aValue: boolean);
2482     begin
2483     RetainInterfaces := aValue;
2484     end;
2485    
2486     end.
2487