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 43 by tony, Thu Sep 22 17:10:15 2016 UTC vs.
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines