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

File Contents

# Content
1 (*
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 {$IFDEF MSWINDOWS}
64 {$DEFINE WINDOWS}
65 {$ENDIF}
66
67 {$IFDEF FPC}
68 {$mode delphi}
69 {$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 Classes, SysUtils, IBExternals, IBHeader, IB, FBActivityMonitor, FBClientAPI;
84
85 type
86
87 { TSQLDataItem }
88
89 TSQLDataItem = class(TFBInterfacedObject)
90 private
91 FFirebirdClientAPI: TFBClientAPI;
92 function AdjustScale(Value: Int64; aScale: Integer): Double;
93 function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
94 function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
95 function GetTimestampFormatStr: AnsiString;
96 function GetDateFormatStr(IncludeTime: boolean): AnsiString;
97 function GetTimeFormatStr: AnsiString;
98 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 procedure InternalSetAsString(Value: AnsiString); virtual;
107 function SQLData: PByte; virtual; abstract;
108 function GetDataLength: cardinal; virtual; abstract;
109 function GetCodePage: TSystemCodePage; virtual; abstract;
110 function getCharSetID: cardinal; virtual; abstract;
111 function Transliterate(s: AnsiString; CodePage: TSystemCodePage): RawByteString;
112 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 constructor Create(api: TFBClientAPI);
119 function GetSQLType: cardinal; virtual; abstract;
120 function GetSQLTypeName: AnsiString; overload;
121 class function GetSQLTypeName(SQLType: short): AnsiString; overload;
122 function GetStrDataLength: short;
123 function GetName: AnsiString; virtual; abstract;
124 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 function GetAsString: AnsiString; virtual;
136 function GetIsNull: Boolean; virtual;
137 function GetIsNullable: boolean; virtual;
138 function GetAsVariant: Variant;
139 function GetModified: boolean; virtual;
140 function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
141 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 procedure SetAsString(Value: AnsiString); virtual;
154 procedure SetAsVariant(Value: Variant);
155 procedure SetAsNumeric(Value: Int64; aScale: integer);
156 procedure SetIsNull(Value: Boolean); virtual;
157 procedure SetIsNullable(Value: Boolean); virtual;
158 procedure SetName(aValue: AnsiString); virtual;
159 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 property AsString: AnsiString read GetAsString write SetAsString;
173 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 FCaseSensitiveParams: boolean;
190 function GetColumn(index: integer): TSQLVarData;
191 function GetCount: integer;
192 protected
193 FUniqueRelationName: AnsiString;
194 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 procedure PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
204 var sProcessedSQL: AnsiString);
205 function ColumnsInUseCount: integer; virtual;
206 function ColumnByName(Idx: AnsiString): TSQLVarData;
207 function CheckStatementStatus(Request: TStatementStatus): boolean; virtual; abstract;
208 procedure GetData(index: integer; var IsNull: boolean; var len: short;
209 var data: PByte); virtual;
210 procedure RowChange;
211 function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
212 property CaseSensitiveParams: boolean read FCaseSensitiveParams
213 write FCaseSensitiveParams; {Only used when IsInputDataArea true}
214 property Count: integer read GetCount;
215 property Column[index: integer]: TSQLVarData read GetColumn;
216 property UniqueRelationName: AnsiString read FUniqueRelationName;
217 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 FName: AnsiString;
228 FIndex: integer;
229 FModified: boolean;
230 FUniqueName: boolean;
231 FVarString: RawByteString;
232 function GetStatement: IStatement;
233 procedure SetName(AValue: AnsiString);
234 protected
235 function GetSQLType: cardinal; virtual; abstract;
236 function GetSubtype: integer; virtual; abstract;
237 function GetAliasName: AnsiString; virtual; abstract;
238 function GetFieldName: AnsiString; virtual; abstract;
239 function GetOwnerName: AnsiString; virtual; abstract;
240 function GetRelationName: AnsiString; virtual; abstract;
241 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 function GetSQLData: PByte; virtual; abstract;
247 function GetDataLength: cardinal; virtual; abstract;
248 procedure SetIsNull(Value: Boolean); virtual; abstract;
249 procedure SetIsNullable(Value: Boolean); virtual; abstract;
250 procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
251 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 procedure SetString(aValue: AnsiString);
258 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 property AliasName: AnsiString read GetAliasName;
269 property FieldName: AnsiString read GetFieldName;
270 property OwnerName: AnsiString read GetOwnerName;
271 property RelationName: AnsiString read GetRelationName;
272 property Parent: TSQLDataArea read FParent;
273 property Index: integer read FIndex;
274 property Name: AnsiString read FName write SetName;
275 property CharSetID: cardinal read GetCharSetID write SetCharSetID;
276 property SQLType: cardinal read GetSQLType write SetSQLType;
277 property SQLSubtype: integer read GetSubtype;
278 property SQLData: PByte read GetSQLData;
279 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 function SQLData: PByte; override;
300 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 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 function GetScale: integer; override;
319 function getCharSetID: cardinal; override;
320 function GetIsNullable: boolean; override;
321 function GetSize: cardinal;
322 function GetArrayMetaData: IArrayMetaData;
323 function GetBlobMetaData: IBlobMetaData;
324 function GetStatement: IStatement;
325 function GetTransaction: ITransaction; virtual;
326 property Name: AnsiString read GetName;
327 property Size: cardinal read GetSize;
328 property CharSetID: cardinal read getCharSetID;
329 property SQLSubtype: integer read getSubtype;
330 property IsNullable: Boolean read GetIsNullable;
331 public
332 property Statement: IStatement read GetStatement;
333 end;
334
335 { TIBSQLData }
336
337 TIBSQLData = class(TColumnMetaData,ISQLData)
338 private
339 FTransaction: ITransaction;
340 protected
341 procedure CheckActive; override;
342 public
343 function GetTransaction: ITransaction; override;
344 function GetIsNull: Boolean; override;
345 function GetAsArray: IArray;
346 function GetAsBlob: IBlob; overload;
347 function GetAsBlob(BPB: IBPB): IBlob; overload;
348 function GetAsString: AnsiString; override;
349 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 procedure InternalSetAsString(Value: AnsiString); override;
359 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 procedure SetName(Value: AnsiString); override;
367 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 procedure SetAsString(AValue: AnsiString); override;
384 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 function GetUniqueRelationName: AnsiString;
407 function getCount: integer;
408 function getColumnMetaData(index: integer): IColumnMetaData;
409 function ByName(Idx: AnsiString): IColumnMetaData;
410 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 function ByName(Idx: AnsiString): ISQLParam ;
429 function GetModified: Boolean;
430 function GetHasCaseSensitiveParams: Boolean;
431 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 function ByName(Idx: AnsiString): ISQLData;
450 function getSQLData(index: integer): ISQLData;
451 procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
452 function GetStatement: IStatement;
453 function GetTransaction: ITransaction; virtual;
454 procedure SetRetainInterfaces(aValue: boolean);
455 end;
456
457 implementation
458
459 uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
460
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 RelationName: AnsiString;
480 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 procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
511 var sProcessedSQL: AnsiString);
512
513 var slNames: TStrings;
514
515 procedure SetColumnNames(slNames: TStrings);
516 var i, j: integer;
517 found: boolean;
518 begin
519 found := false;
520 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 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 finally
551 slNames.Free;
552 end;
553 end;
554
555 function TSQLDataArea.ColumnsInUseCount: integer;
556 begin
557 Result := Count;
558 end;
559
560 function TSQLDataArea.ColumnByName(Idx: AnsiString): TSQLVarData;
561 var
562 s: AnsiString;
563 i: Integer;
564 begin
565 if not IsInputDataArea or not CaseSensitiveParams then
566 s := AnsiUpperCase(Idx)
567 else
568 s := Idx;
569
570 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 var len: short; var data: PByte);
581 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 procedure TSQLVarData.SetName(AValue: AnsiString);
600 begin
601 if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
602 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 procedure TSQLVarData.SetString(aValue: AnsiString);
616 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 SQLVar. This avoids string copies. Note that PAnsiChar is guaranteed to point to
620 a zero byte when the string is empty, neatly avoiding a nil pointer error.}
621
622 FVarString := aValue;
623 SQLType := SQL_TEXT;
624 Scale := 0;
625 SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
626 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 function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
642 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 st: AnsiString;
657 sBaseName: AnsiString;
658 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 FractionText, PadText, CurrText: AnsiString;
745 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 {$IF declared(DefaultFormatSettings)}
764 with DefaultFormatSettings do
765 {$ELSE}
766 {$IF declared(FormatSettings)}
767 with FormatSettings do
768 {$IFEND}
769 {$IFEND}
770 if Value < 0 then
771 CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
772 else
773 CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
774 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 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 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 procedure TSQLDataItem.InternalSetAsString(Value: AnsiString);
900 begin
901 //Do nothing by default
902 end;
903
904 function TSQLDataItem.Transliterate(s: AnsiString; CodePage: TSystemCodePage
905 ): 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 constructor TSQLDataItem.Create(api: TFBClientAPI);
928 begin
929 inherited Create;
930 FFirebirdClientAPI := api;
931 end;
932
933 function TSQLDataItem.GetSQLTypeName: AnsiString;
934 begin
935 Result := GetSQLTypeName(GetSQLType);
936 end;
937
938 class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
939 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 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 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 with FFirebirdClientAPI do
1049 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 function TSQLDataItem.GetAsString: AnsiString;
1179 var
1180 sz: PByte;
1181 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 with FFirebirdClientAPI do
1189 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 SetString(rs, PAnsiChar(sz), str_len);
1206 SetCodePage(rs,GetCodePage,false);
1207 if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1208 Result := TrimRight(rs)
1209 else
1210 Result := rs
1211 end;
1212 SQL_TYPE_DATE:
1213 result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1214 SQL_TYPE_TIME :
1215 result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1216 SQL_TIMESTAMP:
1217 result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1218 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 function TSQLDataItem.GetIsNullable: boolean;
1246 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 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
1308
1309 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 procedure TSQLDataItem.SetName(aValue: AnsiString);
1320 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 with FFirebirdClientAPI do
1372 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 with FFirebirdClientAPI do
1392 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 DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1405 with FFirebirdClientAPI do
1406 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 procedure TSQLDataItem.SetAsString(Value: AnsiString);
1496 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 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 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 function TColumnMetaData.SQLData: PByte;
1575 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 inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
1592 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 function TColumnMetaData.getRelationName: AnsiString;
1628 begin
1629 CheckActive;
1630 result := FIBXSQLVAR.RelationName;
1631 end;
1632
1633 function TColumnMetaData.getOwnerName: AnsiString;
1634 begin
1635 CheckActive;
1636 result := FIBXSQLVAR.OwnerName;
1637 end;
1638
1639 function TColumnMetaData.getSQLName: AnsiString;
1640 begin
1641 CheckActive;
1642 result := FIBXSQLVAR.FieldName;
1643 end;
1644
1645 function TColumnMetaData.getAliasName: AnsiString;
1646 begin
1647 CheckActive;
1648 result := FIBXSQLVAR.AliasName;
1649 end;
1650
1651 function TColumnMetaData.GetName: AnsiString;
1652 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 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 { 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 function TIBSQLData.GetTransaction: ITransaction;
1723 begin
1724 if FTransaction = nil then
1725 Result := inherited GetTransaction
1726 else
1727 Result := FTransaction;
1728 end;
1729
1730 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 function TIBSQLData.GetAsString: AnsiString;
1755 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 result := SArray;
1763 SQL_BLOB:
1764 Result := FIBXSQLVAR.GetAsBlob(AsQuad,nil).GetAsString;
1765 else
1766 Result := inherited GetAsString;
1767 end;
1768 end;
1769
1770 { TSQLParam }
1771
1772 procedure TSQLParam.InternalSetAsString(Value: AnsiString);
1773
1774 procedure DoSetString;
1775 begin
1776 Changing;
1777 FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1778 Changed;
1779 end;
1780
1781 var b: IBlob;
1782 dt: TDateTime;
1783 CurrValue: Currency;
1784 FloatValue: single;
1785 begin
1786 CheckActive;
1787 if IsNullable then
1788 IsNull := False;
1789 case SQLTYPE of
1790 SQL_BOOLEAN:
1791 if AnsiCompareText(Value,STrue) = 0 then
1792 AsBoolean := true
1793 else
1794 if AnsiCompareText(Value,SFalse) = 0 then
1795 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 DoSetString;
1811
1812 SQL_SHORT,
1813 SQL_LONG,
1814 SQL_INT64:
1815 if TryStrToCurr(Value,CurrValue) then
1816 SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
1817 else
1818 DoSetString;
1819
1820 SQL_D_FLOAT,
1821 SQL_DOUBLE,
1822 SQL_FLOAT:
1823 if TryStrToFloat(Value,FloatValue) then
1824 SetAsDouble(FloatValue)
1825 else
1826 DoSetString;
1827
1828 SQL_TIMESTAMP:
1829 if TryStrToDateTime(Value,dt) then
1830 SetAsDateTime(dt)
1831 else
1832 DoSetString;
1833
1834 SQL_TYPE_DATE:
1835 if TryStrToDateTime(Value,dt) then
1836 SetAsDate(dt)
1837 else
1838 DoSetString;
1839
1840 SQL_TYPE_TIME:
1841 if TryStrToDateTime(Value,dt) then
1842 SetAsTime(dt)
1843 else
1844 DoSetString;
1845
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 procedure TSQLParam.SetName(Value: AnsiString);
1899 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 procedure TSQLParam.SetAsString(AValue: AnsiString);
2205 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 function TMetaData.GetUniqueRelationName: AnsiString;
2318 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 function TMetaData.ByName(Idx: AnsiString): IColumnMetaData;
2346 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 function TSQLParams.ByName(Idx: AnsiString): ISQLParam;
2406 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 function TSQLParams.GetHasCaseSensitiveParams: Boolean;
2431 begin
2432 Result := FSQLParams.CaseSensitiveParams;
2433 end;
2434
2435 { 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 var col: TIBSQLData;
2454 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 col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
2461 col.FTransaction := GetTransaction;
2462 Result := col;
2463 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 function TResults.ByName(Idx: AnsiString): ISQLData;
2482 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 var data: PByte);
2514 begin
2515 CheckActive;
2516 FResults.GetData(index,IsNull, len,data);
2517 end;
2518
2519 function TResults.GetStatement: IStatement;
2520 begin
2521 Result := FStatement;
2522 end;
2523
2524 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