ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBSQL.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBSQL.pas (file contents):
Revision 39 by tony, Tue May 17 08:14:52 2016 UTC vs.
Revision 80 by tony, Mon Jan 1 11:31:07 2018 UTC

# Line 35 | Line 35 | unit IBSQL;
35  
36   {$Mode Delphi}
37  
38 {$IF FPC_FULLVERSION >= 20700 }
38   {$codepage UTF8}
40 {$ENDIF}
39  
40 < { IBSQL param names in dialect 3 quoted format (e.g. :"MyParam") are by default disabled.
40 > (* Define IBXQUERYSTATS to write to stdout a summary of query execution
41 >   statistics each time a query is executed
42 >
43 >   Define IBXQUERYTIME to write to stdout The local execution time for each
44 >   query
45 >   *)
46  
47 < Dialect 3 quoted format parameter names represent a significant overhead and are of
48 < limited value - especially for users that use only TIBSQL or TIBCustomDataset
46 < descendents. They were previously used internally by IBX to simplify SQL generation
47 < for TTable components in Master/Slave relationships which are linked by
48 < Dialect 3 names. They were also generated by TStoredProc when the original
49 < parameter names are quoted.
50 <
51 < However, for some users they do cause a big processing overhead. The TTable/TStoredProc
52 < code has been re-written so that they are no required by IBX internally.
53 < The code to support quoted parameter names is now subject  to conditional compilation.
54 < To enable support, ALLOWDIALECT3PARAMNAMES should be defined when IBX is compiled.
55 <
56 < Hint: deleting the space between the brace and the dollar sign below
57 <
58 < }
59 <
60 < { $define ALLOWDIALECT3PARAMNAMES}
61 <
62 < {$ifndef ALLOWDIALECT3PARAMNAMES}
63 <
64 < { Even when dialect 3 quoted format parameter names are not supported, IBX still processes
65 <  parameter names case insensitive. This does result in some additional overhead
66 <  due to a call to "AnsiUpperCase". This can be avoided by undefining
67 <  "UseCaseSensitiveParamName" below.
68 <
69 <  Note: do not define "UseCaseSensitiveParamName" when "ALLOWDIALECT3PARAMNAMES"
70 <  is defined. This will not give a useful result.
71 < }
72 < {$define UseCaseSensitiveParamName}
73 < {$endif}
47 > { $DEFINE IBXQUERYSTATS}
48 > { $DEFINE IBXQUERYTIME}
49  
50   interface
51  
# Line 80 | Line 55 | uses
55   {$ELSE}
56    baseunix, unix,
57   {$ENDIF}
58 <  SysUtils, Classes, IBHeader,
84 <  IBErrorCodes, IBExternals, DB, IB, IBDatabase, IBUtils, IBXConst;
85 <
86 < const
87 <   sSQLErrorSeparator = ' When Executing: ';
58 >  SysUtils, Classes, IBExternals, IB, IBDatabase, IBUtils;
59  
60   type
90  TIBSQL = class;
91  TIBXSQLDA = class;
92  
93  { TIBXSQLVAR }
94  TIBXSQLVAR = class(TObject)
95  private
96    FParent: TIBXSQLDA;
97    FSQL: TIBSQL;
98    FIndex: Integer;
99    FModified: Boolean;
100    FName: String;
101    FUniqueName: boolean;
102    FXSQLVAR: PXSQLVAR;       { Point to the PXSQLVAR in the owner object }
103
104    function AdjustScale(Value: Int64; Scale: Integer): Double;
105    function AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
106    function AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
107    function GetAsBoolean: boolean;
108    function GetAsCurrency: Currency;
109    function GetAsInt64: Int64;
110    function GetAsDateTime: TDateTime;
111    function GetAsDouble: Double;
112    function GetAsFloat: Float;
113    function GetAsLong: Long;
114    function GetAsPointer: Pointer;
115    function GetAsQuad: TISC_QUAD;
116    function GetAsShort: Short;
117    function GetAsString: String;
118    function GetAsVariant: Variant;
119    function GetAsXSQLVAR: PXSQLVAR;
120    function GetIsNull: Boolean;
121    function GetIsNullable: Boolean;
122    function GetSize: Integer;
123    function GetSQLType: Integer;
124    procedure SetAsBoolean(AValue: boolean);
125    procedure SetAsCurrency(Value: Currency);
126    procedure SetAsInt64(Value: Int64);
127    procedure SetAsDate(Value: TDateTime);
128    procedure SetAsLong(Value: Long);
129    procedure SetAsTime(Value: TDateTime);
130    procedure SetAsDateTime(Value: TDateTime);
131    procedure SetAsDouble(Value: Double);
132    procedure SetAsFloat(Value: Float);
133    procedure SetAsPointer(Value: Pointer);
134    procedure SetAsQuad(Value: TISC_QUAD);
135    procedure SetAsShort(Value: Short);
136    procedure SetAsString(Value: String);
137    procedure SetAsVariant(Value: Variant);
138    procedure SetAsXSQLVAR(Value: PXSQLVAR);
139    procedure SetIsNull(Value: Boolean);
140    procedure SetIsNullable(Value: Boolean);
141    procedure xSetAsBoolean(AValue: boolean);
142    procedure xSetAsCurrency(Value: Currency);
143    procedure xSetAsInt64(Value: Int64);
144    procedure xSetAsDate(Value: TDateTime);
145    procedure xSetAsTime(Value: TDateTime);
146    procedure xSetAsDateTime(Value: TDateTime);
147    procedure xSetAsDouble(Value: Double);
148    procedure xSetAsFloat(Value: Float);
149    procedure xSetAsLong(Value: Long);
150    procedure xSetAsPointer(Value: Pointer);
151    procedure xSetAsQuad(Value: TISC_QUAD);
152    procedure xSetAsShort(Value: Short);
153    procedure xSetAsString(Value: String);
154    procedure xSetAsVariant(Value: Variant);
155    procedure xSetAsXSQLVAR(Value: PXSQLVAR);
156    procedure xSetIsNull(Value: Boolean);
157    procedure xSetIsNullable(Value: Boolean);
158  public
159    constructor Create(Parent: TIBXSQLDA; Query: TIBSQL);
160    procedure Assign(Source: TIBXSQLVAR);
161    procedure Clear;
162    procedure LoadFromFile(const FileName: String);
163    procedure LoadFromStream(Stream: TStream);
164    procedure SaveToFile(const FileName: String);
165    procedure SaveToStream(Stream: TStream);
166    property AsDate: TDateTime read GetAsDateTime write SetAsDate;
167    property AsBoolean:boolean read GetAsBoolean write SetAsBoolean;
168    property AsTime: TDateTime read GetAsDateTime write SetAsTime;
169    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
170    property AsDouble: Double read GetAsDouble write SetAsDouble;
171    property AsFloat: Float read GetAsFloat write SetAsFloat;
172    property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
173    property AsInt64: Int64 read GetAsInt64 write SetAsInt64;
174    property AsInteger: Integer read GetAsLong write SetAsLong;
175    property AsLong: Long read GetAsLong write SetAsLong;
176    property AsPointer: Pointer read GetAsPointer write SetAsPointer;
177    property AsQuad: TISC_QUAD read GetAsQuad write SetAsQuad;
178    property AsShort: Short read GetAsShort write SetAsShort;
179    property AsString: String read GetAsString write SetAsString;
180    property AsVariant: Variant read GetAsVariant write SetAsVariant;
181    property AsXSQLVAR: PXSQLVAR read GetAsXSQLVAR write SetAsXSQLVAR;
182    property Data: PXSQLVAR read FXSQLVAR write FXSQLVAR;
183    property IsNull: Boolean read GetIsNull write SetIsNull;
184    property IsNullable: Boolean read GetIsNullable write SetIsNullable;
185    property Index: Integer read FIndex;
186    property Modified: Boolean read FModified write FModified;
187    property Name: String read FName;
188    property Size: Integer read GetSize;
189    property SQLType: Integer read GetSQLType;
190    property Value: Variant read GetAsVariant write SetAsVariant;
191  end;
192
193  TIBXSQLVARArray = Array of TIBXSQLVAR;
194
195  TIBXSQLDAType = (daInput,daOutput);
196
197  { TIBXSQLDA }
198
199  TIBXSQLDA = class(TObject)
200  protected
201    FSQL: TIBSQL;
202    FCount: Integer;
203    FSize: Integer;
204    FInputSQLDA: boolean;
205    FXSQLDA: PXSQLDA;
206    FXSQLVARs: TIBXSQLVARArray; { array of IBXQLVARs }
207    FUniqueRelationName: String;
208    function GetModified: Boolean;
209    function GetRecordSize: Integer;
210    function GetXSQLDA: PXSQLDA;
211    function GetXSQLVAR(Idx: Integer): TIBXSQLVAR;
212    function GetXSQLVARByName(Idx: String): TIBXSQLVAR;
213    procedure Initialize;
214    procedure SetCount(Value: Integer);
215  public
216    constructor Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
217    destructor Destroy; override;
218     procedure SetParamName(FieldName: String; Idx: Integer; UniqueName: boolean = false);
219    function ByName(Idx: String): TIBXSQLVAR;
220    property AsXSQLDA: PXSQLDA read GetXSQLDA;
221    property Count: Integer read FCount write SetCount;
222    property Modified: Boolean read GetModified;
223    property RecordSize: Integer read GetRecordSize;
224    property Vars[Idx: Integer]: TIBXSQLVAR read GetXSQLVAR; default;
225    property UniqueRelationName: String read FUniqueRelationName;
226  end;
227
61    { TIBBatch }
62  
63    TIBBatch = class(TObject)
64    protected
65      FFilename: String;
66 <    FColumns: TIBXSQLDA;
67 <    FParams: TIBXSQLDA;
66 >    FColumns: IResults;
67 >    FParams: ISQLParams;
68    public
69      procedure ReadyFile; virtual; abstract;
70 <    property Columns: TIBXSQLDA read FColumns;
70 >    property Columns: IResults read FColumns;
71      property Filename: String read FFilename write FFilename;
72 <    property Params: TIBXSQLDA read FParams;
72 >    property Params: ISQLParams read FParams;
73    end;
74  
75    TIBBatchInput = class(TIBBatch)
# Line 322 | Line 155 | type
155    end;
156  
157       { TIBSQL }
325  TIBSQLTypes = (SQLUnknown, SQLSelect, SQLInsert,
326                  SQLUpdate, SQLDelete, SQLDDL,
327                  SQLGetSegment, SQLPutSegment,
328                  SQLExecProcedure, SQLStartTransaction,
329                  SQLCommit, SQLRollback,
330                  SQLSelectForUpdate, SQLSetGenerator);
158  
159    TIBSQL = class(TComponent)
160    private
161 <    FIBLoaded: Boolean;
161 >    FMetaData: IMetaData;
162 >    FSQLParams: ISQLParams;
163 >    FStatement: IStatement;
164      FOnSQLChanged: TNotifyEvent;
165      FUniqueParamNames: Boolean;
166 +    FBOF: boolean;
167 +    FEOF: boolean;
168      function GetFieldCount: integer;
169 +    function GetOpen: Boolean;
170 +    function GetPrepared: Boolean;
171 +    function GetSQLStatementType: TIBSQLStatementTypes;
172      procedure SetUniqueParamNames(AValue: Boolean);
173    protected
174      FBase: TIBBase;
175 <    FBOF,                          { At BOF? }
342 <    FEOF,                          { At EOF? }
343 <    FGoToFirstRecordOnExecute,     { Automatically position record on first record after executing }
344 <    FOpen,                         { Is a cursor open? }
345 <    FPrepared: Boolean;            { Has the query been prepared? }
175 >    FGoToFirstRecordOnExecute: boolean;     { Automatically position record on first record after executing }
176      FRecordCount: Integer;         { How many records have been read so far? }
347    FCursor: String;               { Cursor name...}
348    FHandle: TISC_STMT_HANDLE;     { Once prepared, this accesses the SQL Query }
177      FOnSQLChanging: TNotifyEvent;  { Call this when the SQL is changing }
178      FSQL: TStrings;                { SQL Query (by user) }
179      FParamCheck: Boolean;          { Check for parameters? (just like TQuery) }
180 <    FProcessedSQL: TStrings;       { SQL Query (pre-processed for param labels) }
181 <    FSQLParams,                    { Any parameters to the query }
354 <    FSQLRecord: TIBXSQLDA;         { The current record }
355 <    FSQLType: TIBSQLTypes;         { Select, update, delete, insert, create, alter, etc...}
180 >    FResults: IResults;            {Single row results from exec}
181 >    FResultSet: IResultSet;        {Multi-row results from open cursor}
182      FGenerateParamNames: Boolean;  { Auto generate param names ?}
183      procedure DoBeforeDatabaseDisconnect(Sender: TObject);
184      function GetDatabase: TIBDatabase;
359    function GetDBHandle: PISC_DB_HANDLE;
185      function GetEOF: Boolean;
186 <    function GetFields(const Idx: Integer): TIBXSQLVAR;
186 >    function GetFields(const Idx: Integer): ISQLData;
187      function GetFieldIndex(FieldName: String): Integer;
188      function GetPlan: String;
189      function GetRecordCount: Integer;
190      function GetRowsAffected: Integer;
191 <    function GetSQLParams: TIBXSQLDA;
191 >    function GetSQLParams: ISQLParams;
192      function GetTransaction: TIBTransaction;
368    function GetTRHandle: PISC_TR_HANDLE;
369    procedure PreprocessSQL;
193      procedure SetDatabase(Value: TIBDatabase);
194      procedure SetSQL(Value: TStrings);
195      procedure SetTransaction(Value: TIBTransaction);
# Line 378 | Line 201 | type
201      destructor Destroy; override;
202      procedure BatchInput(InputObject: TIBBatchInput);
203      procedure BatchOutput(OutputObject: TIBBatchOutput);
381    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
204      procedure CheckClosed;           { raise error if query is not closed. }
205      procedure CheckOpen;             { raise error if query is not open.}
206      procedure CheckValidStatement;   { raise error if statement is invalid.}
207      procedure Close;
386    function Current: TIBXSQLDA;
208      procedure ExecQuery;
209 <    function FieldByName(FieldName: String): TIBXSQLVAR;
210 <    function ParamByName(ParamName: String): TIBXSQLVAR;
209 >    function HasField(FieldName: String): boolean;
210 >    function FieldByName(FieldName: String): ISQLData;
211 >    function ParamByName(ParamName: String): ISQLParam;
212      procedure FreeHandle;
213 <    function Next: TIBXSQLDA;
213 >    function Next: boolean;
214      procedure Prepare;
215      function GetUniqueRelationName: String;
216      property Bof: Boolean read FBOF;
395    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
217      property Eof: Boolean read GetEOF;
218 <    property Fields[const Idx: Integer]: TIBXSQLVAR read GetFields;
218 >    property Current: IResults read FResults;
219 >    property Fields[const Idx: Integer]: ISQLData read GetFields; default;
220      property FieldIndex[FieldName: String]: Integer read GetFieldIndex;
221      property FieldCount: integer read GetFieldCount;
222 <    property Open: Boolean read FOpen;
223 <    property Params: TIBXSQLDA read GetSQLParams;
222 >    property Open: Boolean read GetOpen;
223 >    property Params: ISQLParams read GetSQLParams;
224      property Plan: String read GetPlan;
225 <    property Prepared: Boolean read FPrepared;
225 >    property Prepared: Boolean read GetPrepared;
226      property RecordCount: Integer read GetRecordCount;
227      property RowsAffected: Integer read GetRowsAffected;
228 <    property SQLType: TIBSQLTypes read FSQLType;
407 <    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
408 <    property Handle: TISC_STMT_HANDLE read FHandle;
228 >    property SQLStatementType: TIBSQLStatementTypes read GetSQLStatementType;
229      property UniqueRelationName: String read GetUniqueRelationName;
230 +    property Statement: IStatement read FStatement;
231 +    property MetaData: IMetaData read FMetaData;
232    published
233      property Database: TIBDatabase read GetDatabase write SetDatabase;
234      property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
# Line 421 | Line 243 | type
243      property OnSQLChanged: TNotifyEvent read FOnSQLChanged write FOnSQLChanged;
244    end;
245  
246 + procedure IBAlloc(var P; OldSize, NewSize: Integer);
247 +
248   implementation
249  
250   uses
251 <  IBIntf, IBBlob, Variants , IBSQLMonitor;
428 <
429 < { TIBXSQLVAR }
430 < constructor TIBXSQLVAR.Create(Parent: TIBXSQLDA; Query: TIBSQL);
431 < begin
432 <  inherited Create;
433 <  FParent := Parent;
434 <  FSQL := Query;
435 < end;
436 <
437 < procedure TIBXSQLVAR.Assign(Source: TIBXSQLVAR);
438 < var
439 <  szBuff: PChar;
440 <  s_bhandle, d_bhandle: TISC_BLOB_HANDLE;
441 <  bSourceBlob, bDestBlob: Boolean;
442 <  iSegs: Int64;
443 <  iMaxSeg: Int64;
444 <  iSize: Int64;
445 <  iBlobType: Short;
446 < begin
447 <  szBuff := nil;
448 <  bSourceBlob := True;
449 <  bDestBlob := True;
450 <  s_bhandle := nil;
451 <  d_bhandle := nil;
452 <  try
453 <    if (Source.IsNull) then
454 <    begin
455 <      IsNull := True;
456 <      exit;
457 <    end
458 <    else
459 <      if (FXSQLVAR^.sqltype and (not 1) = SQL_ARRAY) or
460 <         (Source.FXSQLVAR^.sqltype and (not 1) = SQL_ARRAY) then
461 <        exit; { arrays not supported }
462 <    if (FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
463 <       (Source.FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) then
464 <    begin
465 <      AsXSQLVAR := Source.AsXSQLVAR;
466 <      exit;
467 <    end
468 <    else
469 <      if (Source.FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) then
470 <      begin
471 <        szBuff := nil;
472 <        IBAlloc(szBuff, 0, Source.FXSQLVAR^.sqllen);
473 <        Move(Source.FXSQLVAR^.sqldata[0], szBuff[0], Source.FXSQLVAR^.sqllen);
474 <        bSourceBlob := False;
475 <        iSize := Source.FXSQLVAR^.sqllen;
476 <      end
477 <      else
478 <        if (FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) then
479 <          bDestBlob := False;
480 <
481 <    if bSourceBlob then
482 <    begin
483 <      { read the blob }
484 <      Source.FSQL.Call(isc_open_blob2(StatusVector, Source.FSQL.DBHandle,
485 <        Source.FSQL.TRHandle, @s_bhandle, PISC_QUAD(Source.FXSQLVAR.sqldata),
486 <        0, nil), True);
487 <      try
488 <        IBBlob.GetBlobInfo(@s_bhandle, iSegs, iMaxSeg, iSize,
489 <          iBlobType);
490 <        szBuff := nil;
491 <        IBAlloc(szBuff, 0, iSize);
492 <        IBBlob.ReadBlob(@s_bhandle, szBuff, iSize);
493 <      finally
494 <        Source.FSQL.Call(isc_close_blob(StatusVector, @s_bhandle), True);
495 <      end;
496 <    end;
497 <
498 <    if bDestBlob then
499 <    begin
500 <      { write the blob }
501 <      FSQL.Call(isc_create_blob2(StatusVector, FSQL.DBHandle,
502 <        FSQL.TRHandle, @d_bhandle, PISC_QUAD(FXSQLVAR.sqldata),
503 <        0, nil), True);
504 <      try
505 <        IBBlob.WriteBlob(@d_bhandle, szBuff, iSize);
506 <        isNull := false
507 <      finally
508 <        FSQL.Call(isc_close_blob(StatusVector, @d_bhandle), True);
509 <      end;
510 <    end
511 <    else
512 <    begin
513 <      { just copy the buffer }
514 <      FXSQLVAR.sqltype := SQL_TEXT;
515 <      FXSQLVAR.sqllen := iSize;
516 <      IBAlloc(FXSQLVAR.sqldata, iSize, iSize);
517 <      Move(szBuff[0], FXSQLVAR^.sqldata[0], iSize);
518 <    end;
519 <  finally
520 <    FreeMem(szBuff);
521 <  end;
522 < end;
523 <
524 < function TIBXSQLVAR.AdjustScale(Value: Int64; Scale: Integer): Double;
525 < var
526 <  Scaling : Int64;
527 <  i: Integer;
528 <  Val: Double;
529 < begin
530 <  Scaling := 1; Val := Value;
531 <  if Scale > 0 then
532 <  begin
533 <    for i := 1 to Scale do
534 <      Scaling := Scaling * 10;
535 <    result := Val * Scaling;
536 <  end
537 <  else
538 <    if Scale < 0 then
539 <    begin
540 <      for i := -1 downto Scale do
541 <        Scaling := Scaling * 10;
542 <      result := Val / Scaling;
543 <    end
544 <    else
545 <      result := Val;
546 < end;
547 <
548 < function TIBXSQLVAR.AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
549 < var
550 <  Scaling : Int64;
551 <  i: Integer;
552 <  Val: Int64;
553 < begin
554 <  Scaling := 1; Val := Value;
555 <  if Scale > 0 then begin
556 <    for i := 1 to Scale do Scaling := Scaling * 10;
557 <    result := Val * Scaling;
558 <  end else if Scale < 0 then begin
559 <    for i := -1 downto Scale do Scaling := Scaling * 10;
560 <    result := Val div Scaling;
561 <  end else
562 <    result := Val;
563 < end;
564 <
565 < function TIBXSQLVAR.AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
566 < var
567 <  Scaling : Int64;
568 <  i : Integer;
569 <  FractionText, PadText, CurrText: string;
570 < begin
571 <  Result := 0;
572 <  Scaling := 1;
573 <  if Scale > 0 then
574 <  begin
575 <    for i := 1 to Scale do
576 <      Scaling := Scaling * 10;
577 <    result := Value * Scaling;
578 <  end
579 <  else
580 <    if Scale < 0 then
581 <    begin
582 <      for i := -1 downto Scale do
583 <        Scaling := Scaling * 10;
584 <      FractionText := IntToStr(abs(Value mod Scaling));
585 <      for i := Length(FractionText) to -Scale -1 do
586 <        PadText := '0' + PadText;
587 <      if Value < 0 then
588 <        CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
589 <      else
590 <        CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
591 <      try
592 <        result := StrToCurr(CurrText);
593 <      except
594 <        on E: Exception do
595 <          IBError(ibxeInvalidDataConversion, [nil]);
596 <      end;
597 <    end
598 <    else
599 <      result := Value;
600 < end;
601 <
602 < function TIBXSQLVAR.GetAsBoolean: boolean;
603 < begin
604 <  result := false;
605 <  if not IsNull then
606 <  begin
607 <    if FXSQLVAR^.sqltype and (not 1) = SQL_BOOLEAN then
608 <      result := PByte(FXSQLVAR^.sqldata)^ = ISC_TRUE
609 <    else
610 <      IBError(ibxeInvalidDataConversion, [nil]);
611 <  end
612 < end;
613 <
614 < function TIBXSQLVAR.GetAsCurrency: Currency;
615 < begin
616 <  result := 0;
617 <  if FSQL.Database.SQLDialect < 3 then
618 <    result := GetAsDouble
619 <  else begin
620 <    if not IsNull then
621 <      case FXSQLVAR^.sqltype and (not 1) of
622 <        SQL_TEXT, SQL_VARYING: begin
623 <          try
624 <            result := StrtoCurr(AsString);
625 <          except
626 <            on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
627 <          end;
628 <        end;
629 <        SQL_SHORT:
630 <          result := AdjustScaleToCurrency(Int64(PShort(FXSQLVAR^.sqldata)^),
631 <                                      FXSQLVAR^.sqlscale);
632 <        SQL_LONG:
633 <          result := AdjustScaleToCurrency(Int64(PLong(FXSQLVAR^.sqldata)^),
634 <                                      FXSQLVAR^.sqlscale);
635 <        SQL_INT64:
636 <          result := AdjustScaleToCurrency(PInt64(FXSQLVAR^.sqldata)^,
637 <                                      FXSQLVAR^.sqlscale);
638 <        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
639 <          result := Trunc(AsDouble);
640 <        else
641 <          IBError(ibxeInvalidDataConversion, [nil]);
642 <      end;
643 <    end;
644 < end;
645 <
646 < function TIBXSQLVAR.GetAsInt64: Int64;
647 < begin
648 <  result := 0;
649 <  if not IsNull then
650 <    case FXSQLVAR^.sqltype and (not 1) of
651 <      SQL_TEXT, SQL_VARYING: begin
652 <        try
653 <          result := StrToInt64(AsString);
654 <        except
655 <          on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
656 <        end;
657 <      end;
658 <      SQL_SHORT:
659 <        result := AdjustScaleToInt64(Int64(PShort(FXSQLVAR^.sqldata)^),
660 <                                    FXSQLVAR^.sqlscale);
661 <      SQL_LONG:
662 <        result := AdjustScaleToInt64(Int64(PLong(FXSQLVAR^.sqldata)^),
663 <                                    FXSQLVAR^.sqlscale);
664 <      SQL_INT64:
665 <        result := AdjustScaleToInt64(PInt64(FXSQLVAR^.sqldata)^,
666 <                                    FXSQLVAR^.sqlscale);
667 <      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
668 <        result := Trunc(AsDouble);
669 <      else
670 <        IBError(ibxeInvalidDataConversion, [nil]);
671 <    end;
672 < end;
673 <
674 < function TIBXSQLVAR.GetAsDateTime: TDateTime;
675 < var
676 <  tm_date: TCTimeStructure;
677 <  msecs: word;
678 < begin
679 <  result := 0;
680 <  if not IsNull then
681 <    case FXSQLVAR^.sqltype and (not 1) of
682 <      SQL_TEXT, SQL_VARYING: begin
683 <        try
684 <          result := StrToDate(AsString);
685 <        except
686 <          on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]);
687 <        end;
688 <      end;
689 <      SQL_TYPE_DATE: begin
690 <        isc_decode_sql_date(PISC_DATE(FXSQLVAR^.sqldata), @tm_date);
691 <        try
692 <          result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
693 <                               Word(tm_date.tm_mday));
694 <        except
695 <          on E: EConvertError do begin
696 <            IBError(ibxeInvalidDataConversion, [nil]);
697 <          end;
698 <        end;
699 <      end;
700 <      SQL_TYPE_TIME: begin
701 <        isc_decode_sql_time(PISC_TIME(FXSQLVAR^.sqldata), @tm_date);
702 <        try
703 <          msecs :=  (PISC_TIME(FXSQLVAR^.sqldata)^ mod 10000) div 10;
704 <          result := EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
705 <                               Word(tm_date.tm_sec), msecs)
706 <        except
707 <          on E: EConvertError do begin
708 <            IBError(ibxeInvalidDataConversion, [nil]);
709 <          end;
710 <        end;
711 <      end;
712 <      SQL_TIMESTAMP: begin
713 <        isc_decode_date(PISC_QUAD(FXSQLVAR^.sqldata), @tm_date);
714 <        try
715 <          result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
716 <                              Word(tm_date.tm_mday));
717 <          msecs := (PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time mod 10000) div 10;
718 <          if result >= 0 then
719 <            result := result + EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
720 <                                          Word(tm_date.tm_sec), msecs)
721 <          else
722 <            result := result - EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
723 <                                          Word(tm_date.tm_sec), msecs)
724 <        except
725 <          on E: EConvertError do begin
726 <            IBError(ibxeInvalidDataConversion, [nil]);
727 <          end;
728 <        end;
729 <      end;
730 <      else
731 <        IBError(ibxeInvalidDataConversion, [nil]);
732 <    end;
733 < end;
734 <
735 < function TIBXSQLVAR.GetAsDouble: Double;
736 < begin
737 <  result := 0;
738 <  if not IsNull then begin
739 <    case FXSQLVAR^.sqltype and (not 1) of
740 <      SQL_TEXT, SQL_VARYING: begin
741 <        try
742 <          result := StrToFloat(AsString);
743 <        except
744 <          on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
745 <        end;
746 <      end;
747 <      SQL_SHORT:
748 <        result := AdjustScale(Int64(PShort(FXSQLVAR^.sqldata)^),
749 <                              FXSQLVAR^.sqlscale);
750 <      SQL_LONG:
751 <        result := AdjustScale(Int64(PLong(FXSQLVAR^.sqldata)^),
752 <                              FXSQLVAR^.sqlscale);
753 <      SQL_INT64:
754 <        result := AdjustScale(PInt64(FXSQLVAR^.sqldata)^, FXSQLVAR^.sqlscale);
755 <      SQL_FLOAT:
756 <        result := PFloat(FXSQLVAR^.sqldata)^;
757 <      SQL_DOUBLE, SQL_D_FLOAT:
758 <        result := PDouble(FXSQLVAR^.sqldata)^;
759 <      else
760 <        IBError(ibxeInvalidDataConversion, [nil]);
761 <    end;
762 <    if  FXSQLVAR^.sqlscale <> 0 then
763 <      result :=
764 <        StrToFloat(FloatToStrF(result, fffixed, 15,
765 <                  Abs(FXSQLVAR^.sqlscale) ));
766 <  end;
767 < end;
768 <
769 < function TIBXSQLVAR.GetAsFloat: Float;
770 < begin
771 <  result := 0;
772 <  try
773 <    result := AsDouble;
774 <  except
775 <    on E: EOverflow do
776 <      IBError(ibxeInvalidDataConversion, [nil]);
777 <  end;
778 < end;
779 <
780 < function TIBXSQLVAR.GetAsLong: Long;
781 < begin
782 <  result := 0;
783 <  if not IsNull then
784 <    case FXSQLVAR^.sqltype and (not 1) of
785 <      SQL_TEXT, SQL_VARYING: begin
786 <        try
787 <          result := StrToInt(AsString);
788 <        except
789 <          on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
790 <        end;
791 <      end;
792 <      SQL_SHORT:
793 <        result := Trunc(AdjustScale(Int64(PShort(FXSQLVAR^.sqldata)^),
794 <                                    FXSQLVAR^.sqlscale));
795 <      SQL_LONG:
796 <        result := Trunc(AdjustScale(Int64(PLong(FXSQLVAR^.sqldata)^),
797 <                                    FXSQLVAR^.sqlscale));
798 <      SQL_INT64:
799 <        result := Trunc(AdjustScale(PInt64(FXSQLVAR^.sqldata)^, FXSQLVAR^.sqlscale));
800 <      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
801 <        result := Trunc(AsDouble);
802 <      else
803 <        IBError(ibxeInvalidDataConversion, [nil]);
804 <    end;
805 < end;
806 <
807 < function TIBXSQLVAR.GetAsPointer: Pointer;
808 < begin
809 <  if not IsNull then
810 <    result := FXSQLVAR^.sqldata
811 <  else
812 <    result := nil;
813 < end;
814 <
815 < function TIBXSQLVAR.GetAsQuad: TISC_QUAD;
816 < begin
817 <  result.gds_quad_high := 0;
818 <  result.gds_quad_low := 0;
819 <  if not IsNull then
820 <    case FXSQLVAR^.sqltype and (not 1) of
821 <      SQL_BLOB, SQL_ARRAY, SQL_QUAD:
822 <        result := PISC_QUAD(FXSQLVAR^.sqldata)^;
823 <      else
824 <        IBError(ibxeInvalidDataConversion, [nil]);
825 <    end;
826 < end;
827 <
828 < function TIBXSQLVAR.GetAsShort: Short;
829 < begin
830 <  result := 0;
831 <  try
832 <    result := AsLong;
833 <  except
834 <    on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
835 <  end;
836 < end;
837 <
838 <
839 < function TIBXSQLVAR.GetAsString: String;
840 < var
841 <  sz: PChar;
842 <  str_len: Integer;
843 <  ss: TStringStream;
844 < begin
845 <  result := '';
846 <  { Check null, if so return a default string }
847 <  if not IsNull then
848 <    case FXSQLVar^.sqltype and (not 1) of
849 <      SQL_ARRAY:
850 <        result := '(Array)'; {do not localize}
851 <      SQL_BLOB: begin
852 <        ss := TStringStream.Create('');
853 <        try
854 <          SaveToStream(ss);
855 <          result := ss.DataString;
856 <        finally
857 <          ss.Free;
858 <        end;
859 <      end;
860 <      SQL_TEXT, SQL_VARYING: begin
861 <        sz := FXSQLVAR^.sqldata;
862 <        if (FXSQLVar^.sqltype and (not 1) = SQL_TEXT) then
863 <          str_len := FXSQLVar^.sqllen
864 <        else begin
865 <          str_len := isc_vax_integer(FXSQLVar^.sqldata, 2);
866 <          Inc(sz, 2);
867 <        end;
868 <        SetString(result, sz, str_len);
869 <        if ((FXSQLVar^.sqltype and (not 1)) = SQL_TEXT) then
870 <          result := TrimRight(result);
871 <      end;
872 <      SQL_TYPE_DATE:
873 <        case FSQL.Database.SQLDialect of
874 <          1 : result := DateTimeToStr(AsDateTime);
875 <          3 : result := DateToStr(AsDateTime);
876 <        end;
877 <      SQL_TYPE_TIME :
878 <        result := TimeToStr(AsDateTime);
879 <      SQL_TIMESTAMP:
880 <        result := DateTimeToStr(AsDateTime);
881 <      SQL_SHORT, SQL_LONG:
882 <        if FXSQLVAR^.sqlscale = 0 then
883 <          result := IntToStr(AsLong)
884 <        else if FXSQLVAR^.sqlscale >= (-4) then
885 <          result := CurrToStr(AsCurrency)
886 <        else
887 <          result := FloatToStr(AsDouble);
888 <      SQL_INT64:
889 <        if FXSQLVAR^.sqlscale = 0 then
890 <          result := IntToStr(AsInt64)
891 <        else if FXSQLVAR^.sqlscale >= (-4) then
892 <          result := CurrToStr(AsCurrency)
893 <        else
894 <          result := FloatToStr(AsDouble);
895 <      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
896 <        result := FloatToStr(AsDouble);
897 <      else
898 <        IBError(ibxeInvalidDataConversion, [nil]);
899 <    end;
900 < end;
901 <
902 < function TIBXSQLVAR.GetAsVariant: Variant;
903 < begin
904 <  if IsNull then
905 <    result := NULL
906 <  { Check null, if so return a default string }
907 <  else case FXSQLVar^.sqltype and (not 1) of
908 <      SQL_ARRAY:
909 <        result := '(Array)'; {do not localize}
910 <      SQL_BLOB:
911 <        result := '(Blob)'; {do not localize}
912 <      SQL_TEXT, SQL_VARYING:
913 <        result := AsString;
914 <      SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
915 <        result := AsDateTime;
916 <      SQL_SHORT, SQL_LONG:
917 <        if FXSQLVAR^.sqlscale = 0 then
918 <          result := AsLong
919 <        else if FXSQLVAR^.sqlscale >= (-4) then
920 <          result := AsCurrency
921 <        else
922 <          result := AsDouble;
923 <      SQL_INT64:
924 <        if FXSQLVAR^.sqlscale = 0 then
925 <          result := AsInt64
926 <        else if FXSQLVAR^.sqlscale >= (-4) then
927 <          result := AsCurrency
928 <        else
929 <          result := AsDouble;
930 <      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
931 <        result := AsDouble;
932 <      SQL_BOOLEAN:
933 <        result := AsBoolean;
934 <      else
935 <        IBError(ibxeInvalidDataConversion, [nil]);
936 <    end;
937 < end;
938 <
939 < function TIBXSQLVAR.GetAsXSQLVAR: PXSQLVAR;
940 < begin
941 <  result := FXSQLVAR;
942 < end;
943 <
944 < function TIBXSQLVAR.GetIsNull: Boolean;
945 < begin
946 <  result := IsNullable and (FXSQLVAR^.sqlind^ = -1);
947 < end;
948 <
949 < function TIBXSQLVAR.GetIsNullable: Boolean;
950 < begin
951 <  result := (FXSQLVAR^.sqltype and 1 = 1);
952 < end;
953 <
954 < procedure TIBXSQLVAR.LoadFromFile(const FileName: String);
955 < var
956 <  fs: TFileStream;
957 < begin
958 <  fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
959 <  try
960 <    LoadFromStream(fs);
961 <  finally
962 <    fs.Free;
963 <  end;
964 < end;
965 <
966 < procedure TIBXSQLVAR.LoadFromStream(Stream: TStream);
967 < var
968 <  bs: TIBBlobStream;
969 < begin
970 <  bs := TIBBlobStream.Create;
971 <  try
972 <    bs.Mode := bmWrite;
973 <    bs.Database := FSQL.Database;
974 <    bs.Transaction := FSQL.Transaction;
975 <    Stream.Seek(0, soFromBeginning);
976 <    bs.LoadFromStream(Stream);
977 <    bs.Finalize;
978 <    AsQuad := bs.BlobID;
979 <  finally
980 <    bs.Free;
981 <  end;
982 < end;
983 <
984 < procedure TIBXSQLVAR.SaveToFile(const FileName: String);
985 < var
986 <  fs: TFileStream;
987 < begin
988 <  fs := TFileStream.Create(FileName, fmCreate or fmShareExclusive);
989 <  try
990 <    SaveToStream(fs);
991 <  finally
992 <    fs.Free;
993 <  end;
994 < end;
995 <
996 < procedure TIBXSQLVAR.SaveToStream(Stream: TStream);
997 < var
998 <  bs: TIBBlobStream;
999 < begin
1000 <  bs := TIBBlobStream.Create;
1001 <  try
1002 <    bs.Mode := bmRead;
1003 <    bs.Database := FSQL.Database;
1004 <    bs.Transaction := FSQL.Transaction;
1005 <    bs.BlobID := AsQuad;
1006 <    bs.SaveToStream(Stream);
1007 <  finally
1008 <    bs.Free;
1009 <  end;
1010 < end;
1011 <
1012 < function TIBXSQLVAR.GetSize: Integer;
1013 < begin
1014 <  result := FXSQLVAR^.sqllen;
1015 < end;
1016 <
1017 < function TIBXSQLVAR.GetSQLType: Integer;
1018 < begin
1019 <  result := FXSQLVAR^.sqltype and (not 1);
1020 < end;
1021 <
1022 < procedure TIBXSQLVAR.SetAsBoolean(AValue: boolean);
1023 < var
1024 <  i: Integer;
1025 < begin
1026 <  if FUniqueName then
1027 <     xSetAsBoolean(AValue)
1028 <  else
1029 <  for i := 0 to FParent.FCount - 1 do
1030 <    if FParent[i].FName = FName then
1031 <       FParent[i].xSetAsBoolean(AValue);
1032 < end;
1033 <
1034 < procedure TIBXSQLVAR.xSetAsCurrency(Value: Currency);
1035 < begin
1036 <  if IsNullable then
1037 <    IsNull := False;
1038 <  FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1);
1039 <  FXSQLVAR^.sqlscale := -4;
1040 <  FXSQLVAR^.sqllen := SizeOf(Int64);
1041 <  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1042 <  PCurrency(FXSQLVAR^.sqldata)^ := Value;
1043 <  FModified := True;
1044 < end;
1045 <
1046 < procedure TIBXSQLVAR.SetAsCurrency(Value: Currency);
1047 < var
1048 <  i: Integer;
1049 < begin
1050 <  if FSQL.Database.SQLDialect < 3 then
1051 <    AsDouble := Value
1052 <  else
1053 <  begin
1054 <
1055 <    if FUniqueName then
1056 <       xSetAsCurrency(Value)
1057 <    else
1058 <    for i := 0 to FParent.FCount - 1 do
1059 <      if FParent[i].FName = FName then
1060 <           FParent[i].xSetAsCurrency(Value);
1061 <  end;
1062 < end;
1063 <
1064 < procedure TIBXSQLVAR.xSetAsInt64(Value: Int64);
1065 < begin
1066 <  if IsNullable then
1067 <    IsNull := False;
1068 <
1069 <  FXSQLVAR^.sqltype := SQL_INT64 or (FXSQLVAR^.sqltype and 1);
1070 <  FXSQLVAR^.sqlscale := 0;
1071 <  FXSQLVAR^.sqllen := SizeOf(Int64);
1072 <  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1073 <  PInt64(FXSQLVAR^.sqldata)^ := Value;
1074 <  FModified := True;
1075 < end;
1076 <
1077 < procedure TIBXSQLVAR.SetAsInt64(Value: Int64);
1078 < var
1079 <  i: Integer;
1080 < begin
1081 <  if FUniqueName then
1082 <     xSetAsInt64(Value)
1083 <  else
1084 <  for i := 0 to FParent.FCount - 1 do
1085 <    if FParent[i].FName = FName then
1086 <          FParent[i].xSetAsInt64(Value);
1087 < end;
1088 <
1089 < procedure TIBXSQLVAR.xSetAsDate(Value: TDateTime);
1090 < var
1091 <   tm_date: TCTimeStructure;
1092 <   Yr, Mn, Dy: Word;
1093 < begin
1094 <  if IsNullable then
1095 <    IsNull := False;
1096 <
1097 <  FXSQLVAR^.sqltype := SQL_TYPE_DATE or (FXSQLVAR^.sqltype and 1);
1098 <  DecodeDate(Value, Yr, Mn, Dy);
1099 <  with tm_date do begin
1100 <    tm_sec := 0;
1101 <    tm_min := 0;
1102 <    tm_hour := 0;
1103 <    tm_mday := Dy;
1104 <    tm_mon := Mn - 1;
1105 <    tm_year := Yr - 1900;
1106 <  end;
1107 <  FXSQLVAR^.sqllen := SizeOf(ISC_DATE);
1108 <  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1109 <  isc_encode_sql_date(@tm_date, PISC_DATE(FXSQLVAR^.sqldata));
1110 <  FModified := True;
1111 < end;
1112 <
1113 < procedure TIBXSQLVAR.SetAsDate(Value: TDateTime);
1114 < var
1115 <  i: Integer;
1116 < begin
1117 <  if FSQL.Database.SQLDialect < 3 then
1118 <  begin
1119 <    AsDateTime := Value;
1120 <    exit;
1121 <  end;
1122 <
1123 <  if FUniqueName then
1124 <     xSetAsDate(Value)
1125 <  else
1126 <  for i := 0 to FParent.FCount - 1 do
1127 <    if FParent[i].FName = FName then
1128 <       FParent[i].xSetAsDate(Value);
1129 < end;
1130 <
1131 < procedure TIBXSQLVAR.xSetAsTime(Value: TDateTime);
1132 < var
1133 <  tm_date: TCTimeStructure;
1134 <  Hr, Mt, S, Ms: Word;
1135 < begin
1136 <  if IsNullable then
1137 <    IsNull := False;
1138 <
1139 <  FXSQLVAR^.sqltype := SQL_TYPE_TIME or (FXSQLVAR^.sqltype and 1);
1140 <  DecodeTime(Value, Hr, Mt, S, Ms);
1141 <  with tm_date do begin
1142 <    tm_sec := S;
1143 <    tm_min := Mt;
1144 <    tm_hour := Hr;
1145 <    tm_mday := 0;
1146 <    tm_mon := 0;
1147 <    tm_year := 0;
1148 <  end;
1149 <  FXSQLVAR^.sqllen := SizeOf(ISC_TIME);
1150 <  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1151 <  isc_encode_sql_time(@tm_date, PISC_TIME(FXSQLVAR^.sqldata));
1152 <  if Ms > 0 then
1153 <    Inc(PISC_TIME(FXSQLVAR^.sqldata)^,Ms*10);
1154 <  FModified := True;
1155 < end;
1156 <
1157 < procedure TIBXSQLVAR.SetAsTime(Value: TDateTime);
1158 < var
1159 <  i: Integer;
1160 < begin
1161 <  if FSQL.Database.SQLDialect < 3 then
1162 <  begin
1163 <    AsDateTime := Value;
1164 <    exit;
1165 <  end;
1166 <
1167 <  if FUniqueName then
1168 <     xSetAsTime(Value)
1169 <  else
1170 <  for i := 0 to FParent.FCount - 1 do
1171 <    if FParent[i].FName = FName then
1172 <       FParent[i].xSetAsTime(Value);
1173 < end;
1174 <
1175 < procedure TIBXSQLVAR.xSetAsDateTime(Value: TDateTime);
1176 < var
1177 <  tm_date: TCTimeStructure;
1178 <  Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
1179 < begin
1180 <  if IsNullable then
1181 <    IsNull := False;
1182 <
1183 <  FXSQLVAR^.sqltype := SQL_TIMESTAMP or (FXSQLVAR^.sqltype and 1);
1184 <  DecodeDate(Value, Yr, Mn, Dy);
1185 <  DecodeTime(Value, Hr, Mt, S, Ms);
1186 <  with tm_date do begin
1187 <    tm_sec := S;
1188 <    tm_min := Mt;
1189 <    tm_hour := Hr;
1190 <    tm_mday := Dy;
1191 <    tm_mon := Mn - 1;
1192 <    tm_year := Yr - 1900;
1193 <  end;
1194 <  FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1195 <  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1196 <  isc_encode_date(@tm_date, PISC_QUAD(FXSQLVAR^.sqldata));
1197 <  if Ms > 0 then
1198 <    Inc(PISC_TIMESTAMP(FXSQLVAR^.sqldata)^.timestamp_time,Ms*10);
1199 <  FModified := True;
1200 < end;
1201 <
1202 < procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
1203 < var
1204 <  i: Integer;
1205 < begin
1206 <  if FUniqueName then
1207 <     xSetAsDateTime(value)
1208 <  else
1209 <  for i := 0 to FParent.FCount - 1 do
1210 <    if FParent[i].FName = FName then
1211 <       FParent[i].xSetAsDateTime(Value);
1212 < end;
1213 <
1214 < procedure TIBXSQLVAR.xSetAsDouble(Value: Double);
1215 < begin
1216 <  if IsNullable then
1217 <    IsNull := False;
1218 <
1219 <  FXSQLVAR^.sqltype := SQL_DOUBLE or (FXSQLVAR^.sqltype and 1);
1220 <  FXSQLVAR^.sqllen := SizeOf(Double);
1221 <  FXSQLVAR^.sqlscale := 0;
1222 <  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1223 <  PDouble(FXSQLVAR^.sqldata)^ := Value;
1224 <  FModified := True;
1225 < end;
1226 <
1227 < procedure TIBXSQLVAR.SetAsDouble(Value: Double);
1228 < var
1229 <  i: Integer;
1230 < begin
1231 <  if FUniqueName then
1232 <     xSetAsDouble(Value)
1233 <  else
1234 <  for i := 0 to FParent.FCount - 1 do
1235 <    if FParent[i].FName = FName then
1236 <       FParent[i].xSetAsDouble(Value);
1237 < end;
1238 <
1239 < procedure TIBXSQLVAR.xSetAsFloat(Value: Float);
1240 < begin
1241 <  if IsNullable then
1242 <    IsNull := False;
1243 <
1244 <  FXSQLVAR^.sqltype := SQL_FLOAT or (FXSQLVAR^.sqltype and 1);
1245 <  FXSQLVAR^.sqllen := SizeOf(Float);
1246 <  FXSQLVAR^.sqlscale := 0;
1247 <  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1248 <  PSingle(FXSQLVAR^.sqldata)^ := Value;
1249 <  FModified := True;
1250 < end;
1251 <
1252 < procedure TIBXSQLVAR.SetAsFloat(Value: Float);
1253 < var
1254 <  i: Integer;
1255 < begin
1256 <  if FUniqueName then
1257 <     xSetAsFloat(Value)
1258 <  else
1259 <  for i := 0 to FParent.FCount - 1 do
1260 <    if FParent[i].FName = FName then
1261 <       FParent[i].xSetAsFloat(Value);
1262 < end;
1263 <
1264 < procedure TIBXSQLVAR.xSetAsLong(Value: Long);
1265 < begin
1266 <  if IsNullable then
1267 <    IsNull := False;
1268 <
1269 <  FXSQLVAR^.sqltype := SQL_LONG or (FXSQLVAR^.sqltype and 1);
1270 <  FXSQLVAR^.sqllen := SizeOf(Long);
1271 <  FXSQLVAR^.sqlscale := 0;
1272 <  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1273 <  PLong(FXSQLVAR^.sqldata)^ := Value;
1274 <  FModified := True;
1275 < end;
1276 <
1277 < procedure TIBXSQLVAR.SetAsLong(Value: Long);
1278 < var
1279 <  i: Integer;
1280 < begin
1281 <  if FUniqueName then
1282 <     xSetAsLong(Value)
1283 <  else
1284 <  for i := 0 to FParent.FCount - 1 do
1285 <    if FParent[i].FName = FName then
1286 <       FParent[i].xSetAsLong(Value);
1287 < end;
251 >   Variants, IBSQLMonitor, FBMessages, IBCustomDataSet;
252  
253 < procedure TIBXSQLVAR.xSetAsPointer(Value: Pointer);
1290 < begin
1291 <  if IsNullable and (Value = nil) then
1292 <    IsNull := True
1293 <  else begin
1294 <    IsNull := False;
1295 <    FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1296 <    Move(Value^, FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen);
1297 <  end;
1298 <  FModified := True;
1299 < end;
1300 <
1301 < procedure TIBXSQLVAR.SetAsPointer(Value: Pointer);
1302 < var
1303 <  i: Integer;
1304 < begin
1305 <    if FUniqueName then
1306 <       xSetAsPointer(Value)
1307 <    else
1308 <    for i := 0 to FParent.FCount - 1 do
1309 <      if FParent[i].FName = FName then
1310 <         FParent[i].xSetAsPointer(Value);
1311 < end;
1312 <
1313 < procedure TIBXSQLVAR.xSetAsQuad(Value: TISC_QUAD);
1314 < begin
1315 <  if IsNullable then
1316 <      IsNull := False;
1317 <  if (FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB) and
1318 <     (FXSQLVAR^.sqltype and (not 1) <> SQL_ARRAY) then
1319 <    IBError(ibxeInvalidDataConversion, [nil]);
1320 <  FXSQLVAR^.sqllen := SizeOf(TISC_QUAD);
1321 <  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1322 <  PISC_QUAD(FXSQLVAR^.sqldata)^ := Value;
1323 <  FModified := True;
1324 < end;
1325 <
1326 < procedure TIBXSQLVAR.SetAsQuad(Value: TISC_QUAD);
1327 < var
1328 <  i: Integer;
1329 < begin
1330 <  if FUniqueName then
1331 <     xSetAsQuad(Value)
1332 <  else
1333 <  for i := 0 to FParent.FCount - 1 do
1334 <    if FParent[i].FName = FName then
1335 <       FParent[i].xSetAsQuad(Value);
1336 < end;
1337 <
1338 < procedure TIBXSQLVAR.xSetAsShort(Value: Short);
1339 < begin
1340 <  if IsNullable then
1341 <    IsNull := False;
1342 <
1343 <  FXSQLVAR^.sqltype := SQL_SHORT or (FXSQLVAR^.sqltype and 1);
1344 <  FXSQLVAR^.sqllen := SizeOf(Short);
1345 <  FXSQLVAR^.sqlscale := 0;
1346 <  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1347 <  PShort(FXSQLVAR^.sqldata)^ := Value;
1348 <  FModified := True;
1349 < end;
1350 <
1351 < procedure TIBXSQLVAR.SetAsShort(Value: Short);
253 > procedure IBAlloc(var P; OldSize, NewSize: Integer);
254   var
255    i: Integer;
256   begin
257 <  if FUniqueName then
258 <     xSetAsShort(Value)
1357 <  else
1358 <  for i := 0 to FParent.FCount - 1 do
1359 <    if FParent[i].FName = FName then
1360 <       FParent[i].xSetAsShort(Value);
1361 < end;
1362 <
1363 < procedure TIBXSQLVAR.xSetAsString(Value: String);
1364 < var
1365 <   stype: Integer;
1366 <   ss: TStringStream;
1367 <
1368 <   procedure SetStringValue;
1369 <   var
1370 <      i: Integer;
1371 <   begin
1372 <      if (FXSQLVAR^.sqlname = 'DB_KEY') or {do not localize}
1373 <         (FXSQLVAR^.sqlname = 'RDB$DB_KEY') then {do not localize}
1374 <        Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen)
1375 <      else begin
1376 <        FXSQLVAR^.sqltype := SQL_TEXT or (FXSQLVAR^.sqltype and 1);
1377 <        FXSQLVAR^.sqllen := Length(Value);
1378 <        IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen + 1);
1379 <        if (Length(Value) > 0) then
1380 <          Move(Value[1], FXSQLVAR^.sqldata^, FXSQLVAR^.sqllen);
1381 <      end;
1382 <      FModified := True;
1383 <   end;
1384 <
1385 < begin
1386 <  if IsNullable then
1387 <    IsNull := False;
1388 <
1389 <  stype := FXSQLVAR^.sqltype and (not 1);
1390 <  if (stype = SQL_TEXT) or (stype = SQL_VARYING) then
1391 <    SetStringValue
1392 <  else begin
1393 <    if (stype = SQL_BLOB) then
1394 <    begin
1395 <      ss := TStringStream.Create(Value);
1396 <      try
1397 <        LoadFromStream(ss);
1398 <      finally
1399 <        ss.Free;
1400 <      end;
1401 <    end
1402 <    else if Value = '' then
1403 <      IsNull := True
1404 <    else if (stype = SQL_TIMESTAMP) or (stype = SQL_TYPE_DATE) or
1405 <      (stype = SQL_TYPE_TIME) then
1406 <      xSetAsDateTime(StrToDateTime(Value))
1407 <    else
1408 <      SetStringValue;
1409 <  end;
1410 < end;
1411 <
1412 < procedure TIBXSQLVAR.SetAsString(Value: String);
1413 < var
1414 <   i: integer;
1415 < begin
1416 <  if FUniqueName then
1417 <     xSetAsString(Value)
1418 <  else
1419 <  for i := 0 to FParent.FCount - 1 do
1420 <    if FParent[i].FName = FName then
1421 <       FParent[i].xSetAsString(Value);
1422 < end;
1423 <
1424 < procedure TIBXSQLVAR.xSetAsVariant(Value: Variant);
1425 < begin
1426 <  if VarIsNull(Value) then
1427 <    IsNull := True
1428 <  else case VarType(Value) of
1429 <    varEmpty, varNull:
1430 <      IsNull := True;
1431 <    varSmallint, varInteger, varByte,
1432 <      varWord, varShortInt:
1433 <      AsLong := Value;
1434 <    varInt64:
1435 <      AsInt64 := Value;
1436 <    varSingle, varDouble:
1437 <      AsDouble := Value;
1438 <    varCurrency:
1439 <      AsCurrency := Value;
1440 <    varBoolean:
1441 <      AsBoolean := Value;
1442 <    varDate:
1443 <      AsDateTime := Value;
1444 <    varOleStr, varString:
1445 <      AsString := Value;
1446 <    varArray:
1447 <      IBError(ibxeNotSupported, [nil]);
1448 <    varByRef, varDispatch, varError, varUnknown, varVariant:
1449 <      IBError(ibxeNotPermitted, [nil]);
1450 <  end;
1451 < end;
1452 <
1453 < procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
1454 < var
1455 <   i: integer;
1456 < begin
1457 <  if FUniqueName then
1458 <     xSetAsVariant(Value)
1459 <  else
1460 <  for i := 0 to FParent.FCount - 1 do
1461 <    if FParent[i].FName = FName then
1462 <       FParent[i].xSetAsVariant(Value);
1463 < end;
1464 <
1465 < procedure TIBXSQLVAR.xSetAsXSQLVAR(Value: PXSQLVAR);
1466 < var
1467 <  sqlind: PShort;
1468 <  sqldata: PChar;
1469 <  local_sqllen: Integer;
1470 < begin
1471 <  sqlind := FXSQLVAR^.sqlind;
1472 <  sqldata := FXSQLVAR^.sqldata;
1473 <  Move(Value^, FXSQLVAR^, SizeOf(TXSQLVAR));
1474 <  FXSQLVAR^.sqlind := sqlind;
1475 <  FXSQLVAR^.sqldata := sqldata;
1476 <  if (Value^.sqltype and 1 = 1) then
1477 <  begin
1478 <    if (FXSQLVAR^.sqlind = nil) then
1479 <      IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short));
1480 <    FXSQLVAR^.sqlind^ := Value^.sqlind^;
1481 <  end
1482 <  else
1483 <    if (FXSQLVAR^.sqlind <> nil) then
1484 <      ReallocMem(FXSQLVAR^.sqlind, 0);
1485 <  if ((FXSQLVAR^.sqltype and (not 1)) = SQL_VARYING) then
1486 <    local_sqllen := FXSQLVAR^.sqllen + 2
1487 <  else
1488 <    local_sqllen := FXSQLVAR^.sqllen;
1489 <  FXSQLVAR^.sqlscale := Value^.sqlscale;
1490 <  IBAlloc(FXSQLVAR^.sqldata, 0, local_sqllen);
1491 <  Move(Value^.sqldata[0], FXSQLVAR^.sqldata[0], local_sqllen);
1492 <  FModified := True;
1493 < end;
1494 <
1495 < procedure TIBXSQLVAR.SetAsXSQLVAR(Value: PXSQLVAR);
1496 < var
1497 <  i: Integer;
1498 < begin
1499 <  if FUniqueName then
1500 <     xSetAsXSQLVAR(Value)
1501 <  else
1502 <  for i := 0 to FParent.FCount - 1 do
1503 <    if FParent[i].FName = FName then
1504 <       FParent[i].xSetAsXSQLVAR(Value);
1505 < end;
1506 <
1507 < procedure TIBXSQLVAR.xSetIsNull(Value: Boolean);
1508 < begin
1509 <  if Value then
1510 <  begin
1511 <    if not IsNullable then
1512 <      IsNullable := True;
1513 <
1514 <    if Assigned(FXSQLVAR^.sqlind) then
1515 <      FXSQLVAR^.sqlind^ := -1;
1516 <    FModified := True;
1517 <  end
1518 <  else
1519 <    if ((not Value) and IsNullable) then
1520 <    begin
1521 <      if Assigned(FXSQLVAR^.sqlind) then
1522 <        FXSQLVAR^.sqlind^ := 0;
1523 <      FModified := True;
1524 <    end;
1525 < end;
1526 <
1527 < procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
1528 < var
1529 <  i: Integer;
1530 < begin
1531 <  if FUniqueName then
1532 <     xSetIsNull(Value)
1533 <  else
1534 <  for i := 0 to FParent.FCount - 1 do
1535 <    if FParent[i].FName = FName then
1536 <       FParent[i].xSetIsNull(Value);
1537 < end;
1538 <
1539 < procedure TIBXSQLVAR.xSetIsNullable(Value: Boolean);
1540 < begin
1541 <  if (Value <> IsNullable) then
1542 <  begin
1543 <    if Value then
1544 <    begin
1545 <      FXSQLVAR^.sqltype := FXSQLVAR^.sqltype or 1;
1546 <      IBAlloc(FXSQLVAR^.sqlind, 0, SizeOf(Short));
1547 <    end
1548 <    else
1549 <    begin
1550 <      FXSQLVAR^.sqltype := FXSQLVAR^.sqltype and (not 1);
1551 <      ReallocMem(FXSQLVAR^.sqlind, 0);
1552 <    end;
1553 <  end;
1554 < end;
1555 <
1556 < procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
1557 < var
1558 <  i: Integer;
1559 < begin
1560 <  if FUniqueName then
1561 <     xSetIsNullable(Value)
1562 <  else
1563 <  for i := 0 to FParent.FCount - 1 do
1564 <    if FParent[i].FName = FName then
1565 <       FParent[i].xSetIsNullable(Value);
1566 < end;
1567 <
1568 < procedure TIBXSQLVAR.xSetAsBoolean(AValue: boolean);
1569 < begin
1570 <  if IsNullable then
1571 <    IsNull := False;
1572 <
1573 <  FXSQLVAR^.sqltype := SQL_BOOLEAN;
1574 <  FXSQLVAR^.sqllen := 1;
1575 <  FXSQLVAR^.sqlscale := 0;
1576 <  IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
1577 <  if AValue then
1578 <    PByte(FXSQLVAR^.sqldata)^ := ISC_TRUE
1579 <  else
1580 <    PByte(FXSQLVAR^.sqldata)^ := ISC_FALSE;
1581 <  FModified := True;
1582 < end;
1583 <
1584 < procedure TIBXSQLVAR.Clear;
1585 < begin
1586 <  IsNull := true;
1587 < end;
1588 <
1589 <
1590 < { TIBXSQLDA }
1591 < constructor TIBXSQLDA.Create(Query: TIBSQL; sqldaType: TIBXSQLDAType);
1592 < begin
1593 <  inherited Create;
1594 <  FSQL := Query;
1595 <  FSize := 0;
1596 <  FUniqueRelationName := '';
1597 <  FInputSQLDA := sqldaType = daInput;
1598 < end;
1599 <
1600 < destructor TIBXSQLDA.Destroy;
1601 < var
1602 <  i: Integer;
1603 < begin
1604 <  if FXSQLDA <> nil then
1605 <  begin
1606 <    for i := 0 to FSize - 1 do
1607 <    begin
1608 <      FreeMem(FXSQLVARs[i].FXSQLVAR^.sqldata);
1609 <      FreeMem(FXSQLVARs[i].FXSQLVAR^.sqlind);
1610 <      FXSQLVARs[i].Free ;
1611 <    end;
1612 <    FreeMem(FXSQLDA);
1613 <    FXSQLDA := nil;
1614 <    FXSQLVARs := nil;
1615 <  end;
1616 <  inherited Destroy;
1617 < end;
1618 <
1619 <    procedure TIBXSQLDA.SetParamName(FieldName: String; Idx: Integer;
1620 <    UniqueName: boolean);
1621 < var
1622 <  fn: string;
1623 < begin
1624 <  {$ifdef UseCaseSensitiveParamName}
1625 <  FXSQLVARs[Idx].FName := AnsiUpperCase(FieldName);
1626 <  {$else}
1627 <  FXSQLVARs[Idx].FName := FieldName;
1628 <  {$endif}
1629 <  FXSQLVARs[Idx].FIndex := Idx;
1630 <  FXSQLVARs[Idx].FUniqueName :=  UniqueName
1631 < end;
1632 <
1633 < function TIBXSQLDA.GetModified: Boolean;
1634 < var
1635 <  i: Integer;
1636 < begin
1637 <  result := False;
1638 <  for i := 0 to FCount - 1 do
1639 <    if FXSQLVARs[i].Modified then
1640 <    begin
1641 <      result := True;
1642 <      exit;
1643 <    end;
1644 < end;
1645 <
1646 < function TIBXSQLDA.GetRecordSize: Integer;
1647 < begin
1648 <  result := SizeOf(TIBXSQLDA) + XSQLDA_LENGTH(FSize);
1649 < end;
1650 <
1651 < function TIBXSQLDA.GetXSQLDA: PXSQLDA;
1652 < begin
1653 <  result := FXSQLDA;
1654 < end;
1655 <
1656 < function TIBXSQLDA.GetXSQLVAR(Idx: Integer): TIBXSQLVAR;
1657 < begin
1658 <  if (Idx < 0) or (Idx >= FCount) then
1659 <    IBError(ibxeXSQLDAIndexOutOfRange, [nil]);
1660 <  result := FXSQLVARs[Idx]
1661 < end;
1662 <
1663 < function TIBXSQLDA.ByName(Idx: String): TIBXSQLVAR;
1664 < begin
1665 <  result := GetXSQLVARByName(Idx);
1666 <  if result = nil then
1667 <    IBError(ibxeFieldNotFound, [Idx]);
1668 < end;
1669 <
1670 < function TIBXSQLDA.GetXSQLVARByName(Idx: String): TIBXSQLVAR;
1671 < var
1672 <  s: String;
1673 <  i: Integer;
1674 < begin
1675 <  {$ifdef ALLOWDIALECT3PARAMNAMES}
1676 <  s := FormatIdentifierValueNC(FSQL.Database.SQLDialect, Idx);
1677 <  {$else}
1678 <  {$ifdef UseCaseSensitiveParamName}
1679 <   s := AnsiUpperCase(Idx);
1680 <  {$else}
1681 <   s := Idx;
1682 <  {$endif}
1683 <  {$endif}
1684 <  for i := 0 to FCount - 1 do
1685 <    if Vars[i].FName = s then
1686 <    begin
1687 <         Result := FXSQLVARs[i];
1688 <         Exit;
1689 <    end;
1690 <  Result := nil;
1691 < end;
1692 <
1693 < procedure TIBXSQLDA.Initialize;
1694 <
1695 <    function VarByName(idx: string; limit: integer): TIBXSQLVAR;
1696 <    var
1697 <       k: integer;
1698 <    begin
1699 <         for k := 0 to limit do
1700 <             if FXSQLVARs[k].FName = idx then
1701 <             begin
1702 <                  Result := FXSQLVARs[k];
1703 <                  Exit;
1704 <             end;
1705 <         Result := nil;
1706 <    end;
1707 <
1708 < var
1709 <  i, j, j_len: Integer;
1710 <  st: String;
1711 <  bUnique: Boolean;
1712 <  sBaseName: string;
1713 < begin
1714 <  bUnique := True;
1715 <  if FXSQLDA <> nil then
1716 <  begin
1717 <    for i := 0 to FCount - 1 do
1718 <    begin
1719 <      with FXSQLVARs[i].Data^ do
1720 <      begin
1721 <
1722 <        {First get the unique relation name, if any}
1723 <
1724 <        if bUnique and (strpas(relname) <> '') then
1725 <        begin
1726 <          if FUniqueRelationName = '' then
1727 <            FUniqueRelationName := strpas(relname)
1728 <          else
1729 <            if strpas(relname) <> FUniqueRelationName then
1730 <            begin
1731 <              FUniqueRelationName := '';
1732 <              bUnique := False;
1733 <            end;
1734 <        end;
1735 <
1736 <        {If an output SQLDA then copy the aliasnames to the FName list. Ensure
1737 <         that they are all upper case only and disambiguated.
1738 <        }
1739 <
1740 <        if not FInputSQLDA then
1741 <        begin
1742 <          st := Space2Underscore(AnsiUppercase(strpas(aliasname)));
1743 <          if st = '' then
1744 <          begin
1745 <            sBaseName := 'F_'; {do not localize}
1746 <            aliasname_length := 2;
1747 <            j := 1; j_len := 1;
1748 <            st := sBaseName + IntToStr(j);
1749 <          end
1750 <          else
1751 <          begin
1752 <            j := 0; j_len := 0;
1753 <            sBaseName := st;
1754 <          end;
1755 <
1756 <          {Look for other columns with the same name and make unique}
1757 <
1758 <          while VarByName(st,i-1) <> nil do
1759 <          begin
1760 <               Inc(j);
1761 <               j_len := Length(IntToStr(j));
1762 <               if j_len + Length(sBaseName) > 31 then
1763 <                  st := Copy(sBaseName, 1, 31 - j_len) + IntToStr(j)
1764 <               else
1765 <                  st := sBaseName + IntToStr(j);
1766 <          end;
1767 <
1768 <          FXSQLVARs[i].FName := st;
1769 <        end;
1770 <
1771 <        {Finally initialise the XSQLVAR}
1772 <
1773 <        FXSQLVARs[i].FIndex := i;
1774 <
1775 <        case sqltype and (not 1) of
1776 <          SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
1777 <          SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
1778 <          SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT: begin
1779 <            if (sqllen = 0) then
1780 <              { Make sure you get a valid pointer anyway
1781 <               select '' from foo }
1782 <              IBAlloc(sqldata, 0, 1)
1783 <            else
1784 <              IBAlloc(sqldata, 0, sqllen)
1785 <          end;
1786 <          SQL_VARYING: begin
1787 <            IBAlloc(sqldata, 0, sqllen + 2);
1788 <          end;
1789 <          else
1790 <            IBError(ibxeUnknownSQLDataType, [sqltype and (not 1)])
1791 <        end;
1792 <        if (sqltype and 1 = 1) then
1793 <          IBAlloc(sqlind, 0, SizeOf(Short))
1794 <        else
1795 <          if (sqlind <> nil) then
1796 <            ReallocMem(sqlind, 0);
1797 <      end;
1798 <    end;
1799 <  end;
1800 < end;
1801 <
1802 < procedure TIBXSQLDA.SetCount(Value: Integer);
1803 < var
1804 <  i, OldSize: Integer;
1805 <  p : PXSQLVAR;
1806 < begin
1807 <  FCount := Value;
1808 <  if FCount = 0 then
1809 <    FUniqueRelationName := ''
1810 <  else
1811 <  begin
1812 <    if FSize > 0 then
1813 <      OldSize := XSQLDA_LENGTH(FSize)
1814 <    else
1815 <      OldSize := 0;
1816 <    if FCount > FSize then
1817 <    begin
1818 <      IBAlloc(FXSQLDA, OldSize, XSQLDA_LENGTH(FCount));
1819 <      SetLength(FXSQLVARs, FCount);
1820 <      FXSQLDA^.version := SQLDA_VERSION1;
1821 <      p := @FXSQLDA^.sqlvar[0];
1822 <      for i := 0 to FCount - 1 do
1823 <      begin
1824 <        if i >= FSize then
1825 <          FXSQLVARs[i] := TIBXSQLVAR.Create(self, FSQL);
1826 <        FXSQLVARs[i].FXSQLVAR := p;
1827 <        p := Pointer(PChar(p) + sizeof(FXSQLDA^.sqlvar));
1828 <      end;
1829 <      FSize := FCount;
1830 <    end;
1831 <    if FSize > 0 then
1832 <    begin
1833 <      FXSQLDA^.sqln := Value;
1834 <      FXSQLDA^.sqld := Value;
1835 <    end;
1836 <  end;
257 >  ReallocMem(Pointer(P), NewSize);
258 >  for i := OldSize to NewSize - 1 do PChar(P)[i] := #0;
259   end;
260  
261   { TIBOutputDelimitedFile }
# Line 1879 | Line 301 | begin
301    begin
302      for i := 0 to Columns.Count - 1 do
303        if i = 0 then
304 <        st := strpas(Columns[i].Data^.aliasname)
304 >        st := Columns[i].GetAliasname
305        else
306 <        st := st + FColDelimiter + strpas(Columns[i].Data^.aliasname);
306 >        st := st + FColDelimiter + Columns[i].GetAliasname;
307      st := st + FRowDelimiter;
308      {$IFDEF UNIX}
309      if FHandle <> -1 then
# Line 2072 | Line 494 | begin
494      for i := 0 to Columns.Count - 1 do
495      begin
496        {$IFDEF UNIX}
497 <      BytesWritten := FpWrite(FHandle,Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen);
497 >      BytesWritten := FpWrite(FHandle,Columns[i].GetAsPointer^, Columns[i].GetSize);
498        {$ELSE}
499 <      WriteFile(FHandle, Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen,
499 >      WriteFile(FHandle, Columns[i].GetAsPointer^, Columns[i].GetSize,
500                  BytesWritten, nil);
501        {$ENDIF}
502 <      if BytesWritten <> DWORD(Columns[i].Data^.sqllen) then
502 >      if BytesWritten <> DWORD(Columns[i].GetSize) then
503          exit;
504      end;
505      result := True;
# Line 2112 | Line 534 | begin
534      for i := 0 to Params.Count - 1 do
535      begin
536        {$IFDEF UNIX}
537 <      BytesRead := FpRead(FHandle,Params[i].Data^.sqldata^,Params[i].Data^.sqllen);
537 >      BytesRead := FpRead(FHandle,Params[i].GetAsPointer^,Params[i].GetSize);
538        {$ELSE}
539 <      ReadFile(FHandle, Params[i].Data^.sqldata^, Params[i].Data^.sqllen,
539 >      ReadFile(FHandle, Params[i].GetAsPointer^, Params[i].GetSize,
540                 BytesRead, nil);
541        {$ENDIF}
542 <      if BytesRead <> DWORD(Params[i].Data^.sqllen) then
542 >      if BytesRead <> DWORD(Params[i].GetSize) then
543          exit;
544      end;
545      result := True;
# Line 2144 | Line 566 | end;
566  
567   { TIBSQL }
568   constructor TIBSQL.Create(AOwner: TComponent);
2147 var  GUID : TGUID;
569   begin
570    inherited Create(AOwner);
2150  FIBLoaded := False;
2151  CheckIBLoaded;
2152  FIBLoaded := True;
571    FGenerateParamNames := False;
572    FGoToFirstRecordOnExecute := True;
573    FBase := TIBBase.Create(Self);
574    FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
575    FBase.BeforeTransactionEnd := BeforeTransactionEnd;
2158  FBOF := False;
2159  FEOF := False;
2160  FPrepared := False;
576    FRecordCount := 0;
577    FSQL := TStringList.Create;
578    TStringList(FSQL).OnChanging := SQLChanging;
579    TStringList(FSQL).OnChange := SQLChanged;
2165  FProcessedSQL := TStringList.Create;
2166  FHandle := nil;
2167  FSQLParams := TIBXSQLDA.Create(self,daInput);
2168  FSQLRecord := TIBXSQLDA.Create(self,daOutput);
2169  FSQLType := SQLUnknown;
580    FParamCheck := True;
2171  CreateGuid(GUID);
2172  FCursor := GUIDToString(GUID);
581    if AOwner is TIBDatabase then
582      Database := TIBDatabase(AOwner)
583    else
# Line 2179 | Line 587 | end;
587  
588   destructor TIBSQL.Destroy;
589   begin
590 <  if FIBLoaded then
591 <  begin
592 <    if (FOpen) then
2185 <      Close;
2186 <    if (FHandle <> nil) then
2187 <      FreeHandle;
2188 <    FSQL.Free;
2189 <    FProcessedSQL.Free;
2190 <    FBase.Free;
2191 <    FSQLParams.Free;
2192 <    FSQLRecord.Free;
2193 <  end;
590 >  FreeHandle;
591 >  FSQL.Free;
592 >  FBase.Free;
593    inherited Destroy;
594   end;
595  
# Line 2198 | Line 597 | procedure TIBSQL.BatchInput(InputObject:
597   begin
598    if not Prepared then
599      Prepare;
600 <  InputObject.FParams := Self.FSQLParams;
600 >  InputObject.FParams := Self.GetSQLParams;
601    InputObject.ReadyFile;
602 <  if FSQLType in [SQLInsert, SQLUpdate, SQLDelete, SQLExecProcedure] then
602 >  if GetSQLStatementType in [SQLInsert, SQLUpdate, SQLDelete, SQLExecProcedure] then
603      while InputObject.ReadParameters do
604        ExecQuery;
605   end;
# Line 2210 | Line 609 | begin
609    CheckClosed;
610    if not Prepared then
611      Prepare;
612 <  if FSQLType = SQLSelect then begin
612 >  if GetSQLStatementType = SQLSelect then begin
613      try
614        ExecQuery;
615 <      OutputObject.FColumns := Self.FSQLRecord;
615 >      OutputObject.FColumns := Self.FResults;
616        OutputObject.ReadyFile;
617        if not FGoToFirstRecordOnExecute then
618          Next;
# Line 2227 | Line 626 | end;
626  
627   procedure TIBSQL.CheckClosed;
628   begin
629 <  if FOpen then IBError(ibxeSQLOpen, [nil]);
629 >  if FResultSet <> nil  then IBError(ibxeSQLOpen, [nil]);
630   end;
631  
632   procedure TIBSQL.CheckOpen;
633   begin
634 <  if not FOpen then IBError(ibxeSQLClosed, [nil]);
634 >  if FResultSet = nil then IBError(ibxeSQLClosed, [nil]);
635   end;
636  
637   procedure TIBSQL.CheckValidStatement;
638   begin
639    FBase.CheckTransaction;
640 <  if (FHandle = nil) then
640 >  if (FStatement = nil) then
641      IBError(ibxeInvalidStatementHandle, [nil]);
642   end;
643  
644   procedure TIBSQL.Close;
2246 var
2247  isc_res: ISC_STATUS;
645   begin
646 <  try
647 <    if (FHandle <> nil) and (SQLType = SQLSelect) and FOpen then begin
648 <      isc_res := Call(
649 <                   isc_dsql_free_statement(StatusVector, @FHandle, DSQL_close),
650 <                   False);
651 <      if (StatusVector^ = 1) and (isc_res > 0) and
652 <        not CheckStatusVector(
2256 <              [isc_bad_stmt_handle, isc_dsql_cursor_close_err]) then
2257 <        IBDatabaseError;
2258 <    end;
2259 <  finally
2260 <    FEOF := False;
2261 <    FBOF := False;
2262 <    FOpen := False;
2263 <    FRecordCount := 0;
2264 <  end;
646 >  if FResults <> nil then
647 >    FResults.SetRetainInterfaces(false);
648 >  FResultSet := nil;
649 >  FResults := nil;
650 >  FBOF := false;
651 >  FEOF := false;
652 >  FRecordCount := 0;
653   end;
654  
655 < function TIBSQL.Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
655 > function TIBSQL.GetFieldCount: integer;
656   begin
657 <  result := 0;
658 < if Transaction <> nil then
659 <    result := Transaction.Call(ErrCode, RaiseError)
657 >  if FResults <> nil then
658 >    Result := FResults.GetCount
659 >  else
660 >  if FMetaData <> nil then
661 >    Result := FMetaData.GetCount
662    else
663 <  if RaiseError and (ErrCode > 0) then
2274 <    IBDataBaseError;
663 >    Result := 0;
664   end;
665  
666 < function TIBSQL.Current: TIBXSQLDA;
666 > function TIBSQL.GetOpen: Boolean;
667   begin
668 <  result := FSQLRecord;
668 >  Result := FResultSet <> nil;
669   end;
670  
671 < function TIBSQL.GetFieldCount: integer;
671 > function TIBSQL.GetPrepared: Boolean;
672 > begin
673 >  Result := (FStatement <> nil) and FStatement.IsPrepared;
674 > end;
675 >
676 > function TIBSQL.GetSQLStatementType: TIBSQLStatementTypes;
677   begin
678 <  Result := FSQLRecord.Count
678 >  if FStatement = nil then
679 >    Result := SQLUnknown
680 >  else
681 >    Result := FStatement.GetSQLStatementType;
682   end;
683  
684   procedure TIBSQL.SetUniqueParamNames(AValue: Boolean);
# Line 2293 | Line 690 | end;
690  
691   procedure TIBSQL.DoBeforeDatabaseDisconnect(Sender: TObject);
692   begin
693 <  if (FHandle <> nil) then begin
2297 <    Close;
2298 <    FreeHandle;
2299 <  end;
693 >  FreeHandle;
694   end;
695  
696   procedure TIBSQL.ExecQuery;
697   var
698    fetch_res: ISC_STATUS;
699 +  {$IFDEF IBXQUERYSTATS}
700 +  stats: TPerfCounters;
701 +  {$ENDIF}
702 +  {$IFDEF IBXQUERYTIME}
703 +  tmsecs: comp;
704 +  {$ENDIF}
705   begin
706    CheckClosed;
707    if not Prepared then Prepare;
708    CheckValidStatement;
709 <  case FSQLType of
710 <    SQLSelect: begin
711 <      Call(isc_dsql_execute2(StatusVector,
712 <                            TRHandle,
713 <                            @FHandle,
714 <                            Database.SQLDialect,
715 <                            FSQLParams.AsXSQLDA,
716 <                            nil), True);
717 <      Call(
718 <        isc_dsql_set_cursor_name(StatusVector, @FHandle, PChar(FCursor), 0),
719 <        True);
720 <      FOpen := True;
721 <      FBOF := True;
722 <      FEOF := False;
723 <      FRecordCount := 0;
724 <      if not (csDesigning in ComponentState) then
725 <        MonitorHook.SQLExecute(Self);
726 <      if FGoToFirstRecordOnExecute then
727 <        Next;
728 <    end;
729 <    SQLExecProcedure: begin
2330 <      fetch_res := Call(isc_dsql_execute2(StatusVector,
2331 <                            TRHandle,
2332 <                            @FHandle,
2333 <                            Database.SQLDialect,
2334 <                            FSQLParams.AsXSQLDA,
2335 <                            FSQLRecord.AsXSQLDA), True);
2336 <      if not (csDesigning in ComponentState) then
2337 <        MonitorHook.SQLExecute(Self);
2338 < (*      if (fetch_res <> 0) and (fetch_res <> isc_deadlock) then
2339 <      begin
2340 <         { Sometimes a prepared stored procedure appears to get
2341 <           off sync on the server ....This code is meant to try
2342 <           to work around the problem simply by "retrying". This
2343 <           need to be reproduced and fixed.
2344 <         }
2345 <        isc_dsql_prepare(StatusVector, TRHandle, @FHandle, 0,
2346 <                         PChar(FProcessedSQL.Text), 1, nil);
2347 <        Call(isc_dsql_execute2(StatusVector,
2348 <                            TRHandle,
2349 <                            @FHandle,
2350 <                            Database.SQLDialect,
2351 <                            FSQLParams.AsXSQLDA,
2352 <                            FSQLRecord.AsXSQLDA), True);
2353 <      end;  *)
2354 <    end
2355 <    else
2356 <      Call(isc_dsql_execute(StatusVector,
2357 <                           TRHandle,
2358 <                           @FHandle,
2359 <                           Database.SQLDialect,
2360 <                           FSQLParams.AsXSQLDA), True);
2361 <      if not (csDesigning in ComponentState) then
2362 <        MonitorHook.SQLExecute(Self);
709 >  {$IFDEF IBXQUERYTIME}
710 >  tmsecs := TimeStampToMSecs(DateTimeToTimeStamp(Now));
711 >  {$ENDIF}
712 >  if SQLStatementType = SQLSelect then
713 >  begin
714 >    FResultSet := FStatement.OpenCursor;
715 >    FResults := FResultSet;
716 >    FResults.SetRetainInterfaces(true);
717 >    FBOF := True;
718 >    FEOF := False;
719 >    FRecordCount := 0;
720 >    if not (csDesigning in ComponentState) then
721 >      MonitorHook.SQLExecute(Self);
722 >    if FGoToFirstRecordOnExecute then
723 >      Next;
724 >  end
725 >  else
726 >  begin
727 >    FResults := FStatement.Execute;
728 >    if not (csDesigning in ComponentState) then
729 >      MonitorHook.SQLExecute(Self);
730    end;
731 +  {$IFDEF IBXQUERYTIME}
732 +  writeln('Executing ',FStatement.GetSQLText,
733 +    ' Response time= ',Format('%f msecs',[TimeStampToMSecs(DateTimeToTimeStamp(Now)) - tmsecs]));
734 +  {$ENDIF}
735 +  {$IFDEF IBXQUERYSTATS}
736 +  if FStatement.GetPerfStatistics(stats) then
737 +    writeln('Executing ',FStatement.GetSQLText,
738 +    ' Elapsed time= ', FormatFloat('#0.000',stats[psRealTime]/1000),' sec');
739 +  {$ENDIF}
740    FBase.DoAfterExecQuery(self);
741 < //  writeln('Rows Affected = ',RowsAffected);
741 > end;
742 >
743 > function TIBSQL.HasField(FieldName: String): boolean;
744 > begin
745 >  if FResults = nil then
746 >    IBError(ibxeNoFieldAccess,[nil]);
747 >
748 >  Result := FResults.ByName(FieldName) <> nil;
749   end;
750  
751   function TIBSQL.GetEOF: Boolean;
752   begin
753 <  result := FEOF or not FOpen;
753 >  result := FEOF or (FResultSet = nil);
754   end;
755  
756 < function TIBSQL.FieldByName(FieldName: String): TIBXSQLVAR;
2374 < var
2375 <  i: Integer;
756 > function TIBSQL.FieldByName(FieldName: String): ISQLData;
757   begin
758 <  i := GetFieldIndex(FieldName);
759 <  if (i < 0) then
758 >  if FResults = nil then
759 >    IBError(ibxeNoFieldAccess,[nil]);
760 >
761 >  Result := FResults.ByName(FieldName);
762 >
763 >  if Result = nil then
764      IBError(ibxeFieldNotFound, [FieldName]);
2380  result := GetFields(i);
765   end;
766  
767 < function TIBSQL.ParamByName(ParamName: String): TIBXSQLVAR;
767 > function TIBSQL.ParamByName(ParamName: String): ISQLParam;
768   begin
769    Result := Params.ByName(ParamName);
770   end;
771  
772 < function TIBSQL.GetFields(const Idx: Integer): TIBXSQLVAR;
772 > function TIBSQL.GetFields(const Idx: Integer): ISQLData;
773   begin
774 <  if (Idx < 0) or (Idx >= FSQLRecord.Count) then
774 >  if FResults = nil then
775 >    IBError(ibxeNoFieldAccess,[nil]);
776 >
777 >  if (Idx < 0) or (Idx >= FResults.GetCount) then
778      IBError(ibxeFieldNotFound, [IntToStr(Idx)]);
779 <  result := FSQLRecord[Idx];
779 >  result := FResults[Idx];
780   end;
781  
782   function TIBSQL.GetFieldIndex(FieldName: String): Integer;
783 + var Field: IColumnMetaData;
784   begin
785 <  if (FSQLRecord.GetXSQLVarByName(FieldName) = nil) then
785 >  if FMetaData = nil then
786 >    IBError(ibxeNoFieldAccess,[nil]);
787 >
788 >  Field := FMetaData.ByName(FieldName);
789 >
790 >  if Field = nil then
791      result := -1
792    else
793 <    result := FSQLRecord.GetXSQLVarByName(FieldName).Index;
793 >    result := Field.GetIndex;
794   end;
795  
796 < function TIBSQL.Next: TIBXSQLDA;
2404 < var
2405 <  fetch_res: ISC_STATUS;
796 > function TIBSQL.Next: boolean;
797   begin
798 <  result := nil;
799 <  if not FEOF then begin
798 >  result := false;
799 >  if not FEOF then
800 >  begin
801      CheckOpen;
802 <    { Go to the next record... }
803 <    fetch_res :=
804 <      Call(isc_dsql_fetch(StatusVector, @FHandle, Database.SQLDialect, FSQLRecord.AsXSQLDA), False);
805 <    if (fetch_res = 100) or (CheckStatusVector([isc_dsql_cursor_err])) then begin
806 <      FEOF := True;
807 <    end else if (fetch_res > 0) then begin
808 <      try
809 <        IBDataBaseError;
810 <      except
2419 <        Close;
2420 <        raise;
2421 <      end;
2422 <    end else begin
802 >    try
803 >      Result := FResultSet.FetchNext;
804 >    except
805 >      Close;
806 >      raise;
807 >    end;
808 >
809 >    if Result then
810 >    begin
811        Inc(FRecordCount);
812        FBOF := False;
813 <      result := FSQLRecord;
814 <    end;
813 >    end
814 >    else
815 >      FEOF := true;
816 >
817      if not (csDesigning in ComponentState) then
818        MonitorHook.SQLFetch(Self);
819    end;
820   end;
821  
822   procedure TIBSQL.FreeHandle;
2433 var
2434  isc_res: ISC_STATUS;
823   begin
824 <  try
825 <    { The following two lines merely set the SQLDA count
826 <     variable FCount to 0, but do not deallocate
827 <     That way the allocations can be reused for
828 <     a new query sring in the same SQL instance }
829 <    FSQLRecord.Count := 0;
830 <    FSQLParams.Count := 0;
831 <    if FHandle <> nil then begin
2444 <      isc_res :=
2445 <        Call(isc_dsql_free_statement(StatusVector, @FHandle, DSQL_drop), False);
2446 <      if (StatusVector^ = 1) and (isc_res > 0) and (isc_res <> isc_bad_stmt_handle) then
2447 <        IBDataBaseError;
2448 <    end;
2449 <  finally
2450 <    FPrepared := False;
2451 <    FHandle := nil;
2452 <  end;
824 >  if FStatement <> nil then
825 >    FStatement.SetRetainInterfaces(false);
826 >  Close;
827 >  FStatement := nil;
828 >  FResults := nil;
829 >  FResultSet := nil;
830 >  FMetaData := nil;
831 >  FSQLParams := nil;
832   end;
833  
834   function TIBSQL.GetDatabase: TIBDatabase;
# Line 2457 | Line 836 | begin
836    result := FBase.Database;
837   end;
838  
2460 function TIBSQL.GetDBHandle: PISC_DB_HANDLE;
2461 begin
2462  result := FBase.DBHandle;
2463 end;
2464
839   function TIBSQL.GetPlan: String;
2466 var
2467  result_buffer: array[0..16384] of Char;
2468  result_length, i: Integer;
2469  info_request: Char;
840   begin
841    if (not Prepared) or
842 <     (not (FSQLType in [SQLSelect, SQLSelectForUpdate,
842 >     (not (GetSQLStatementType in [SQLSelect, SQLSelectForUpdate,
843         {TODO: SQLExecProcedure, }
844         SQLUpdate, SQLDelete])) then
845      result := ''
846 <  else begin
847 <    info_request := isc_info_sql_get_plan;
2478 <    Call(isc_dsql_sql_info(StatusVector, @FHandle, 2, @info_request,
2479 <                           SizeOf(result_buffer), result_buffer), True);
2480 <    if (result_buffer[0] <> isc_info_sql_get_plan) then
2481 <      IBError(ibxeUnknownError, [nil]);
2482 <    result_length := isc_vax_integer(@result_buffer[1], 2);
2483 <    SetString(result, nil, result_length);
2484 <    for i := 1 to result_length do
2485 <      result[i] := result_buffer[i + 2];
2486 <    result := Trim(result);
2487 <  end;
846 >  else
847 >    Result := FStatement.GetPlan;
848   end;
849  
850   function TIBSQL.GetRecordCount: Integer;
851   begin
852 <  result := FRecordCount;
852 >  Result := FRecordCount;
853   end;
854  
855   function TIBSQL.GetRowsAffected: Integer;
856   var
857 <  info_request: Char;
2498 <  RB: TResultBuffer;
857 >  SelectCount, InsertCount, UpdateCount, DeleteCount: integer;
858   begin
859    if not Prepared then
860 <    result := -1
861 <  else begin
862 <    RB := TResultBuffer.Create;
863 <    try
864 <      info_request := isc_info_sql_records;
2506 <      if isc_dsql_sql_info(StatusVector, @FHandle, 1, @info_request,
2507 <                         RB.Size, RB.buffer) > 0 then
2508 <        IBDatabaseError;
2509 <      case SQLType of
2510 <      SQLInsert, SQLUpdate: {Covers Insert or Update as well as individual update}
2511 <        Result := RB.GetValue(isc_info_sql_records, isc_info_req_insert_count)+
2512 <         RB.GetValue(isc_info_sql_records, isc_info_req_update_count);
2513 <      SQLDelete:
2514 <        Result := RB.GetValue(isc_info_sql_records, isc_info_req_delete_count);
2515 <      SQLExecProcedure:
2516 <        Result :=  RB.GetValue(isc_info_sql_records, isc_info_req_insert_count) +
2517 <                   RB.GetValue(isc_info_sql_records, isc_info_req_update_count) +
2518 <                   RB.GetValue(isc_info_sql_records, isc_info_req_delete_count);
2519 <      else
2520 <        Result := 0;
2521 <      end;
2522 <    finally
2523 <      RB.Free;
2524 <    end;
860 >    Result := -1
861 >  else
862 >  begin
863 >    FStatement.GetRowsAffected(SelectCount, InsertCount, UpdateCount, DeleteCount);
864 >    Result := InsertCount + UpdateCount + DeleteCount;
865    end;
866   end;
867  
868 < function TIBSQL.GetSQLParams: TIBXSQLDA;
868 > function TIBSQL.GetSQLParams: ISQLParams;
869   begin
870    if not Prepared then
871      Prepare;
872 <  result := FSQLParams;
872 >  result := Statement.SQLParams;
873   end;
874  
875   function TIBSQL.GetTransaction: TIBTransaction;
# Line 2537 | Line 877 | begin
877    result := FBase.Transaction;
878   end;
879  
2540 function TIBSQL.GetTRHandle: PISC_TR_HANDLE;
2541 begin
2542  result := FBase.TRHandle;
2543 end;
2544
2545 {
2546 Preprocess SQL
2547 Using FSQL, process the typed SQL and put the process SQL
2548 in FProcessedSQL and parameter names in FSQLParams
2549 }
2550 procedure TIBSQL.PreprocessSQL;
2551 var
2552  cCurChar, cNextChar, cQuoteChar: Char;
2553  sSQL, sProcessedSQL, sParamName: String;
2554  i, iLenSQL, iSQLPos: Integer;
2555  iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
2556  iParamSuffix: Integer;
2557  slNames: TStrings;
2558
2559 const
2560  DefaultState = 0;
2561  CommentState = 1;
2562  QuoteState = 2;
2563  ParamState = 3;
2564 {$ifdef ALLOWDIALECT3PARAMNAMES}
2565  ParamDefaultState = 0;
2566  ParamQuoteState = 1;
2567  {$endif}
2568
2569  procedure AddToProcessedSQL(cChar: Char);
2570  begin
2571    sProcessedSQL[iSQLPos] := cChar;
2572    Inc(iSQLPos);
2573  end;
2574
2575 begin
2576  sParamName := '';
2577  slNames := TStringList.Create;
2578  try
2579    { Do some initializations of variables }
2580    iParamSuffix := 0;
2581    cQuoteChar := '''';
2582    sSQL := FSQL.Text;
2583    iLenSQL := Length(sSQL);
2584    SetString(sProcessedSQL, nil, iLenSQL + 1);
2585    i := 1;
2586    iSQLPos := 1;
2587    iCurState := DefaultState;
2588    {$ifdef ALLOWDIALECT3PARAMNAMES}
2589    iCurParamState := ParamDefaultState;
2590    {$endif}
2591    { Now, traverse through the SQL string, character by character,
2592     picking out the parameters and formatting correctly for InterBase }
2593    while (i <= iLenSQL) do begin
2594      { Get the current token and a look-ahead }
2595      cCurChar := sSQL[i];
2596      if i = iLenSQL then
2597        cNextChar := #0
2598      else
2599        cNextChar := sSQL[i + 1];
2600      { Now act based on the current state }
2601      case iCurState of
2602        DefaultState: begin
2603          case cCurChar of
2604            '''', '"': begin
2605              cQuoteChar := cCurChar;
2606              iCurState := QuoteState;
2607            end;
2608            '?', ':': begin
2609              iCurState := ParamState;
2610              AddToProcessedSQL('?');
2611            end;
2612            '/': if (cNextChar = '*') then begin
2613              AddToProcessedSQL(cCurChar);
2614              Inc(i);
2615              iCurState := CommentState;
2616            end;
2617          end;
2618        end;
2619        CommentState: begin
2620          if (cNextChar = #0) then
2621            IBError(ibxeSQLParseError, [SEOFInComment])
2622          else if (cCurChar = '*') then begin
2623            if (cNextChar = '/') then
2624              iCurState := DefaultState;
2625          end;
2626        end;
2627        QuoteState: begin
2628          if cNextChar = #0 then
2629            IBError(ibxeSQLParseError, [SEOFInString])
2630          else if (cCurChar = cQuoteChar) then begin
2631            if (cNextChar = cQuoteChar) then begin
2632              AddToProcessedSQL(cCurChar);
2633              Inc(i);
2634            end else
2635              iCurState := DefaultState;
2636          end;
2637        end;
2638        ParamState:
2639        begin
2640          { collect the name of the parameter }
2641          {$ifdef ALLOWDIALECT3PARAMNAMES}
2642          if iCurParamState = ParamDefaultState then
2643          begin
2644            if cCurChar = '"' then
2645              iCurParamState := ParamQuoteState
2646            else
2647            {$endif}
2648            if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
2649                sParamName := sParamName + cCurChar
2650            else if FGenerateParamNames then
2651            begin
2652              sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
2653              Inc(iParamSuffix);
2654              iCurState := DefaultState;
2655              slNames.AddObject(sParamName,self); //Note local convention
2656                                                  //add pointer to self to mark entry
2657              sParamName := '';
2658            end
2659            else
2660              IBError(ibxeSQLParseError, [SParamNameExpected]);
2661          {$ifdef ALLOWDIALECT3PARAMNAMES}
2662          end
2663          else begin
2664            { determine if Quoted parameter name is finished }
2665            if cCurChar = '"' then
2666            begin
2667              Inc(i);
2668              slNames.Add(sParamName);
2669              SParamName := '';
2670              iCurParamState := ParamDefaultState;
2671              iCurState := DefaultState;
2672            end
2673            else
2674              sParamName := sParamName + cCurChar
2675          end;
2676          {$endif}
2677          { determine if the unquoted parameter name is finished }
2678          if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
2679            (iCurState <> DefaultState) then
2680          begin
2681            if not (cNextChar in ['A'..'Z', 'a'..'z',
2682                                  '0'..'9', '_', '$']) then begin
2683              Inc(i);
2684              iCurState := DefaultState;
2685              slNames.Add(sParamName);
2686              sParamName := '';
2687            end;
2688          end;
2689        end;
2690      end;
2691      if iCurState <> ParamState then
2692        AddToProcessedSQL(sSQL[i]);
2693      Inc(i);
2694    end;
2695    AddToProcessedSQL(#0);
2696    FSQLParams.Count := slNames.Count;
2697    for i := 0 to slNames.Count - 1 do
2698      FSQLParams.SetParamName(slNames[i], i,FUniqueParamNames or (slNames.Objects[i] <> nil));
2699    FProcessedSQL.Text := sProcessedSQL;
2700  finally
2701    slNames.Free;
2702  end;
2703 end;
2704
880   procedure TIBSQL.SetDatabase(Value: TIBDatabase);
881   begin
882 +  if Value = FBase.Database then Exit;
883    FBase.Database := Value;
884 +  FreeHandle;
885   end;
886  
887   procedure TIBSQL.Prepare;
2711 var
2712  stmt_len: Integer;
2713  res_buffer: array[0..7] of Char;
2714  type_item: Char;
888   begin
889    CheckClosed;
890    FBase.CheckDatabase;
891    FBase.CheckTransaction;
892 <  if FPrepared then
892 >  Close;
893 >  if Prepared then
894      exit;
895    if (FSQL.Text = '') then
896      IBError(ibxeEmptyQuery, [nil]);
897 +
898 +  if FStatement <> nil then
899 +    FStatement.Prepare(Transaction.TransactionIntf)
900 +  else
901    if not ParamCheck then
902 <    FProcessedSQL.Text := FSQL.Text
902 >    FStatement := Database.Attachment.Prepare(Transaction.TransactionIntf,SQL.Text)
903    else
904 <    PreprocessSQL;
905 <  if (FProcessedSQL.Text = '') then
906 <    IBError(ibxeEmptyQuery, [nil]);
907 <  try
908 <    Call(isc_dsql_alloc_statement2(StatusVector, DBHandle,
909 <                                    @FHandle), True);
910 <    Call(isc_dsql_prepare(StatusVector, TRHandle, @FHandle, 0,
911 <               PChar(FProcessedSQL.Text), Database.SQLDialect, nil), True);
912 <    { After preparing the statement, query the stmt type and possibly
913 <      create a FSQLRecord "holder" }
914 <    { Get the type of the statement }
2737 <    type_item := isc_info_sql_stmt_type;
2738 <    Call(isc_dsql_sql_info(StatusVector, @FHandle, 1, @type_item,
2739 <                         SizeOf(res_buffer), res_buffer), True);
2740 <    if (res_buffer[0] <> isc_info_sql_stmt_type) then
2741 <      IBError(ibxeUnknownError, [nil]);
2742 <    stmt_len := isc_vax_integer(@res_buffer[1], 2);
2743 <    FSQLType := TIBSQLTypes(isc_vax_integer(@res_buffer[3], stmt_len));
2744 <    { Done getting the type }
2745 <    case FSQLType of
2746 <      SQLGetSegment,
2747 <      SQLPutSegment,
2748 <      SQLStartTransaction: begin
2749 <        FreeHandle;
2750 <        IBError(ibxeNotPermitted, [nil]);
2751 <      end;
2752 <      SQLCommit,
2753 <      SQLRollback,
2754 <      SQLDDL, SQLSetGenerator,
2755 <      SQLInsert, SQLUpdate, SQLDelete, SQLSelect, SQLSelectForUpdate,
2756 <      SQLExecProcedure: begin
2757 <        { We already know how many inputs there are, so... }
2758 <        if (FSQLParams.FXSQLDA <> nil) and
2759 <           (Call(isc_dsql_describe_bind(StatusVector, @FHandle, Database.SQLDialect,
2760 <                                        FSQLParams.FXSQLDA), False) > 0) then
2761 <          IBDataBaseError;
2762 <        FSQLParams.Initialize;
2763 <        if FSQLType in [SQLSelect, SQLSelectForUpdate,
2764 <                        SQLExecProcedure] then begin
2765 <          { Allocate an initial output descriptor (with one column) }
2766 <          FSQLRecord.Count := 1;
2767 <          { Using isc_dsql_describe, get the right size for the columns... }
2768 <          Call(isc_dsql_describe(StatusVector, @FHandle, Database.SQLDialect, FSQLRecord.FXSQLDA), True);
2769 <          if FSQLRecord.FXSQLDA^.sqld > FSQLRecord.FXSQLDA^.sqln then begin
2770 <            FSQLRecord.Count := FSQLRecord.FXSQLDA^.sqld;
2771 <            Call(isc_dsql_describe(StatusVector, @FHandle, Database.SQLDialect, FSQLRecord.FXSQLDA), True);
2772 <          end else if FSQLRecord.FXSQLDA^.sqld = 0 then
2773 <            FSQLRecord.Count := 0;
2774 <          FSQLRecord.Initialize;
2775 <        end;
2776 <      end;
2777 <    end;
2778 <    FPrepared := True;
2779 <    if not (csDesigning in ComponentState) then
904 >    FStatement := Database.Attachment.PrepareWithNamedParameters(
905 >                     Transaction.TransactionIntf,
906 >                     SQL.Text,
907 >                     GenerateParamNames);
908 >  {$IFDEF IBXQUERYSTATS}
909 >  FStatement.EnableStatistics(true);
910 >  {$ENDIF}
911 >  FMetaData := FStatement.GetMetaData;
912 >  FSQLParams := FStatement.GetSQLParams;
913 >  FStatement.SetRetainInterfaces(true);
914 >  if not (csDesigning in ComponentState) then
915        MonitorHook.SQLPrepare(Self);
2781  except
2782    on E: Exception do begin
2783      if (FHandle <> nil) then
2784        FreeHandle;
2785      if E is EIBInterBaseError then
2786        raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
2787                                       EIBInterBaseError(E).IBErrorCode,
2788                                       EIBInterBaseError(E).Message +
2789                                       sSQLErrorSeparator + FProcessedSQL.Text)
2790      else
2791        raise;
2792    end;
2793  end;
916   end;
917  
918   function TIBSQL.GetUniqueRelationName: String;
919   begin
920 <  if FPrepared and (FSQLType = SQLSelect) then
921 <    result := FSQLRecord.UniqueRelationName
920 >  if Prepared and (GetSQLStatementType = SQLSelect) then
921 >    result := FMetaData.GetUniqueRelationName
922    else
923      result := '';
924   end;
# Line 2823 | Line 945 | procedure TIBSQL.SQLChanging(Sender: TOb
945   begin
946    if Assigned(OnSQLChanging) then
947      OnSQLChanging(Self);
948 <  if FHandle <> nil then FreeHandle;
948 >
949 >  FreeHandle;
950   end;
951  
952   procedure TIBSQL.SQLChanged(Sender: TObject);
# Line 2835 | Line 958 | end;
958   procedure TIBSQL.BeforeTransactionEnd(Sender: TObject;
959    Action: TTransactionAction);
960   begin
961 <  if (FOpen) then
962 <    Close;
961 >  if not (Owner is TIBCustomDataSet) then
962 >    FreeHandle;
963   end;
964  
965   end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines