ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/FBSQLData.pas
Revision: 287
Committed: Thu Apr 11 08:51:23 2019 UTC (4 years, 11 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/FBSQLData.pas
File size: 64638 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 tony 287 function GetHasCaseSensitiveParams: Boolean;
425 tony 45 end;
426    
427     { TResults }
428    
429     TResults = class(TInterfaceOwner,IResults)
430     private
431     FPrepareSeqNo: integer;
432     FTransactionSeqNo: integer;
433     FChangeSeqNo: integer;
434     FResults: TSQLDataArea;
435     FStatement: IStatement; {ensure FStatement not destroyed until no longer needed}
436     function GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
437     protected
438     procedure CheckActive;
439     public
440     constructor Create(aResults: TSQLDataArea);
441     {IResults}
442     function getCount: integer;
443 tony 56 function ByName(Idx: AnsiString): ISQLData;
444 tony 45 function getSQLData(index: integer): ISQLData;
445 tony 56 procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
446 tony 45 function GetTransaction: ITransaction; virtual;
447     procedure SetRetainInterfaces(aValue: boolean);
448     end;
449    
450     implementation
451    
452 tony 270 uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
453 tony 45
454     { TSQLDataArea }
455    
456     function TSQLDataArea.GetColumn(index: integer): TSQLVarData;
457     begin
458     if (index < 0) or (index >= Count) then
459     IBError(ibxeInvalidColumnIndex,[nil]);
460     Result := FColumnList[index];
461     end;
462    
463     function TSQLDataArea.GetCount: integer;
464     begin
465     Result := Length(FColumnList);
466     end;
467    
468     procedure TSQLDataArea.SetUniqueRelationName;
469     var
470     i: Integer;
471     bUnique: Boolean;
472 tony 56 RelationName: AnsiString;
473 tony 45 begin
474     bUnique := True;
475     for i := 0 to ColumnsInUseCount - 1 do
476     begin
477     RelationName := Column[i].RelationName;
478    
479     {First get the unique relation name, if any}
480    
481     if bUnique and (RelationName <> '') then
482     begin
483     if FUniqueRelationName = '' then
484     FUniqueRelationName := RelationName
485     else
486     if RelationName <> FUniqueRelationName then
487     begin
488     FUniqueRelationName := '';
489     bUnique := False;
490     end;
491     end;
492     end;
493     end;
494    
495     procedure TSQLDataArea.Initialize;
496     var
497     i: Integer;
498     begin
499     for i := 0 to ColumnsInUseCount - 1 do
500     Column[i].Initialize;
501     end;
502    
503 tony 56 procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
504     var sProcessedSQL: AnsiString);
505 tony 45
506 tony 263 var slNames: TStrings;
507 tony 45
508 tony 263 procedure SetColumnNames(slNames: TStrings);
509     var i, j: integer;
510     found: boolean;
511 tony 45 begin
512 tony 263 found := false;
513 tony 45 SetCount(slNames.Count);
514     for i := 0 to slNames.Count - 1 do
515     begin
516     Column[i].Name := slNames[i];
517     Column[i].UniqueName := (slNames.Objects[i] <> nil);
518     end;
519     for i := 0 to Count - 1 do
520     begin
521     if not Column[i].UniqueName then
522     begin
523     found := false;
524     for j := i + 1 to Count - 1 do
525     if Column[i].Name = Column[j].Name then
526     begin
527     found := true;
528     break;
529     end;
530     Column[i].UniqueName := not found;
531     end;
532     end;
533 tony 263 end;
534    
535     begin
536     if not IsInputDataArea then
537     IBError(ibxeNotPermitted,[nil]);
538    
539     slNames := TStringList.Create;
540     try
541     sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
542     SetColumnNames(slNames);
543 tony 45 finally
544     slNames.Free;
545     end;
546     end;
547    
548     function TSQLDataArea.ColumnsInUseCount: integer;
549     begin
550     Result := Count;
551     end;
552    
553 tony 56 function TSQLDataArea.ColumnByName(Idx: AnsiString): TSQLVarData;
554 tony 45 var
555 tony 56 s: AnsiString;
556 tony 45 i: Integer;
557     begin
558 tony 270 if not IsInputDataArea or not CaseSensitiveParams then
559     s := AnsiUpperCase(Idx)
560     else
561 tony 45 s := Idx;
562 tony 270
563 tony 45 for i := 0 to Count - 1 do
564     if Column[i].Name = s then
565     begin
566     Result := Column[i];
567     Exit;
568     end;
569     Result := nil;
570     end;
571    
572     procedure TSQLDataArea.GetData(index: integer; var IsNull: boolean;
573 tony 56 var len: short; var data: PByte);
574 tony 45 begin
575     //Do Nothing
576     end;
577    
578     procedure TSQLDataArea.RowChange;
579     var i: integer;
580     begin
581     for i := 0 to Count - 1 do
582     Column[i].RowChange;
583     end;
584    
585     {TSQLVarData}
586    
587     function TSQLVarData.GetStatement: IStatement;
588     begin
589     Result := FParent.Statement;
590     end;
591    
592 tony 56 procedure TSQLVarData.SetName(AValue: AnsiString);
593 tony 45 begin
594 tony 270 if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
595 tony 45 FName := AnsiUpperCase(AValue)
596     else
597     FName := AValue;
598     end;
599    
600     constructor TSQLVarData.Create(aParent: TSQLDataArea; aIndex: integer);
601     begin
602     inherited Create;
603     FParent := aParent;
604     FIndex := aIndex;
605     FUniqueName := true;
606     end;
607    
608 tony 56 procedure TSQLVarData.SetString(aValue: AnsiString);
609 tony 45 begin
610     {we take full advantage here of reference counted strings. When setting a string
611     value, a reference is kept in FVarString and a pointer to it placed in the
612 tony 56 SQLVar. This avoids string copies. Note that PAnsiChar is guaranteed to point to
613 tony 45 a zero byte when the string is empty, neatly avoiding a nil pointer error.}
614    
615     FVarString := aValue;
616     SQLType := SQL_TEXT;
617 tony 270 Scale := 0;
618 tony 56 SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
619 tony 45 end;
620    
621     procedure TSQLVarData.Changed;
622     begin
623     FModified := true;
624     end;
625    
626     procedure TSQLVarData.RowChange;
627     begin
628     FModified := false;
629     FVarString := '';
630     end;
631    
632     procedure TSQLVarData.Initialize;
633    
634 tony 56 function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
635 tony 45 var
636     k: integer;
637     begin
638     for k := 0 to limit do
639     if Parent.Column[k].Name = idx then
640     begin
641     Result := Parent.Column[k];
642     Exit;
643     end;
644     Result := nil;
645     end;
646    
647     var
648     j, j_len: Integer;
649 tony 56 st: AnsiString;
650     sBaseName: AnsiString;
651 tony 45 begin
652     RowChange;
653    
654     {If an output SQLDA then copy the aliasname to the FName. Ensure
655     that they are all upper case only and disambiguated.
656     }
657    
658     if not Parent.IsInputDataArea then
659     begin
660     st := Space2Underscore(AnsiUppercase(AliasName));
661     if st = '' then
662     begin
663     sBaseName := 'F_'; {do not localize}
664     j := 1; j_len := 1;
665     st := sBaseName + IntToStr(j);
666     end
667     else
668     begin
669     j := 0; j_len := 0;
670     sBaseName := st;
671     end;
672    
673     {Look for other columns with the same name and make unique}
674    
675     while FindVarByName(st,Index-1) <> nil do
676     begin
677     Inc(j);
678     j_len := Length(IntToStr(j));
679     if j_len + Length(sBaseName) > 31 then
680     st := system.Copy(sBaseName, 1, 31 - j_len) + IntToStr(j)
681     else
682     st := sBaseName + IntToStr(j);
683     end;
684    
685     Name := st;
686     end;
687     end;
688    
689     {TSQLDataItem}
690    
691     function TSQLDataItem.AdjustScale(Value: Int64; aScale: Integer): Double;
692     var
693     Scaling : Int64;
694     i: Integer;
695     Val: Double;
696     begin
697     Scaling := 1; Val := Value;
698     if aScale > 0 then
699     begin
700     for i := 1 to aScale do
701     Scaling := Scaling * 10;
702     result := Val * Scaling;
703     end
704     else
705     if aScale < 0 then
706     begin
707     for i := -1 downto aScale do
708     Scaling := Scaling * 10;
709     result := Val / Scaling;
710     end
711     else
712     result := Val;
713     end;
714    
715     function TSQLDataItem.AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
716     var
717     Scaling : Int64;
718     i: Integer;
719     Val: Int64;
720     begin
721     Scaling := 1; Val := Value;
722     if aScale > 0 then begin
723     for i := 1 to aScale do Scaling := Scaling * 10;
724     result := Val * Scaling;
725     end else if aScale < 0 then begin
726     for i := -1 downto aScale do Scaling := Scaling * 10;
727     result := Val div Scaling;
728     end else
729     result := Val;
730     end;
731    
732     function TSQLDataItem.AdjustScaleToCurrency(Value: Int64; aScale: Integer
733     ): Currency;
734     var
735     Scaling : Int64;
736     i : Integer;
737 tony 56 FractionText, PadText, CurrText: AnsiString;
738 tony 45 begin
739     Result := 0;
740     Scaling := 1;
741     PadText := '';
742     if aScale > 0 then
743     begin
744     for i := 1 to aScale do
745     Scaling := Scaling * 10;
746     result := Value * Scaling;
747     end
748     else
749     if aScale < 0 then
750     begin
751     for i := -1 downto aScale do
752     Scaling := Scaling * 10;
753     FractionText := IntToStr(abs(Value mod Scaling));
754     for i := Length(FractionText) to -aScale -1 do
755     PadText := '0' + PadText;
756 tony 56 {$IF declared(DefaultFormatSettings)}
757     with DefaultFormatSettings do
758     {$ELSE}
759     {$IF declared(FormatSettings)}
760     with FormatSettings do
761     {$IFEND}
762     {$IFEND}
763 tony 45 if Value < 0 then
764 tony 56 CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
765 tony 45 else
766 tony 56 CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
767 tony 45 try
768     result := StrToCurr(CurrText);
769     except
770     on E: Exception do
771     IBError(ibxeInvalidDataConversion, [nil]);
772     end;
773     end
774     else
775     result := Value;
776     end;
777    
778 tony 270 function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
779     begin
780     {$IF declared(DefaultFormatSettings)}
781     with DefaultFormatSettings do
782     {$ELSE}
783     {$IF declared(FormatSettings)}
784     with FormatSettings do
785     {$IFEND}
786     {$IFEND}
787     case GetSQLDialect of
788     1:
789     if IncludeTime then
790     result := ShortDateFormat + ' ' + LongTimeFormat
791     else
792     result := ShortDateFormat;
793     3:
794     result := ShortDateFormat;
795     end;
796     end;
797    
798     function TSQLDataItem.GetTimeFormatStr: AnsiString;
799     begin
800     {$IF declared(DefaultFormatSettings)}
801     with DefaultFormatSettings do
802     {$ELSE}
803     {$IF declared(FormatSettings)}
804     with FormatSettings do
805     {$IFEND}
806     {$IFEND}
807     Result := LongTimeFormat;
808     end;
809    
810     function TSQLDataItem.GetTimestampFormatStr: AnsiString;
811     begin
812     {$IF declared(DefaultFormatSettings)}
813     with DefaultFormatSettings do
814     {$ELSE}
815     {$IF declared(FormatSettings)}
816     with FormatSettings do
817     {$IFEND}
818     {$IFEND}
819     Result := ShortDateFormat + ' ' + LongTimeFormat + '.zzz';
820     end;
821    
822 tony 45 procedure TSQLDataItem.SetAsInteger(AValue: Integer);
823     begin
824     SetAsLong(aValue);
825     end;
826    
827     function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
828     ): Int64;
829     var
830     Scaling : Int64;
831     i : Integer;
832     begin
833     Result := 0;
834     Scaling := 1;
835     if aScale < 0 then
836     begin
837     for i := -1 downto aScale do
838     Scaling := Scaling * 10;
839     result := trunc(Value * Scaling);
840     end
841     else
842     if aScale > 0 then
843     begin
844     for i := 1 to aScale do
845     Scaling := Scaling * 10;
846     result := trunc(Value / Scaling);
847     end
848     else
849     result := trunc(Value);
850     end;
851    
852     function TSQLDataItem.AdjustScaleFromDouble(Value: Double; aScale: Integer
853     ): Int64;
854     var
855     Scaling : Int64;
856     i : Integer;
857     begin
858     Result := 0;
859     Scaling := 1;
860     if aScale < 0 then
861     begin
862     for i := -1 downto aScale do
863     Scaling := Scaling * 10;
864     result := trunc(Value * Scaling);
865     end
866     else
867     if aScale > 0 then
868     begin
869     for i := 1 to aScale do
870     Scaling := Scaling * 10;
871     result := trunc(Value / Scaling);
872     end
873     else
874     result := trunc(Value);
875     end;
876    
877     procedure TSQLDataItem.CheckActive;
878     begin
879     //Do nothing by default
880     end;
881    
882     procedure TSQLDataItem.Changed;
883     begin
884     //Do nothing by default
885     end;
886    
887     procedure TSQLDataItem.Changing;
888     begin
889     //Do nothing by default
890     end;
891    
892 tony 56 procedure TSQLDataItem.InternalSetAsString(Value: AnsiString);
893 tony 45 begin
894     //Do nothing by default
895     end;
896    
897 tony 56 function TSQLDataItem.Transliterate(s: AnsiString; CodePage: TSystemCodePage
898 tony 45 ): RawByteString;
899     begin
900     Result := s;
901     if StringCodePage(Result) <> CodePage then
902     SetCodePage(Result,CodePage,CodePage <> CP_NONE);
903     end;
904    
905     procedure TSQLDataItem.SetScale(aValue: integer);
906     begin
907     //Do nothing by default
908     end;
909    
910     procedure TSQLDataItem.SetDataLength(len: cardinal);
911     begin
912     //Do nothing by default
913     end;
914    
915     procedure TSQLDataItem.SetSQLType(aValue: cardinal);
916     begin
917     //Do nothing by default
918     end;
919    
920 tony 263 constructor TSQLDataItem.Create(api: TFBClientAPI);
921     begin
922     inherited Create;
923     FFirebirdClientAPI := api;
924     end;
925    
926 tony 56 function TSQLDataItem.GetSQLTypeName: AnsiString;
927 tony 45 begin
928     Result := GetSQLTypeName(GetSQLType);
929     end;
930    
931 tony 56 class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
932 tony 45 begin
933     Result := 'Unknown';
934     case SQLType of
935     SQL_VARYING: Result := 'SQL_VARYING';
936     SQL_TEXT: Result := 'SQL_TEXT';
937     SQL_DOUBLE: Result := 'SQL_DOUBLE';
938     SQL_FLOAT: Result := 'SQL_FLOAT';
939     SQL_LONG: Result := 'SQL_LONG';
940     SQL_SHORT: Result := 'SQL_SHORT';
941     SQL_TIMESTAMP: Result := 'SQL_TIMESTAMP';
942     SQL_BLOB: Result := 'SQL_BLOB';
943     SQL_D_FLOAT: Result := 'SQL_D_FLOAT';
944     SQL_ARRAY: Result := 'SQL_ARRAY';
945     SQL_QUAD: Result := 'SQL_QUAD';
946     SQL_TYPE_TIME: Result := 'SQL_TYPE_TIME';
947     SQL_TYPE_DATE: Result := 'SQL_TYPE_DATE';
948     SQL_INT64: Result := 'SQL_INT64';
949     end;
950     end;
951    
952     function TSQLDataItem.GetAsBoolean: boolean;
953     begin
954     CheckActive;
955     result := false;
956     if not IsNull then
957     begin
958     if SQLType = SQL_BOOLEAN then
959     result := PByte(SQLData)^ = ISC_TRUE
960     else
961     IBError(ibxeInvalidDataConversion, [nil]);
962     end
963     end;
964    
965     function TSQLDataItem.GetAsCurrency: Currency;
966     begin
967     CheckActive;
968     result := 0;
969     if GetSQLDialect < 3 then
970     result := GetAsDouble
971     else begin
972     if not IsNull then
973     case SQLType of
974     SQL_TEXT, SQL_VARYING: begin
975     try
976     result := StrtoCurr(AsString);
977     except
978     on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
979     end;
980     end;
981     SQL_SHORT:
982     result := AdjustScaleToCurrency(Int64(PShort(SQLData)^),
983     Scale);
984     SQL_LONG:
985     result := AdjustScaleToCurrency(Int64(PLong(SQLData)^),
986     Scale);
987     SQL_INT64:
988     result := AdjustScaleToCurrency(PInt64(SQLData)^,
989     Scale);
990     SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
991     result := Trunc(AsDouble);
992     else
993     IBError(ibxeInvalidDataConversion, [nil]);
994     end;
995     end;
996     end;
997    
998     function TSQLDataItem.GetAsInt64: Int64;
999     begin
1000     CheckActive;
1001     result := 0;
1002     if not IsNull then
1003     case SQLType of
1004     SQL_TEXT, SQL_VARYING: begin
1005     try
1006     result := StrToInt64(AsString);
1007     except
1008     on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
1009     end;
1010     end;
1011     SQL_SHORT:
1012     result := AdjustScaleToInt64(Int64(PShort(SQLData)^),
1013     Scale);
1014     SQL_LONG:
1015     result := AdjustScaleToInt64(Int64(PLong(SQLData)^),
1016     Scale);
1017     SQL_INT64:
1018     result := AdjustScaleToInt64(PInt64(SQLData)^,
1019     Scale);
1020     SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1021     result := Trunc(AsDouble);
1022     else
1023     IBError(ibxeInvalidDataConversion, [nil]);
1024     end;
1025     end;
1026    
1027     function TSQLDataItem.GetAsDateTime: TDateTime;
1028     begin
1029     CheckActive;
1030     result := 0;
1031     if not IsNull then
1032 tony 263 with FFirebirdClientAPI do
1033 tony 45 case SQLType of
1034     SQL_TEXT, SQL_VARYING: begin
1035     try
1036     result := StrToDate(AsString);
1037     except
1038     on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]);
1039     end;
1040     end;
1041     SQL_TYPE_DATE:
1042     result := SQLDecodeDate(SQLData);
1043     SQL_TYPE_TIME:
1044     result := SQLDecodeTime(SQLData);
1045     SQL_TIMESTAMP:
1046     result := SQLDecodeDateTime(SQLData);
1047     else
1048     IBError(ibxeInvalidDataConversion, [nil]);
1049     end;
1050     end;
1051    
1052     function TSQLDataItem.GetAsDouble: Double;
1053     begin
1054     CheckActive;
1055     result := 0;
1056     if not IsNull then begin
1057     case SQLType of
1058     SQL_TEXT, SQL_VARYING: begin
1059     try
1060     result := StrToFloat(AsString);
1061     except
1062     on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
1063     end;
1064     end;
1065     SQL_SHORT:
1066     result := AdjustScale(Int64(PShort(SQLData)^),
1067     Scale);
1068     SQL_LONG:
1069     result := AdjustScale(Int64(PLong(SQLData)^),
1070     Scale);
1071     SQL_INT64:
1072     result := AdjustScale(PInt64(SQLData)^, Scale);
1073     SQL_FLOAT:
1074     result := PFloat(SQLData)^;
1075     SQL_DOUBLE, SQL_D_FLOAT:
1076     result := PDouble(SQLData)^;
1077     else
1078     IBError(ibxeInvalidDataConversion, [nil]);
1079     end;
1080     if Scale <> 0 then
1081     result :=
1082     StrToFloat(FloatToStrF(result, fffixed, 15,
1083     Abs(Scale) ));
1084     end;
1085     end;
1086    
1087     function TSQLDataItem.GetAsFloat: Float;
1088     begin
1089     CheckActive;
1090     result := 0;
1091     try
1092     result := AsDouble;
1093     except
1094     on E: EOverflow do
1095     IBError(ibxeInvalidDataConversion, [nil]);
1096     end;
1097     end;
1098    
1099     function TSQLDataItem.GetAsLong: Long;
1100     begin
1101     CheckActive;
1102     result := 0;
1103     if not IsNull then
1104     case SQLType of
1105     SQL_TEXT, SQL_VARYING: begin
1106     try
1107     result := StrToInt(AsString);
1108     except
1109     on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
1110     end;
1111     end;
1112     SQL_SHORT:
1113     result := Trunc(AdjustScale(Int64(PShort(SQLData)^),
1114     Scale));
1115     SQL_LONG:
1116     result := Trunc(AdjustScale(Int64(PLong(SQLData)^),
1117     Scale));
1118     SQL_INT64:
1119     result := Trunc(AdjustScale(PInt64(SQLData)^, Scale));
1120     SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1121     result := Trunc(AsDouble);
1122     else
1123     IBError(ibxeInvalidDataConversion, [nil]);
1124     end;
1125     end;
1126    
1127     function TSQLDataItem.GetAsPointer: Pointer;
1128     begin
1129     CheckActive;
1130     if not IsNull then
1131     result := SQLData
1132     else
1133     result := nil;
1134     end;
1135    
1136     function TSQLDataItem.GetAsQuad: TISC_QUAD;
1137     begin
1138     CheckActive;
1139     result.gds_quad_high := 0;
1140     result.gds_quad_low := 0;
1141     if not IsNull then
1142     case SQLType of
1143     SQL_BLOB, SQL_ARRAY, SQL_QUAD:
1144     result := PISC_QUAD(SQLData)^;
1145     else
1146     IBError(ibxeInvalidDataConversion, [nil]);
1147     end;
1148     end;
1149    
1150     function TSQLDataItem.GetAsShort: short;
1151     begin
1152     CheckActive;
1153     result := 0;
1154     try
1155     result := AsLong;
1156     except
1157     on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
1158     end;
1159     end;
1160    
1161    
1162 tony 56 function TSQLDataItem.GetAsString: AnsiString;
1163 tony 45 var
1164 tony 56 sz: PByte;
1165 tony 45 str_len: Integer;
1166     rs: RawByteString;
1167     begin
1168     CheckActive;
1169     result := '';
1170     { Check null, if so return a default string }
1171     if not IsNull then
1172 tony 263 with FFirebirdClientAPI do
1173 tony 45 case SQLType of
1174     SQL_BOOLEAN:
1175     if AsBoolean then
1176     Result := sTrue
1177     else
1178     Result := SFalse;
1179    
1180     SQL_TEXT, SQL_VARYING:
1181     begin
1182     sz := SQLData;
1183     if (SQLType = SQL_TEXT) then
1184     str_len := DataLength
1185     else begin
1186     str_len := DecodeInteger(SQLData, 2);
1187     Inc(sz, 2);
1188     end;
1189 tony 56 SetString(rs, PAnsiChar(sz), str_len);
1190 tony 45 SetCodePage(rs,GetCodePage,false);
1191 tony 47 if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1192     Result := TrimRight(rs)
1193     else
1194     Result := rs
1195 tony 45 end;
1196     SQL_TYPE_DATE:
1197 tony 270 result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1198 tony 45 SQL_TYPE_TIME :
1199 tony 270 result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1200 tony 45 SQL_TIMESTAMP:
1201 tony 270 result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1202 tony 45 SQL_SHORT, SQL_LONG:
1203     if Scale = 0 then
1204     result := IntToStr(AsLong)
1205     else if Scale >= (-4) then
1206     result := CurrToStr(AsCurrency)
1207     else
1208     result := FloatToStr(AsDouble);
1209     SQL_INT64:
1210     if Scale = 0 then
1211     result := IntToStr(AsInt64)
1212     else if Scale >= (-4) then
1213     result := CurrToStr(AsCurrency)
1214     else
1215     result := FloatToStr(AsDouble);
1216     SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1217     result := FloatToStr(AsDouble);
1218     else
1219     IBError(ibxeInvalidDataConversion, [nil]);
1220     end;
1221     end;
1222    
1223     function TSQLDataItem.GetIsNull: Boolean;
1224     begin
1225     CheckActive;
1226     Result := false;
1227     end;
1228    
1229 tony 270 function TSQLDataItem.GetIsNullable: boolean;
1230 tony 45 begin
1231     CheckActive;
1232     Result := false;
1233     end;
1234    
1235     function TSQLDataItem.GetAsVariant: Variant;
1236     begin
1237     CheckActive;
1238     if IsNull then
1239     result := NULL
1240     { Check null, if so return a default string }
1241     else case SQLType of
1242     SQL_ARRAY:
1243     result := '(Array)'; {do not localize}
1244     SQL_BLOB,
1245     SQL_TEXT, SQL_VARYING:
1246     result := AsString;
1247     SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
1248     result := AsDateTime;
1249     SQL_SHORT, SQL_LONG:
1250     if Scale = 0 then
1251     result := AsLong
1252     else if Scale >= (-4) then
1253     result := AsCurrency
1254     else
1255     result := AsDouble;
1256     SQL_INT64:
1257     if Scale = 0 then
1258     result := AsInt64
1259     else if Scale >= (-4) then
1260     result := AsCurrency
1261     else
1262     result := AsDouble;
1263     SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1264     result := AsDouble;
1265     SQL_BOOLEAN:
1266     result := AsBoolean;
1267     else
1268     IBError(ibxeInvalidDataConversion, [nil]);
1269     end;
1270     end;
1271    
1272     function TSQLDataItem.GetModified: boolean;
1273     begin
1274     Result := false;
1275     end;
1276    
1277 tony 270 function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
1278     ): integer;
1279     begin
1280     case DateTimeFormat of
1281     dfTimestamp:
1282     Result := Length(GetTimestampFormatStr);
1283     dfDateTime:
1284     Result := Length(GetDateFormatStr(true));
1285     dfTime:
1286     Result := Length(GetTimeFormatStr);
1287     else
1288     Result := 0;
1289     end;
1290     end;
1291 tony 45
1292 tony 270
1293 tony 45 procedure TSQLDataItem.SetIsNull(Value: Boolean);
1294     begin
1295     //ignore unless overridden
1296     end;
1297    
1298     procedure TSQLDataItem.SetIsNullable(Value: Boolean);
1299     begin
1300     //ignore unless overridden
1301     end;
1302    
1303 tony 56 procedure TSQLDataItem.SetName(aValue: AnsiString);
1304 tony 45 begin
1305     //ignore unless overridden
1306     end;
1307    
1308     procedure TSQLDataItem.SetAsCurrency(Value: Currency);
1309     begin
1310     CheckActive;
1311     if GetSQLDialect < 3 then
1312     AsDouble := Value
1313     else
1314     begin
1315     Changing;
1316     if IsNullable then
1317     IsNull := False;
1318     SQLType := SQL_INT64;
1319     Scale := -4;
1320     DataLength := SizeOf(Int64);
1321     PCurrency(SQLData)^ := Value;
1322     Changed;
1323     end;
1324     end;
1325    
1326     procedure TSQLDataItem.SetAsInt64(Value: Int64);
1327     begin
1328     CheckActive;
1329     Changing;
1330     if IsNullable then
1331     IsNull := False;
1332    
1333     SQLType := SQL_INT64;
1334     Scale := 0;
1335     DataLength := SizeOf(Int64);
1336     PInt64(SQLData)^ := Value;
1337     Changed;
1338     end;
1339    
1340     procedure TSQLDataItem.SetAsDate(Value: TDateTime);
1341     begin
1342     CheckActive;
1343     if GetSQLDialect < 3 then
1344     begin
1345     AsDateTime := Value;
1346     exit;
1347     end;
1348    
1349     Changing;
1350     if IsNullable then
1351     IsNull := False;
1352    
1353     SQLType := SQL_TYPE_DATE;
1354     DataLength := SizeOf(ISC_DATE);
1355 tony 263 with FFirebirdClientAPI do
1356 tony 45 SQLEncodeDate(Value,SQLData);
1357     Changed;
1358     end;
1359    
1360     procedure TSQLDataItem.SetAsTime(Value: TDateTime);
1361     begin
1362     CheckActive;
1363     if GetSQLDialect < 3 then
1364     begin
1365     AsDateTime := Value;
1366     exit;
1367     end;
1368    
1369     Changing;
1370     if IsNullable then
1371     IsNull := False;
1372    
1373     SQLType := SQL_TYPE_TIME;
1374     DataLength := SizeOf(ISC_TIME);
1375 tony 263 with FFirebirdClientAPI do
1376 tony 45 SQLEncodeTime(Value,SQLData);
1377     Changed;
1378     end;
1379    
1380     procedure TSQLDataItem.SetAsDateTime(Value: TDateTime);
1381     begin
1382     CheckActive;
1383     if IsNullable then
1384     IsNull := False;
1385    
1386     Changing;
1387     SQLType := SQL_TIMESTAMP;
1388 tony 47 DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1389 tony 263 with FFirebirdClientAPI do
1390 tony 45 SQLEncodeDateTime(Value,SQLData);
1391     Changed;
1392     end;
1393    
1394     procedure TSQLDataItem.SetAsDouble(Value: Double);
1395     begin
1396     CheckActive;
1397     if IsNullable then
1398     IsNull := False;
1399    
1400     Changing;
1401     SQLType := SQL_DOUBLE;
1402     DataLength := SizeOf(Double);
1403     Scale := 0;
1404     PDouble(SQLData)^ := Value;
1405     Changed;
1406     end;
1407    
1408     procedure TSQLDataItem.SetAsFloat(Value: Float);
1409     begin
1410     CheckActive;
1411     if IsNullable then
1412     IsNull := False;
1413    
1414     Changing;
1415     SQLType := SQL_FLOAT;
1416     DataLength := SizeOf(Float);
1417     Scale := 0;
1418     PSingle(SQLData)^ := Value;
1419     Changed;
1420     end;
1421    
1422     procedure TSQLDataItem.SetAsLong(Value: Long);
1423     begin
1424     CheckActive;
1425     if IsNullable then
1426     IsNull := False;
1427    
1428     Changing;
1429     SQLType := SQL_LONG;
1430     DataLength := SizeOf(Long);
1431     Scale := 0;
1432     PLong(SQLData)^ := Value;
1433     Changed;
1434     end;
1435    
1436     procedure TSQLDataItem.SetAsPointer(Value: Pointer);
1437     begin
1438     CheckActive;
1439     Changing;
1440     if IsNullable and (Value = nil) then
1441     IsNull := True
1442     else
1443     begin
1444     IsNull := False;
1445     SQLType := SQL_TEXT;
1446     Move(Value^, SQLData^, DataLength);
1447     end;
1448     Changed;
1449     end;
1450    
1451     procedure TSQLDataItem.SetAsQuad(Value: TISC_QUAD);
1452     begin
1453     CheckActive;
1454     Changing;
1455     if IsNullable then
1456     IsNull := False;
1457     if (SQLType <> SQL_BLOB) and
1458     (SQLType <> SQL_ARRAY) then
1459     IBError(ibxeInvalidDataConversion, [nil]);
1460     DataLength := SizeOf(TISC_QUAD);
1461     PISC_QUAD(SQLData)^ := Value;
1462     Changed;
1463     end;
1464    
1465     procedure TSQLDataItem.SetAsShort(Value: short);
1466     begin
1467     CheckActive;
1468     Changing;
1469     if IsNullable then
1470     IsNull := False;
1471    
1472     SQLType := SQL_SHORT;
1473     DataLength := SizeOf(Short);
1474     Scale := 0;
1475     PShort(SQLData)^ := Value;
1476     Changed;
1477     end;
1478    
1479 tony 56 procedure TSQLDataItem.SetAsString(Value: AnsiString);
1480 tony 45 begin
1481     InternalSetAsString(Value);
1482     end;
1483    
1484     procedure TSQLDataItem.SetAsVariant(Value: Variant);
1485     begin
1486     CheckActive;
1487     if VarIsNull(Value) then
1488     IsNull := True
1489     else case VarType(Value) of
1490     varEmpty, varNull:
1491     IsNull := True;
1492     varSmallint, varInteger, varByte,
1493     varWord, varShortInt:
1494     AsLong := Value;
1495     varInt64:
1496     AsInt64 := Value;
1497     varSingle, varDouble:
1498     AsDouble := Value;
1499     varCurrency:
1500     AsCurrency := Value;
1501     varBoolean:
1502     AsBoolean := Value;
1503     varDate:
1504     AsDateTime := Value;
1505     varOleStr, varString:
1506     AsString := Value;
1507     varArray:
1508     IBError(ibxeNotSupported, [nil]);
1509     varByRef, varDispatch, varError, varUnknown, varVariant:
1510     IBError(ibxeNotPermitted, [nil]);
1511     end;
1512     end;
1513    
1514 tony 59 procedure TSQLDataItem.SetAsNumeric(Value: Int64; aScale: integer);
1515     begin
1516     CheckActive;
1517     Changing;
1518     if IsNullable then
1519     IsNull := False;
1520    
1521     SQLType := SQL_INT64;
1522     Scale := aScale;
1523     DataLength := SizeOf(Int64);
1524     PInt64(SQLData)^ := Value;
1525     Changed;
1526     end;
1527    
1528 tony 45 procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
1529     begin
1530     CheckActive;
1531     Changing;
1532     if IsNullable then
1533     IsNull := False;
1534    
1535     SQLType := SQL_BOOLEAN;
1536     DataLength := 1;
1537     Scale := 0;
1538     if AValue then
1539     PByte(SQLData)^ := ISC_TRUE
1540     else
1541     PByte(SQLData)^ := ISC_FALSE;
1542     Changed;
1543     end;
1544    
1545     {TColumnMetaData}
1546    
1547     procedure TColumnMetaData.CheckActive;
1548     begin
1549     if not FIBXSQLVAR.Parent.StateChanged(FChangeSeqNo) then Exit;
1550    
1551     if FPrepareSeqNo < FIBXSQLVAR.Parent.GetPrepareSeqNo then
1552     IBError(ibxeInterfaceOutofDate,[nil]);
1553    
1554     if not FIBXSQLVAR.Parent.CheckStatementStatus(ssPrepared) then
1555     IBError(ibxeStatementNotPrepared, [nil]);
1556     end;
1557    
1558 tony 56 function TColumnMetaData.SQLData: PByte;
1559 tony 45 begin
1560     Result := FIBXSQLVAR.SQLData;
1561     end;
1562    
1563     function TColumnMetaData.GetDataLength: cardinal;
1564     begin
1565     Result := FIBXSQLVAR.DataLength;
1566     end;
1567    
1568     function TColumnMetaData.GetCodePage: TSystemCodePage;
1569     begin
1570     Result := FIBXSQLVAR.GetCodePage;
1571     end;
1572    
1573     constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
1574     begin
1575 tony 263 inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
1576 tony 45 FIBXSQLVAR := aIBXSQLVAR;
1577     FOwner := aOwner;
1578     FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
1579     FIBXSQLVAR.Parent.StateChanged(FChangeSeqNo)
1580     end;
1581    
1582     destructor TColumnMetaData.Destroy;
1583     begin
1584     (FOwner as TInterfaceOwner).Remove(self);
1585     inherited Destroy;
1586     end;
1587    
1588    
1589     function TColumnMetaData.GetSQLDialect: integer;
1590     begin
1591     Result := FIBXSQLVAR.Statement.GetSQLDialect;
1592     end;
1593    
1594     function TColumnMetaData.GetIndex: integer;
1595     begin
1596     Result := FIBXSQLVAR.Index;
1597     end;
1598    
1599     function TColumnMetaData.GetSQLType: cardinal;
1600     begin
1601     CheckActive;
1602     result := FIBXSQLVAR.SQLType;
1603     end;
1604    
1605     function TColumnMetaData.getSubtype: integer;
1606     begin
1607     CheckActive;
1608     result := FIBXSQLVAR.SQLSubtype;
1609     end;
1610    
1611 tony 56 function TColumnMetaData.getRelationName: AnsiString;
1612 tony 45 begin
1613     CheckActive;
1614     result := FIBXSQLVAR.RelationName;
1615     end;
1616    
1617 tony 56 function TColumnMetaData.getOwnerName: AnsiString;
1618 tony 45 begin
1619     CheckActive;
1620     result := FIBXSQLVAR.OwnerName;
1621     end;
1622    
1623 tony 56 function TColumnMetaData.getSQLName: AnsiString;
1624 tony 45 begin
1625     CheckActive;
1626     result := FIBXSQLVAR.FieldName;
1627     end;
1628    
1629 tony 56 function TColumnMetaData.getAliasName: AnsiString;
1630 tony 45 begin
1631     CheckActive;
1632     result := FIBXSQLVAR.AliasName;
1633     end;
1634    
1635 tony 56 function TColumnMetaData.GetName: AnsiString;
1636 tony 45 begin
1637     CheckActive;
1638     Result := FIBXSQLVAR. Name;
1639     end;
1640    
1641     function TColumnMetaData.GetScale: integer;
1642     begin
1643     CheckActive;
1644     result := FIBXSQLVAR.Scale;
1645     end;
1646    
1647     function TColumnMetaData.getCharSetID: cardinal;
1648     begin
1649     CheckActive;
1650     Result := FIBXSQLVAR.CharSetID;
1651     end;
1652    
1653     function TColumnMetaData.GetIsNullable: boolean;
1654     begin
1655     CheckActive;
1656     result := FIBXSQLVAR.IsNullable;
1657     end;
1658    
1659     function TColumnMetaData.GetSize: cardinal;
1660     begin
1661     CheckActive;
1662     result := FIBXSQLVAR.DataLength;
1663     end;
1664    
1665     function TColumnMetaData.GetArrayMetaData: IArrayMetaData;
1666     begin
1667     CheckActive;
1668     result := FIBXSQLVAR.GetArrayMetaData;
1669     end;
1670    
1671     function TColumnMetaData.GetBlobMetaData: IBlobMetaData;
1672     begin
1673     CheckActive;
1674     result := FIBXSQLVAR.GetBlobMetaData;
1675     end;
1676    
1677     { TIBSQLData }
1678    
1679     procedure TIBSQLData.CheckActive;
1680     begin
1681     if not FIBXSQLVAR.Parent.StateChanged(FChangeSeqNo) then Exit;
1682    
1683     inherited CheckActive;
1684    
1685     if not FIBXSQLVAR.Parent.CheckStatementStatus(ssCursorOpen) and
1686     not FIBXSQLVAR.Parent.CheckStatementStatus(ssExecuteResults) then
1687     IBError(ibxeSQLClosed, [nil]);
1688    
1689     if FIBXSQLVAR.Parent.CheckStatementStatus(ssEOF) then
1690     IBError(ibxeEOF,[nil]);
1691    
1692     if FIBXSQLVAR.Parent.CheckStatementStatus(ssBOF) then
1693     IBError(ibxeBOF,[nil]);
1694     end;
1695    
1696     function TIBSQLData.GetIsNull: Boolean;
1697     begin
1698     CheckActive;
1699     result := FIBXSQLVAR.IsNull;
1700     end;
1701    
1702     function TIBSQLData.GetAsArray: IArray;
1703     begin
1704     CheckActive;
1705     result := FIBXSQLVAR.GetAsArray(AsQuad);
1706     end;
1707    
1708     function TIBSQLData.GetAsBlob: IBlob;
1709     begin
1710     CheckActive;
1711     result := FIBXSQLVAR.GetAsBlob(AsQuad,nil);
1712     end;
1713    
1714     function TIBSQLData.GetAsBlob(BPB: IBPB): IBlob;
1715     begin
1716     CheckActive;
1717     result := FIBXSQLVAR.GetAsBlob(AsQuad,BPB);
1718     end;
1719    
1720 tony 56 function TIBSQLData.GetAsString: AnsiString;
1721 tony 45 begin
1722     CheckActive;
1723     Result := '';
1724     { Check null, if so return a default string }
1725     if not IsNull then
1726     case SQLType of
1727     SQL_ARRAY:
1728 tony 47 result := SArray;
1729 tony 45 SQL_BLOB:
1730 tony 47 Result := FIBXSQLVAR.GetAsBlob(AsQuad,nil).GetAsString;
1731 tony 45 else
1732     Result := inherited GetAsString;
1733     end;
1734     end;
1735    
1736     { TSQLParam }
1737    
1738 tony 56 procedure TSQLParam.InternalSetAsString(Value: AnsiString);
1739 tony 270
1740     procedure DoSetString;
1741     begin
1742     Changing;
1743     FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1744     Changed;
1745     end;
1746    
1747 tony 45 var b: IBlob;
1748 tony 59 dt: TDateTime;
1749 tony 270 CurrValue: Currency;
1750     FloatValue: single;
1751 tony 45 begin
1752     CheckActive;
1753     if IsNullable then
1754     IsNull := False;
1755     case SQLTYPE of
1756     SQL_BOOLEAN:
1757 tony 56 if AnsiCompareText(Value,STrue) = 0 then
1758 tony 45 AsBoolean := true
1759     else
1760 tony 56 if AnsiCompareText(Value,SFalse) = 0 then
1761 tony 45 AsBoolean := false
1762     else
1763     IBError(ibxeInvalidDataConversion,[nil]);
1764    
1765     SQL_BLOB:
1766     begin
1767     Changing;
1768     b := FIBXSQLVAR.CreateBlob;
1769     b.SetAsString(Value);
1770     AsBlob := b;
1771     Changed;
1772     end;
1773    
1774     SQL_VARYING,
1775     SQL_TEXT:
1776 tony 270 DoSetString;
1777 tony 45
1778     SQL_SHORT,
1779     SQL_LONG,
1780     SQL_INT64:
1781 tony 270 if TryStrToCurr(Value,CurrValue) then
1782     SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
1783     else
1784     DoSetString;
1785 tony 45
1786     SQL_D_FLOAT,
1787     SQL_DOUBLE,
1788     SQL_FLOAT:
1789 tony 270 if TryStrToFloat(Value,FloatValue) then
1790     SetAsDouble(FloatValue)
1791     else
1792     DoSetString;
1793 tony 45
1794     SQL_TIMESTAMP:
1795 tony 59 if TryStrToDateTime(Value,dt) then
1796     SetAsDateTime(dt)
1797     else
1798 tony 270 DoSetString;
1799 tony 45
1800     SQL_TYPE_DATE:
1801 tony 59 if TryStrToDateTime(Value,dt) then
1802     SetAsDate(dt)
1803     else
1804 tony 270 DoSetString;
1805 tony 45
1806     SQL_TYPE_TIME:
1807 tony 59 if TryStrToDateTime(Value,dt) then
1808     SetAsTime(dt)
1809     else
1810 tony 270 DoSetString;
1811 tony 45
1812     else
1813     IBError(ibxeInvalidDataConversion,[nil]);
1814     end;
1815     end;
1816    
1817     procedure TSQLParam.CheckActive;
1818     begin
1819     if not FIBXSQLVAR.Parent.StateChanged(FChangeSeqNo) then Exit;
1820    
1821     if FPrepareSeqNo < FIBXSQLVAR.Parent.GetPrepareSeqNo then
1822     IBError(ibxeInterfaceOutofDate,[nil]);
1823    
1824     if not FIBXSQLVAR.Parent.CheckStatementStatus(ssPrepared) then
1825     IBError(ibxeStatementNotPrepared, [nil]);
1826     end;
1827    
1828     procedure TSQLParam.SetScale(aValue: integer);
1829     begin
1830     CheckActive;
1831     FIBXSQLVAR.Scale := aValue;
1832     end;
1833    
1834     procedure TSQLParam.SetDataLength(len: cardinal);
1835     begin
1836     CheckActive;
1837     FIBXSQLVAR.DataLength := len;
1838     end;
1839    
1840     procedure TSQLParam.SetSQLType(aValue: cardinal);
1841     begin
1842     CheckActive;
1843     FIBXSQLVAR.SQLType := aValue;
1844     end;
1845    
1846     procedure TSQLParam.Clear;
1847     begin
1848     IsNull := true;
1849     end;
1850    
1851     function TSQLParam.GetModified: boolean;
1852     begin
1853     CheckActive;
1854     Result := FIBXSQLVAR.Modified;
1855     end;
1856    
1857     function TSQLParam.GetAsPointer: Pointer;
1858     begin
1859     IsNull := false; {Assume that we get the pointer in order to set a value}
1860     Changed;
1861     Result := inherited GetAsPointer;
1862     end;
1863    
1864 tony 56 procedure TSQLParam.SetName(Value: AnsiString);
1865 tony 45 begin
1866     CheckActive;
1867     FIBXSQLVAR.Name := Value;
1868     end;
1869    
1870     procedure TSQLParam.SetIsNull(Value: Boolean);
1871     var i: integer;
1872     begin
1873     CheckActive;
1874     if FIBXSQLVAR.UniqueName then
1875     FIBXSQLVAR.IsNull := Value
1876     else
1877     with FIBXSQLVAR.Parent do
1878     begin
1879     for i := 0 to Count - 1 do
1880     if Column[i].Name = Name then
1881     Column[i].IsNull := Value;
1882     end
1883     end;
1884    
1885     procedure TSQLParam.SetIsNullable(Value: Boolean);
1886     var i: integer;
1887     begin
1888     CheckActive;
1889     if FIBXSQLVAR.UniqueName then
1890     FIBXSQLVAR.IsNullable := Value
1891     else
1892     with FIBXSQLVAR.Parent do
1893     begin
1894     for i := 0 to Count - 1 do
1895     if Column[i].Name = Name then
1896     Column[i].IsNullable := Value;
1897     end
1898     end;
1899    
1900     procedure TSQLParam.SetAsArray(anArray: IArray);
1901     begin
1902     CheckActive;
1903     if GetSQLType <> SQL_ARRAY then
1904     IBError(ibxeInvalidDataConversion,[nil]);
1905    
1906     if not FIBXSQLVAR.UniqueName then
1907     IBError(ibxeDuplicateParamName,[FIBXSQLVAR.Name]);
1908    
1909     SetAsQuad(AnArray.GetArrayID);
1910     end;
1911    
1912     procedure TSQLParam.Changed;
1913     begin
1914     FIBXSQLVAR.Changed;
1915     end;
1916    
1917     procedure TSQLParam.SetAsBoolean(AValue: boolean);
1918     var i: integer;
1919     OldSQLVar: TSQLVarData;
1920     begin
1921     if FIBXSQLVAR.UniqueName then
1922     inherited SetAsBoolean(AValue)
1923     else
1924     with FIBXSQLVAR.Parent do
1925     begin
1926     for i := 0 to Count - 1 do
1927     if Column[i].Name = Name then
1928     begin
1929     OldSQLVar := FIBXSQLVAR;
1930     FIBXSQLVAR := Column[i];
1931     try
1932     inherited SetAsBoolean(AValue);
1933     finally
1934     FIBXSQLVAR := OldSQLVar;
1935     end;
1936     end;
1937     end;
1938     end;
1939    
1940     procedure TSQLParam.SetAsCurrency(AValue: Currency);
1941     var i: integer;
1942     OldSQLVar: TSQLVarData;
1943     begin
1944     if FIBXSQLVAR.UniqueName then
1945     inherited SetAsCurrency(AValue)
1946     else
1947     with FIBXSQLVAR.Parent do
1948     begin
1949     for i := 0 to Count - 1 do
1950     if Column[i].Name = Name then
1951     begin
1952     OldSQLVar := FIBXSQLVAR;
1953     FIBXSQLVAR := Column[i];
1954     try
1955     inherited SetAsCurrency(AValue);
1956     finally
1957     FIBXSQLVAR := OldSQLVar;
1958     end;
1959     end;
1960     end;
1961     end;
1962    
1963     procedure TSQLParam.SetAsInt64(AValue: Int64);
1964     var i: integer;
1965     OldSQLVar: TSQLVarData;
1966     begin
1967     if FIBXSQLVAR.UniqueName then
1968     inherited SetAsInt64(AValue)
1969     else
1970     with FIBXSQLVAR.Parent do
1971     begin
1972     for i := 0 to Count - 1 do
1973     if Column[i].Name = Name then
1974     begin
1975     OldSQLVar := FIBXSQLVAR;
1976     FIBXSQLVAR := Column[i];
1977     try
1978     inherited SetAsInt64(AValue);
1979     finally
1980     FIBXSQLVAR := OldSQLVar;
1981     end;
1982     end;
1983     end;
1984     end;
1985    
1986     procedure TSQLParam.SetAsDate(AValue: TDateTime);
1987     var i: integer;
1988     OldSQLVar: TSQLVarData;
1989     begin
1990     if FIBXSQLVAR.UniqueName then
1991     inherited SetAsDate(AValue)
1992     else
1993     with FIBXSQLVAR.Parent do
1994     begin
1995     for i := 0 to Count - 1 do
1996     if Column[i].Name = Name then
1997     begin
1998     OldSQLVar := FIBXSQLVAR;
1999     FIBXSQLVAR := Column[i];
2000     try
2001     inherited SetAsDate(AValue);
2002     finally
2003     FIBXSQLVAR := OldSQLVar;
2004     end;
2005     end;
2006     end;
2007     end;
2008    
2009     procedure TSQLParam.SetAsLong(AValue: Long);
2010     var i: integer;
2011     OldSQLVar: TSQLVarData;
2012     begin
2013     if FIBXSQLVAR.UniqueName then
2014     inherited SetAsLong(AValue)
2015     else
2016     with FIBXSQLVAR.Parent do
2017     begin
2018     for i := 0 to Count - 1 do
2019     if Column[i].Name = Name then
2020     begin
2021     OldSQLVar := FIBXSQLVAR;
2022     FIBXSQLVAR := Column[i];
2023     try
2024     inherited SetAsLong(AValue);
2025     finally
2026     FIBXSQLVAR := OldSQLVar;
2027     end;
2028     end;
2029     end;
2030     end;
2031    
2032     procedure TSQLParam.SetAsTime(AValue: TDateTime);
2033     var i: integer;
2034     OldSQLVar: TSQLVarData;
2035     begin
2036     if FIBXSQLVAR.UniqueName then
2037     inherited SetAsTime(AValue)
2038     else
2039     with FIBXSQLVAR.Parent do
2040     begin
2041     for i := 0 to Count - 1 do
2042     if Column[i].Name = Name then
2043     begin
2044     OldSQLVar := FIBXSQLVAR;
2045     FIBXSQLVAR := Column[i];
2046     try
2047     inherited SetAsTime(AValue);
2048     finally
2049     FIBXSQLVAR := OldSQLVar;
2050     end;
2051     end;
2052     end;
2053     end;
2054    
2055     procedure TSQLParam.SetAsDateTime(AValue: TDateTime);
2056     var i: integer;
2057     OldSQLVar: TSQLVarData;
2058     begin
2059     if FIBXSQLVAR.UniqueName then
2060     inherited SetAsDateTime(AValue)
2061     else
2062     with FIBXSQLVAR.Parent do
2063     begin
2064     for i := 0 to Count - 1 do
2065     if Column[i].Name = Name then
2066     begin
2067     OldSQLVar := FIBXSQLVAR;
2068     FIBXSQLVAR := Column[i];
2069     try
2070     inherited SetAsDateTime(AValue);
2071     finally
2072     FIBXSQLVAR := OldSQLVar;
2073     end;
2074     end;
2075     end;
2076     end;
2077    
2078     procedure TSQLParam.SetAsDouble(AValue: Double);
2079     var i: integer;
2080     OldSQLVar: TSQLVarData;
2081     begin
2082     if FIBXSQLVAR.UniqueName then
2083     inherited SetAsDouble(AValue)
2084     else
2085     with FIBXSQLVAR.Parent do
2086     begin
2087     for i := 0 to Count - 1 do
2088     if Column[i].Name = Name then
2089     begin
2090     OldSQLVar := FIBXSQLVAR;
2091     FIBXSQLVAR := Column[i];
2092     try
2093     inherited SetAsDouble(AValue);
2094     finally
2095     FIBXSQLVAR := OldSQLVar;
2096     end;
2097     end;
2098     end;
2099     end;
2100    
2101     procedure TSQLParam.SetAsFloat(AValue: Float);
2102     var i: integer;
2103     OldSQLVar: TSQLVarData;
2104     begin
2105     if FIBXSQLVAR.UniqueName then
2106     inherited SetAsFloat(AValue)
2107     else
2108     with FIBXSQLVAR.Parent do
2109     begin
2110     for i := 0 to Count - 1 do
2111     if Column[i].Name = Name then
2112     begin
2113     OldSQLVar := FIBXSQLVAR;
2114     FIBXSQLVAR := Column[i];
2115     try
2116     inherited SetAsFloat(AValue);
2117     finally
2118     FIBXSQLVAR := OldSQLVar;
2119     end;
2120     end;
2121     end;
2122     end;
2123    
2124     procedure TSQLParam.SetAsPointer(AValue: Pointer);
2125     var i: integer;
2126     OldSQLVar: TSQLVarData;
2127     begin
2128     if FIBXSQLVAR.UniqueName then
2129     inherited SetAsPointer(AValue)
2130     else
2131     with FIBXSQLVAR.Parent do
2132     begin
2133     for i := 0 to Count - 1 do
2134     if Column[i].Name = Name then
2135     begin
2136     OldSQLVar := FIBXSQLVAR;
2137     FIBXSQLVAR := Column[i];
2138     try
2139     inherited SetAsPointer(AValue);
2140     finally
2141     FIBXSQLVAR := OldSQLVar;
2142     end;
2143     end;
2144     end;
2145     end;
2146    
2147     procedure TSQLParam.SetAsShort(AValue: Short);
2148     var i: integer;
2149     OldSQLVar: TSQLVarData;
2150     begin
2151     if FIBXSQLVAR.UniqueName then
2152     inherited SetAsShort(AValue)
2153     else
2154     with FIBXSQLVAR.Parent do
2155     begin
2156     for i := 0 to Count - 1 do
2157     if Column[i].Name = Name then
2158     begin
2159     OldSQLVar := FIBXSQLVAR;
2160     FIBXSQLVAR := Column[i];
2161     try
2162     inherited SetAsShort(AValue);
2163     finally
2164     FIBXSQLVAR := OldSQLVar;
2165     end;
2166     end;
2167     end;
2168     end;
2169    
2170 tony 56 procedure TSQLParam.SetAsString(AValue: AnsiString);
2171 tony 45 var i: integer;
2172     OldSQLVar: TSQLVarData;
2173     begin
2174     if FIBXSQLVAR.UniqueName then
2175     InternalSetAsString(AValue)
2176     else
2177     with FIBXSQLVAR.Parent do
2178     begin
2179     for i := 0 to Count - 1 do
2180     if Column[i].Name = Name then
2181     begin
2182     OldSQLVar := FIBXSQLVAR;
2183     FIBXSQLVAR := Column[i];
2184     try
2185     InternalSetAsString(AValue);
2186     finally
2187     FIBXSQLVAR := OldSQLVar;
2188     end;
2189     end;
2190     end;
2191     end;
2192    
2193     procedure TSQLParam.SetAsVariant(AValue: Variant);
2194     var i: integer;
2195     OldSQLVar: TSQLVarData;
2196     begin
2197     if FIBXSQLVAR.UniqueName then
2198     inherited SetAsVariant(AValue)
2199     else
2200     with FIBXSQLVAR.Parent do
2201     begin
2202     for i := 0 to Count - 1 do
2203     if Column[i].Name = Name then
2204     begin
2205     OldSQLVar := FIBXSQLVAR;
2206     FIBXSQLVAR := Column[i];
2207     try
2208     inherited SetAsVariant(AValue);
2209     finally
2210     FIBXSQLVAR := OldSQLVar;
2211     end;
2212     end;
2213     end;
2214     end;
2215    
2216     procedure TSQLParam.SetAsBlob(aValue: IBlob);
2217     begin
2218     with FIBXSQLVAR do
2219     if not UniqueName then
2220     IBError(ibxeDuplicateParamName,[Name]);
2221     CheckActive;
2222     Changing;
2223     aValue.Close;
2224     if aValue.GetSubType <> GetSubType then
2225     IBError(ibxeIncompatibleBlob,[GetSubType,aValue.GetSubType]);
2226     AsQuad := aValue.GetBlobID;
2227     Changed;
2228     end;
2229    
2230     procedure TSQLParam.SetAsQuad(AValue: TISC_QUAD);
2231     var i: integer;
2232     OldSQLVar: TSQLVarData;
2233     begin
2234     if FIBXSQLVAR.UniqueName then
2235     inherited SetAsQuad(AValue)
2236     else
2237     with FIBXSQLVAR.Parent do
2238     begin
2239     for i := 0 to Count - 1 do
2240     if Column[i].Name = Name then
2241     begin
2242     OldSQLVar := FIBXSQLVAR;
2243     FIBXSQLVAR := Column[i];
2244     try
2245     inherited SetAsQuad(AValue);
2246     finally
2247     FIBXSQLVAR := OldSQLVar;
2248     end;
2249     end;
2250     end;
2251     end;
2252    
2253     procedure TSQLParam.SetCharSetID(aValue: cardinal);
2254     begin
2255     FIBXSQLVAR.SetCharSetID(aValue);
2256     end;
2257    
2258     { TMetaData }
2259    
2260     procedure TMetaData.CheckActive;
2261     begin
2262     if FPrepareSeqNo < FMetaData.PrepareSeqNo then
2263     IBError(ibxeInterfaceOutofDate,[nil]);
2264    
2265     if not FMetaData.CheckStatementStatus(ssPrepared) then
2266     IBError(ibxeStatementNotPrepared, [nil]);
2267     end;
2268    
2269     constructor TMetaData.Create(aMetaData: TSQLDataArea);
2270     begin
2271     inherited Create(aMetaData.Count);
2272     FMetaData := aMetaData;
2273     FStatement := aMetaData.Statement;
2274     FPrepareSeqNo := aMetaData.PrepareSeqNo;
2275     end;
2276    
2277     destructor TMetaData.Destroy;
2278     begin
2279     (FStatement as TInterfaceOwner).Remove(self);
2280     inherited Destroy;
2281     end;
2282    
2283 tony 56 function TMetaData.GetUniqueRelationName: AnsiString;
2284 tony 45 begin
2285     CheckActive;
2286     Result := FMetaData.UniqueRelationName;
2287     end;
2288    
2289     function TMetaData.getCount: integer;
2290     begin
2291     CheckActive;
2292     Result := FMetaData.ColumnsInUseCount;
2293     end;
2294    
2295     function TMetaData.getColumnMetaData(index: integer): IColumnMetaData;
2296     begin
2297     CheckActive;
2298     if (index < 0) or (index >= getCount) then
2299     IBError(ibxeInvalidColumnIndex,[nil]);
2300    
2301     if FMetaData.Count = 0 then
2302     Result := nil
2303     else
2304     begin
2305     if not HasInterface(index) then
2306     AddInterface(index,TColumnMetaData.Create(self,FMetaData.Column[index]));
2307     Result := TColumnMetaData(GetInterface(index));
2308     end;
2309     end;
2310    
2311 tony 56 function TMetaData.ByName(Idx: AnsiString): IColumnMetaData;
2312 tony 45 var aIBXSQLVAR: TSQLVarData;
2313     begin
2314     CheckActive;
2315     aIBXSQLVAR := FMetaData.ColumnByName(Idx);
2316     if aIBXSQLVAR = nil then
2317     IBError(ibxeFieldNotFound,[Idx]);
2318     Result := getColumnMetaData(aIBXSQLVAR.index);
2319     end;
2320    
2321     { TSQLParams }
2322    
2323     procedure TSQLParams.CheckActive;
2324     begin
2325     if not FSQLParams.StateChanged(FChangeSeqNo) then Exit;
2326    
2327     if FPrepareSeqNo < FSQLParams.PrepareSeqNo then
2328     IBError(ibxeInterfaceOutofDate,[nil]);
2329    
2330     if not FSQLParams.CheckStatementStatus(ssPrepared) then
2331     IBError(ibxeStatementNotPrepared, [nil]);
2332     end;
2333    
2334     constructor TSQLParams.Create(aSQLParams: TSQLDataArea);
2335     begin
2336     inherited Create(aSQLParams.Count);
2337     FSQLParams := aSQLParams;
2338     FStatement := aSQLParams.Statement;
2339     FPrepareSeqNo := aSQLParams.PrepareSeqNo;
2340     FSQLParams.StateChanged(FChangeSeqNo);
2341     end;
2342    
2343     destructor TSQLParams.Destroy;
2344     begin
2345     (FStatement as TInterfaceOwner).Remove(self);
2346     inherited Destroy;
2347     end;
2348    
2349     function TSQLParams.getCount: integer;
2350     begin
2351     CheckActive;
2352     Result := FSQLParams.ColumnsInUseCount;
2353     end;
2354    
2355     function TSQLParams.getSQLParam(index: integer): ISQLParam;
2356     begin
2357     CheckActive;
2358     if (index < 0) or (index >= getCount) then
2359     IBError(ibxeInvalidColumnIndex,[nil]);
2360    
2361     if getCount = 0 then
2362     Result := nil
2363     else
2364     begin
2365     if not HasInterface(index) then
2366     AddInterface(index, TSQLParam.Create(self,FSQLParams.Column[index]));
2367     Result := TSQLParam(GetInterface(index));
2368     end;
2369     end;
2370    
2371 tony 56 function TSQLParams.ByName(Idx: AnsiString): ISQLParam;
2372 tony 45 var aIBXSQLVAR: TSQLVarData;
2373     begin
2374     CheckActive;
2375     aIBXSQLVAR := FSQLParams.ColumnByName(Idx);
2376     if aIBXSQLVAR = nil then
2377     IBError(ibxeFieldNotFound,[Idx]);
2378     Result := getSQLParam(aIBXSQLVAR.index);
2379     end;
2380    
2381     function TSQLParams.GetModified: Boolean;
2382     var
2383     i: Integer;
2384     begin
2385     CheckActive;
2386     result := False;
2387     with FSQLParams do
2388     for i := 0 to Count - 1 do
2389     if Column[i].Modified then
2390     begin
2391     result := True;
2392     exit;
2393     end;
2394     end;
2395    
2396 tony 287 function TSQLParams.GetHasCaseSensitiveParams: Boolean;
2397     begin
2398     Result := FSQLParams.CaseSensitiveParams;
2399     end;
2400    
2401 tony 45 { TResults }
2402    
2403     procedure TResults.CheckActive;
2404     begin
2405     if not FResults.StateChanged(FChangeSeqNo) then Exit;
2406    
2407     if FPrepareSeqNo < FResults.PrepareSeqNo then
2408     IBError(ibxeInterfaceOutofDate,[nil]);
2409    
2410     if not FResults.CheckStatementStatus(ssPrepared) then
2411     IBError(ibxeStatementNotPrepared, [nil]);
2412    
2413     with GetTransaction as TFBTransaction do
2414     if not InTransaction or (FResults.TransactionSeqNo <> FTransactionSeqNo) then
2415     IBError(ibxeInterfaceOutofDate,[nil]);
2416     end;
2417    
2418     function TResults.GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
2419     begin
2420     if (aIBXSQLVAR.Index < 0) or (aIBXSQLVAR.Index >= getCount) then
2421     IBError(ibxeInvalidColumnIndex,[nil]);
2422    
2423     if not HasInterface(aIBXSQLVAR.Index) then
2424     AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
2425     Result := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
2426     end;
2427    
2428     constructor TResults.Create(aResults: TSQLDataArea);
2429     begin
2430     inherited Create(aResults.Count);
2431     FResults := aResults;
2432     FStatement := aResults.Statement;
2433     FPrepareSeqNo := aResults.PrepareSeqNo;
2434     FTransactionSeqNo := aResults.TransactionSeqNo;
2435     FResults.StateChanged(FChangeSeqNo);
2436     end;
2437    
2438     function TResults.getCount: integer;
2439     begin
2440     CheckActive;
2441     Result := FResults.Count;
2442     end;
2443    
2444 tony 56 function TResults.ByName(Idx: AnsiString): ISQLData;
2445 tony 45 var col: TSQLVarData;
2446     begin
2447     Result := nil;
2448     CheckActive;
2449     if FResults.CheckStatementStatus(ssBOF) then
2450     IBError(ibxeBOF,[nil]);
2451     if FResults.CheckStatementStatus(ssEOF) then
2452     IBError(ibxeEOF,[nil]);
2453    
2454     if FResults.Count > 0 then
2455     begin
2456     col := FResults.ColumnByName(Idx);
2457     if col <> nil then
2458     Result := GetISQLData(col);
2459     end;
2460     end;
2461    
2462     function TResults.getSQLData(index: integer): ISQLData;
2463     begin
2464     CheckActive;
2465     if FResults.CheckStatementStatus(ssBOF) then
2466     IBError(ibxeBOF,[nil]);
2467     if FResults.CheckStatementStatus(ssEOF) then
2468     IBError(ibxeEOF,[nil]);
2469     if (index < 0) or (index >= FResults.Count) then
2470     IBError(ibxeInvalidColumnIndex,[nil]);
2471    
2472     Result := GetISQLData(FResults.Column[index]);
2473     end;
2474    
2475     procedure TResults.GetData(index: integer; var IsNull: boolean; var len: short;
2476 tony 56 var data: PByte);
2477 tony 45 begin
2478     CheckActive;
2479     FResults.GetData(index,IsNull, len,data);
2480     end;
2481    
2482     function TResults.GetTransaction: ITransaction;
2483     begin
2484     Result := FStatement.GetTransaction;
2485     end;
2486    
2487     procedure TResults.SetRetainInterfaces(aValue: boolean);
2488     begin
2489     RetainInterfaces := aValue;
2490     end;
2491    
2492     end.
2493