ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/FBSQLData.pas
Revision: 291
Committed: Fri Apr 17 10:26:08 2020 UTC (4 years ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/FBSQLData.pas
File size: 65605 byte(s)
Log Message:
Changed for 2.3.4 merged into public release

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