{*************************************************************}
{                                                             }
{       Borland Delphi Visual Component Library               }
{       InterBase Express core components                     }
{                                                             }
{       Copyright (c) 1998-2003 Borland Software Corporation  }
{                                                             }
{    InterBase Express is based in part on the product        }
{    Free IB Components, written by Gregory H. Deatz for      }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.          }
{    Free IB Components is used under license.                }
{                                                             }
{    Additional code created by Jeff Overcash and used        }
{    with permission.                                         }
{*************************************************************}

unit Borland.Vcl.IBSQL;

{$A8,R-}

interface

uses
  SysUtils, Variants, Windows, Classes, IBHeader, IBErrorCodes, IBExternals,
  DB, IB, IBDatabase, IBUtils, IBXConst, DBConsts, IBIntf, FMTBcd;

type
  TIBSQL = class;
  TIBXSQLDA = class;

  TSQLVAR = class(TObject)
  private
    function GetSqlDef: Short;
  protected
    function GetAliasName: String; virtual; abstract;
    function GetOwnName: String; virtual; abstract;
    function GetRelName: String; virtual; abstract;
    function GetSqlData: IntPtr; virtual; abstract;
    function GetSqlInd: PShort; virtual; abstract;
    function GetSqlLen: Short; virtual; abstract;
    function GetSqlName: String; virtual; abstract;
    function GetSqlPrecision: Short; virtual; abstract;
    function GetSqlScale: Short; virtual; abstract;
    function GetSqlSubtype: Short; virtual; abstract;
    function GetSqlType: Short; virtual; abstract;
    function GetSQLVAR: IntPtr; virtual; abstract;
    procedure SetAliasName(const Value: String); virtual; abstract;
    procedure SetOwnName(const Value: String); virtual; abstract;
    procedure SetRelName(const Value: String); virtual; abstract;
    procedure SetSqlName(const Value: String); virtual; abstract;
    procedure SetSqlData(const Value:IntPtr); virtual; abstract;
    procedure SetSqlInd(const Value: PShort); virtual; abstract;
    procedure SetSqlLen(const Value: Short); virtual; abstract;
    procedure SetSqlPrecision(const Value: Short); virtual; abstract;
    procedure SetSqlScale(const Value: Short); virtual; abstract;
    procedure SetSqlSubtype(const Value: Short); virtual; abstract;
    procedure SetSqlType(const Value: Short); virtual; abstract;
    procedure SetSQLVAR(const Value: IntPtr); virtual; abstract;
  public
    procedure SetDataSize(oldsize, newsize : Integer); virtual; abstract;
    procedure SetIndSize(oldsize, newsize : Integer); virtual; abstract;
    property XSqlVar : IntPtr read GetSQLVAR write SetSQLVAR;
    property SqlType : Short read GetSqlType write SetSqlType;
    property SqlDef : Short read GetSqlDef;
    property SqlScale : Short read GetSqlScale write SetSqlScale;
    property SqlPrecision : Short read GetSqlPrecision write SetSqlPrecision;
    property SqlSubtype : Short read GetSqlSubtype write SetSqlSubtype;
    property SqlLen : Short read GetSqlLen write SetSqlLen;
    property SqlData :IntPtr read GetSqlData write SetSqlData;
    property SqlInd : PShort read GetSqlInd write SetSqlInd;

    property SqlName : String read GetSqlName write SetSqlName;
    property RelName : String read GetRelName write SetRelName;
    property OwnName : String read GetOwnName write SetOwnName;
    property AliasName : String read GetAliasName write SetAliasName;
  end;

  TSQLVAR_V1 = class(TSQLVAR)
  private
    FXSQLVAR : PXSQLVAR_V1;
  protected
    function GetAliasName: String; override;
    function GetOwnName: String; override;
    function GetRelName: String; override;
    function GetSqlData: IntPtr; override;
    function GetSqlInd: PShort; override;
    function GetSqlLen: Short; override;
    function GetSqlName: String; override;
    function GetSqlPrecision: Short; override;
    function GetSqlScale: Short; override;
    function GetSqlSubtype: Short; override;
    function GetSqlType: Short; override;
    function GetSQLVAR: IntPtr; override;
    procedure SetAliasName(const Value: String); override;
    procedure SetOwnName(const Value: String); override;
    procedure SetRelName(const Value: String); override;
    procedure SetSqlName(const Value: String); override;
    procedure SetSqlData(const Value: IntPtr); override;
    procedure SetSqlInd(const Value: PShort); override;
    procedure SetSqlLen(const Value: Short); override;
    procedure SetSqlPrecision(const Value: Short); override;
    procedure SetSqlScale(const Value: Short); override;
    procedure SetSqlSubtype(const Value: Short); override;
    procedure SetSqlType(const Value: Short); override;
    procedure SetSQLVAR(const Value: IntPtr); override;
    procedure SetCharValue(Length_name, Value : String);
  public
    procedure SetDataSize(oldsize, newsize : Integer); override;
    procedure SetIndSize(oldsize, newsize : Integer); override;
  end;

  TSQLVAR_V2 = class(TSQLVAR)
  private
    FXSQLVAR : PXSQLVAR;
  protected
    function GetAliasName: String; override;
    function GetOwnName: String; override;
    function GetRelName: String; override;
    function GetSqlData: IntPtr; override;
    function GetSqlInd: PShort; override;
    function GetSqlLen: Short; override;
    function GetSqlName: String; override;
    function GetSqlPrecision: Short; override;
    function GetSqlScale: Short; override;
    function GetSqlSubtype: Short; override;
    function GetSqlType: Short; override;
    function GetSQLVAR: IntPtr; override;
    procedure SetAliasName(const Value: String); override;
    procedure SetOwnName(const Value: String); override;
    procedure SetRelName(const Value: String); override;
    procedure SetSqlName(const Value: String); override;
    procedure SetSqlData(const Value: IntPtr); override;
    procedure SetSqlInd(const Value: PShort); override;
    procedure SetSqlLen(const Value: Short); override;
    procedure SetSqlPrecision(const Value: Short); override;
    procedure SetSqlScale(const Value: Short); override;
    procedure SetSqlSubtype(const Value: Short); override;
    procedure SetSqlType(const Value: Short); override;
    procedure SetSQLVAR(const Value: IntPtr); override;
    procedure SetCharValue(Length_name, Value : String);
  public
    procedure SetDataSize(oldsize, newsize : Integer); override;
    procedure SetIndSize(oldsize, newsize : Integer); override;
  end;

  { TIBXSQLVAR }
  TIBXSQLVAR = class(TObject)
  private
    FParent: TIBXSQLDA;
    FSQL: TIBSQL;
    FIndex: Integer;
    FModified: Boolean;
    FName: String;
    FXSQLVAR: TSQLVAR;       { Point to the PXSQLVAR in the owner object }
    FMaxLen : Short;     (** length of data area **)
    FGDSLibrary : IGDSLibrary;

    function AdjustScale(Value: Int64; Scale: Integer): Double;
    function AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
    function AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
    function AdjustScaleToBCD(Value: Int64; Scale: Integer): TBcd;

    function GetAsCurrency: Currency;
    function GetAsInt64: Int64;
    function GetAsDateTime: TDateTime;
    function GetAsDouble: Double;
    function GetAsFloat: Float;
    function GetAsLong: Long;
    function GetAsIntPtr: IntPtr;
    function GetAsQuad: TISC_QUAD;
    function GetAsShort: Short;
    function GetAsString: String;
    function GetAsVariant: Variant;
    function GetIsNull: Boolean;
    function GetIsNullable: Boolean;
    function GetSize: Integer;
    function GetSQLType: Integer;
    procedure SetAsCurrency(Value: Currency);
    procedure SetAsInt64(Value: Int64);
    procedure SetAsDate(Value: TDateTime);
    procedure SetAsTime(Value: TDateTime);
    procedure SetAsDateTime(Value: TDateTime);
    procedure SetAsDouble(Value: Double);
    procedure SetAsFloat(Value: Float);
    procedure SetAsLong(Value: Long);
    procedure SetAsIntPtr(Value: IntPtr);
    procedure SetAsQuad(Value: TISC_QUAD);
    procedure SetAsShort(Value: Short);
    procedure SetAsString(Value: String);
    procedure SetAsVariant(Value: Variant);
    procedure SetIsNull(Value: Boolean);
    procedure SetIsNullable(Value: Boolean);
    procedure SetAsTrimString(const Value: String);
    function GetAsTrimString: String;
    function GetAsBoolean: Boolean;
    procedure SetAsBoolean(const Value: Boolean);
//    procedure SetAsXSQLVAR(Value: PXSQLVAR);
    procedure SetFXSQLVAR(const Value: TSQLVAR);
    function GetAsBCD: TBcd;                                                                  
    procedure SetAsBcd(const Value: TBcd);
  public
    constructor Create(Parent: TIBXSQLDA; Query: TIBSQL);
    destructor Destroy; override;
    procedure Assign(Source: TIBXSQLVAR);
    procedure LoadFromFile(const FileName: String);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToFile(const FileName: String);
    procedure SaveToStream(Stream: TStream);
    procedure Clear;
    property AsBoolean : Boolean read GetAsBoolean write SetAsBoolean;
    property AsDate: TDateTime read GetAsDateTime write SetAsDate;
    property AsTime: TDateTime read GetAsDateTime write SetAsTime;
    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
    property AsDouble: Double read GetAsDouble write SetAsDouble;
    property AsFloat: Float read GetAsFloat write SetAsFloat;
    property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
    property AsInt64: Int64 read GetAsInt64 write SetAsInt64;
    property AsInteger: Integer read GetAsLong write SetAsLong;
    property AsLong: Long read GetAsLong write SetAsLong;
    property AsIntPtr: IntPtr read GetAsIntPtr write SetAsIntPtr;
    property AsQuad: TISC_QUAD read GetAsQuad write SetAsQuad;
    property AsShort: Short read GetAsShort write SetAsShort;
    property AsString: String read GetAsString write SetAsString;
    property AsTrimString : String read GetAsTrimString write SetAsTrimString;
    property AsVariant: Variant read GetAsVariant write SetAsVariant;
    property AsBcd : TBcd read GetAsBCD write SetAsBcd;

    property SqlVar : TSQLVAR read FXSQLVAR write SetFXSQLVAR;
    property Data : TSQLVAR read FXSQLVAR write FXSQLVAR;
    property IsNull: Boolean read GetIsNull write SetIsNull;
    property IsNullable: Boolean read GetIsNullable write SetIsNullable;
    property Index: Integer read FIndex;
    property Modified: Boolean read FModified write FModified;
    property Name: String read FName;
    property Size: Integer read GetSize;
    property SQLType: Integer read GetSQLType;
    property Value: Variant read GetAsVariant write SetAsVariant;
  end;

  TIBXSQLVARArray = Array of TIBXSQLVAR;

  { TIBXSQLVAR }
  TIBXSQLDA = class(TObject)
  protected
    FSQL: TIBSQL;
    FCount: Integer;
    FNames: TStrings;
    FSize: Integer;
    FXSQLDA: PXSQLDA;
    FXSQLVARs: TIBXSQLVARArray; { array of IBXQLVARs }
    FUniqueRelationName: String;
    FGDSLibrary : IGDSLibrary;

    function GetModified: Boolean;
    function GetNames: String;
    function GetRecordSize: Integer;
    function GetXSQLDA: PXSQLDA;
    function GetSQLVAR(Idx: Integer): TIBXSQLVAR;
    function GetSQLVARByName(Idx: String): TIBXSQLVAR;
    procedure Initialize;
    procedure SetCount(Value: Integer);
  public
    constructor Create(Query: TIBSQL);
    destructor Destroy; override;
    procedure AddName(FieldName: String; Idx: Integer);
    function ByName(Idx: String): TIBXSQLVAR;
    property AsXSQLDA: PXSQLDA read GetXSQLDA;
    property Count: Integer read FCount write SetCount;
    property Modified: Boolean read GetModified;
    property Names: String read GetNames;
    property RecordSize: Integer read GetRecordSize;
    property Vars[Idx: Integer]: TIBXSQLVAR read GetSQLVAR; default;
    property UniqueRelationName: String read FUniqueRelationName;
  end;

  { TIBBatch }

  TIBBatch = class(TObject)
  protected
    FFilename: String;
    FColumns: TIBXSQLDA;
    FParams: TIBXSQLDA;
  public
    procedure ReadyFile; virtual; abstract;
    property Columns: TIBXSQLDA read FColumns write FColumns;
    property Filename: String read FFilename write FFilename;
    property Params: TIBXSQLDA read FParams write FParams;
  end;

  TIBBatchInput = class(TIBBatch)
  public
    function ReadParameters: Boolean; virtual; abstract;
  end;

  TIBBatchOutput = class(TIBBatch)
  public
    function WriteColumns: Boolean; virtual; abstract;
  end;

  { TIBOutputDelimitedFile }
  TIBOutputDelimitedFile = class(TIBBatchOutput)
  protected
    FFile : TFileStream;
    FOutputTitles: Boolean;
    FColDelimiter,
    FRowDelimiter: string;
  public
    destructor Destroy; override;
    procedure ReadyFile; override;
    function WriteColumns: Boolean; override;
    property ColDelimiter: string read FColDelimiter write FColDelimiter;
    property OutputTitles: Boolean read FOutputTitles
                                   write FOutputTitles;
    property RowDelimiter: string read FRowDelimiter write FRowDelimiter;
  end;

  { TIBInputDelimitedFile }
  TIBInputDelimitedFile = class(TIBBatchInput)
  protected
    FColDelimiter,
    FRowDelimiter: string;
    FEOF: Boolean;
    FFile: TFileStream;
    FLookAhead: Char;
    FReadBlanksAsNull: Boolean;
    FSkipTitles: Boolean;
  public
    destructor Destroy; override;
    function GetColumn(var Col: string): Integer;
    function ReadParameters: Boolean; override;
    procedure ReadyFile; override;
    property ColDelimiter: string read FColDelimiter write FColDelimiter;
    property ReadBlanksAsNull: Boolean read FReadBlanksAsNull
                                       write FReadBlanksAsNull;
    property RowDelimiter: string read FRowDelimiter write FRowDelimiter;
    property SkipTitles: Boolean read FSkipTitles write FSkipTitles;
  end;

  { TIBOutputRawFile }
  TIBOutputRawFile = class(TIBBatchOutput)
  protected
    FFile : TFileStream;
  public
    destructor Destroy; override;
    procedure ReadyFile; override;
    function WriteColumns: Boolean; override;
  end;

  { TIBInputRawFile }
  TIBInputRawFile = class(TIBBatchInput)
  protected
    FFile : TFileStream;
  public
    destructor Destroy; override;
    function ReadParameters: Boolean; override;
    procedure ReadyFile; override;
  end;

  TIBXMLFlag = (  xmlAttribute, xmlDisplayNull, xmlNoHeader);
  TIBXMLFlags = set of TIBXMLFlag;

  TIBOutputXML = class(TObject)
  private
    FTableTag: String;
    FHeaderTag: String;
    FDatabaseTag: String;
    FFlags: TIBXMLFlags;
    FRowTag: String;
    FStream: TStream;
  public
    procedure WriteXML(SQL : TIBSQL);
    property HeaderTag : String read FHeaderTag write FHeaderTag;
    property DatabaseTag : String read FDatabaseTag write FDatabaseTag;
    property Stream : TStream read FStream write FStream;
    property TableTag : String read FTableTag write FTableTag;
    property RowTag : String read FRowTag write FRowTag;
    property Flags : TIBXMLFlags read FFlags write FFlags;
  end;

  { TIBSQL }
  TIBSQLTypes = (SQLUnknown, SQLSelect, SQLInsert,
                  SQLUpdate, SQLDelete, SQLDDL,
                  SQLGetSegment, SQLPutSegment,
                  SQLExecProcedure, SQLStartTransaction,
                  SQLCommit, SQLRollback,
                  SQLSelectForUpdate, SQLSetGenerator);

  TIBSQL = class(TComponent)
  private
    FIBLoaded: Boolean;
    function GetFieldCount: Integer;
  protected
    FBase: TIBBase;
    FBOF,                          { At BOF? }
    FEOF,                          { At EOF? }
    FGoToFirstRecordOnExecute,     { Automatically position record on first record after executing }
    FOpen,                         { Is a cursor open? }
    FPrepared: Boolean;            { Has the query been prepared? }
    FRecordCount: Integer;         { How many records have been read so far? }
    FCursor: IntPtr;               { Cursor name...}
    FHandle: IntPtr;               { Once prepared, this accesses the SQL Query }
    FOnSQLChanging: TNotifyEvent;  { Call this when the SQL is changing }
    FSQL: TStrings;                { SQL Query (by user) }
    FParamCheck: Boolean;          { Check for parameters? (just like TQuery) }
    FProcessedSQL: TStrings;       { SQL Query (pre-processed for param labels) }
    FSQLParams,                    { Any parameters to the query }
    FSQLRecord: TIBXSQLDA;         { The current record }
    FSQLType: TIBSQLTypes;         { Select, update, delete, insert, create, alter, etc...}
    FGenerateParamNames: Boolean;  { Auto generate param names ?}
    FGDSLibrary : IGDSLibrary;
    procedure DoBeforeDatabaseDisconnect(Sender: TObject);
    function GetDatabase: TIBDatabase;
    function GetDBHandle: PISC_DB_HANDLE;
    function GetEOF: Boolean;
    function GetFields(const Idx: Integer): TIBXSQLVAR;
    function GetFieldIndex(FieldName: String): Integer;
    function GetPlan: String;
    function GetRecordCount: Integer;
    function GetRowsAffected: Integer;
    function GetSQLParams: TIBXSQLDA;
    function GetTransaction: TIBTransaction;
    function GetTRHandle: PISC_TR_HANDLE;
    function GetHandleValue : TISC_STMT_HANDLE;
    procedure SetHandleValue(const Value : TISC_STMT_HANDLE);
    procedure PreprocessSQL;
    procedure SetDatabase(Value: TIBDatabase);
    procedure SetSQL(Value: TStrings);
    procedure SetTransaction(Value: TIBTransaction);
    procedure SQLChanging(Sender: TObject);
    procedure BeforeTransactionEnd(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BatchInput(InputObject: TIBBatchInput);
    procedure BatchOutput(OutputObject: TIBBatchOutput);
    procedure OutputXML(OutputObject : TIBOutputXML);
    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
    procedure CheckClosed;           { raise error if query is not closed. }
    procedure CheckOpen;             { raise error if query is not open.}
    procedure CheckValidStatement;   { raise error if statement is invalid.}
    procedure Close;
    function Current: TIBXSQLDA;
    procedure ExecQuery;
    function FieldByName(FieldName: String): TIBXSQLVAR;
    procedure FreeHandle;
    function Next: TIBXSQLDA;
    procedure Prepare;
    procedure Unprepare;
    function GetUniqueRelationName: String;
    function ParamByName(Idx: String): TIBXSQLVAR;
    property Bof: Boolean read FBOF;
    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
    property Eof: Boolean read GetEOF;
    property Fields[const Idx: Integer]: TIBXSQLVAR read GetFields;
    property FieldIndex[FieldName: String]: Integer read GetFieldIndex;
    property Open: Boolean read FOpen;
    property Params: TIBXSQLDA read GetSQLParams;
    property Plan: String read GetPlan;
    property Prepared: Boolean read FPrepared;
    property RecordCount: Integer read GetRecordCount;
    property RowsAffected: Integer read GetRowsAffected;
    property SQLType: TIBSQLTypes read FSQLType;
    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
    property Handle : IntPtr read FHandle;
    property HandleValue: TISC_STMT_HANDLE read GetHandleValue write SetHandleValue;
    property GenerateParamNames: Boolean read FGenerateParamNames write FGenerateParamNames;
    property UniqueRelationName: String read GetUniqueRelationName;
    property FieldCount : Integer Read GetFieldCount;
  published
    property Database: TIBDatabase read GetDatabase write SetDatabase;
    property GoToFirstRecordOnExecute: Boolean read FGoToFirstRecordOnExecute
                                               write FGoToFirstRecordOnExecute
                                               default True;
    property ParamCheck: Boolean read FParamCheck write FParamCheck default true;
    property SQL: TStrings read FSQL write SetSQL;
    property Transaction: TIBTransaction read GetTransaction write SetTransaction;
    property OnSQLChanging: TNotifyEvent read FOnSQLChanging write FOnSQLChanging;
  end;

  procedure OutputXML(sqlObject : TIBSQL; OutputObject: TIBOutputXML);

implementation

uses
  IBBlob, Borland.Vcl.IBSQLMonitor, IBXMLHeader, System.Runtime.InteropServices;

{procedure WriteSQLVAR(reason : String; SQLVARS : TIBXSQLVARArray);
var
  i : Integer;
  data : TSQLVAR;
begin
  writeln(reason);
  for i := 0 to High(SQLVARS) do
  begin
    writeln('');
    data := SQLVARS[i].data;
    writeln(data.sqldef);
    writeln(data.sqlscale);
    writeln(data.sqlprecision);
    writeln(data.sqlsubtype);
    writeln(data.sqllen);
    writeln(data.sqldata);
    writeln(data.sqlind);
    Writeln(Marshal.ReadInt16(Data.XSqlVar, Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR), 'sqlname_length'))));
    writeln(data.sqlname);
    Writeln(Marshal.ReadInt16(Data.XSqlVar, Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR), 'relname_length'))));
    writeln(data.relname);
    Writeln(Marshal.ReadInt16(Data.XSqlVar, Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR), 'ownname_length'))));
    writeln(data.ownname);
    Writeln(Marshal.ReadInt16(Data.XSqlVar, Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR), 'aliasname_length'))));
    writeln(data.aliasname);
  end;
  writeln('------------------');
end;       }

{ TIBXSQLVAR }
constructor TIBXSQLVAR.Create(Parent: TIBXSQLDA; Query: TIBSQL);
begin
  inherited Create;
  FParent := Parent;
  FSQL := Query;
  FGDSLibrary := GetGDSLibrary;
  
  if FGDSLibrary.GetIBClientVersion >= 7 then
    FXSQLVAR := TSQLVAR_V2.Create
  else
    FXSQLVAR := TSQLVAR_V1.Create;
end;

procedure TIBXSQLVAR.Assign(Source: TIBXSQLVAR);
var
  szBuff : TBytes;
  pBuff : IntPtr;
  s_bhandle, d_bhandle: TISC_BLOB_HANDLE;
  bSourceBlob, bDestBlob: Boolean;
  iSegs, iMaxSeg, iSize: Long;
  iBlobType: Short;
begin
  szBuff := nil;
  bSourceBlob := True;
  bDestBlob := True;
  s_bhandle := nil;
  d_bhandle := nil;
  try
    if (Source.IsNull) then
    begin
      IsNull := True;
      exit;
    end
    else
      if (FXSQLVAR.SqlDef = SQL_ARRAY) or
         (Source.FXSQLVAR.SqlDef = SQL_ARRAY) then
        exit; { arrays not supported }
    if (FXSQLVAR.sqlDef <> SQL_BLOB) and
       (Source.FXSQLVAR.SqlDef <> SQL_BLOB) then
    begin
      SQLVAR := Source.SQLVAR;
      exit;
    end
    else
      if (Source.FXSQLVAR.SqlDef <> SQL_BLOB) then
      begin
        SetLength(szBuff, Source.FXSQLVAR.sqllen);

        if (Source.FXSQLVAR.SqlDef = SQL_TEXT) or
           (Source.FXSQLVAR.SqlDef = SQL_VARYING) then
          Marshal.Copy(Source.FXSQLVAR.sqldata, szBuff, 2,
             Marshal.ReadInt16(Source.FXSQLVAR.sqldata))
        else
          Marshal.Copy(Source.FXSQLVAR.sqldata, szBuff, 0, Source.FXSQLVAR.sqllen);
        bSourceBlob := False;
        iSize := Source.FXSQLVAR.sqllen;
      end
      else
        if (FXSQLVAR.SqlDef <> SQL_BLOB) then
          bDestBlob := False;

    if bSourceBlob then
    begin
      { read the blob }
      Source.FSQL.Call(FGDSLibrary.isc_open_blob2(StatusVector, Source.FSQL.DBHandle,
        Source.FSQL.TRHandle, s_bhandle, Source.FXSQLVAR.sqldata, 0, nil), True);
      try
        IBBlob.GetBlobInfo(s_bhandle, iSegs, iMaxSeg, iSize, iBlobType);
        pBuff := Marshal.AllocHGlobal(iSize);
        Borland.Vcl.IBBlob.ReadBlob(s_bhandle, pBuff, iSize);
        SetLength(szBuff, iSize);
        Marshal.Copy(pBuff, szBuff, 0, iSize);
      finally
        Source.FSQL.Call(FGDSLibrary.isc_close_blob(StatusVector, s_bhandle), True);
      end;
    end;

    if bDestBlob then
    begin
      { write the blob }
      FSQL.Call(FGDSLibrary.isc_create_blob2(StatusVector, FSQL.DBHandle,
        FSQL.TRHandle, d_bhandle, FXSQLVAR.sqldata, 0, nil), True);
      try
        IBBlob.WriteBlob(d_bhandle, pBuff, iSize);
        IsNull := false;
      finally
        FSQL.Call(FGDSLibrary.isc_close_blob(StatusVector, d_bhandle), True);
      end;
    end
    else
    begin
      { just copy the buffer }
      FXSQLVAR.sqltype := SQL_TEXT;
      FXSQLVAR.sqllen := iSize;
      FXSQLVAR.SetDataSize(iSize, iSize);
      Marshal.Copy(szBuff, 0, FXSQLVAR.sqldata, iSize);
    end;
  finally
    Marshal.FreeHGlobal(pBuff);
  end;
end;

function TIBXSQLVAR.AdjustScale(Value: Int64; Scale: Integer): Double;
var
  Scaling : Int64;
  i: Integer;
  Val: Double;
begin
  Scaling := 1; Val := Value;
  if Scale > 0 then
  begin
    for i := 1 to Scale do
      Scaling := Scaling * 10;
    result := Val * Scaling;
  end
  else
    if Scale < 0 then
    begin
      for i := -1 downto Scale do
        Scaling := Scaling * 10;
      result := Val / Scaling;
    end
    else
      result := Val;
end;

function TIBXSQLVAR.AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
var
  Scaling : Int64;
  i: Integer;
  Val: Int64;
begin
  Scaling := 1; Val := Value;
  if Scale > 0 then begin
    for i := 1 to Scale do Scaling := Scaling * 10;
    result := Val * Scaling;
  end else if Scale < 0 then begin
    for i := -1 downto Scale do Scaling := Scaling * 10;
    result := Val div Scaling;
  end else
    result := Val;
end;

function TIBXSQLVAR.AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
var
  Scaling : Int64;
  i : Integer;
  FractionText, PadText, CurrText: string;
begin
  Result := 0;
  Scaling := 1;
  if Scale > 0 then
  begin
    for i := 1 to Scale do
      Scaling := Scaling * 10;
    result := Value * Scaling;
  end
  else
    if Scale < 0 then
    begin
      for i := -1 downto Scale do
        Scaling := Scaling * 10;
      FractionText := IntToStr(abs(Value mod Scaling));
      for i := Length(FractionText) to -Scale -1 do
        PadText := '0' + PadText;
      if Value < 0 then
        CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
      else
        CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
      try
        result := StrToCurr(CurrText);
      except
        on E: Exception do
          IBError(ibxeInvalidDataConversion, [nil]);
      end;
    end
    else
      result := Value;
end;

function TIBXSQLVAR.GetAsCurrency: Currency;
begin
  result := 0;
  if FSQL.Database.SQLDialect < 3 then
    result := GetAsDouble
  else begin
    if not IsNull then
      case FXSQLVAR.SqlDef of
        SQL_TEXT, SQL_VARYING: begin
          try
            result := StrtoCurr(AsString);
          except
            on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
          end;
        end;
        SQL_SHORT:
          result := AdjustScaleToCurrency(Marshal.ReadInt16(FXSQLVAR.sqldata),
                                      FXSQLVAR.sqlscale);
        SQL_LONG:
          result := AdjustScaleToCurrency(Marshal.ReadInt32(FXSQLVAR.sqldata),
                                      FXSQLVAR.sqlscale);
        SQL_INT64:
          result := AdjustScaleToCurrency(Marshal.ReadInt64(FXSQLVAR.sqldata),
                                      FXSQLVAR.sqlscale);
        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
          result := GetAsDouble;
        else
          IBError(ibxeInvalidDataConversion, [nil]);
      end;
    end;
end;

function TIBXSQLVAR.GetAsInt64: Int64;
begin
  result := 0;
  if not IsNull then
    case FXSQLVAR.SqlDef of
      SQL_TEXT, SQL_VARYING: begin
        try
          result := StrToInt64(AsString);
        except
          on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
        end;
      end;
      SQL_SHORT:
        result := AdjustScaleToInt64(Marshal.ReadInt16(FXSQLVAR.sqldata),
                                    FXSQLVAR.sqlscale);
      SQL_LONG:
        result := AdjustScaleToInt64(Marshal.ReadInt32(FXSQLVAR.sqldata),
                                    FXSQLVAR.sqlscale);
      SQL_INT64:
        result := AdjustScaleToInt64(Marshal.ReadInt64(FXSQLVAR.sqldata),
                                    FXSQLVAR.sqlscale);
      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
        result := Trunc(AsDouble);
      SQL_BOOLEAN :
        case Marshal.ReadInt16(FXSQLVAR.sqldata) of
          ISC_TRUE : Result := 1;
          ISC_FALSE : Result := 0;
        end;
      else
        IBError(ibxeInvalidDataConversion, [nil]);
    end;
end;

function TIBXSQLVAR.GetAsDateTime: TDateTime;
var
  tm_date: TCTimeStructure;
begin
  result := 0;
  if not IsNull then
    case FXSQLVAR.SqlDef of
      SQL_TEXT, SQL_VARYING: begin
        try
          result := StrToDate(AsString);
        except
          on E: EConvertError do
            IBError(ibxeInvalidDataConversion, [nil]);
        end;
      end;
      SQL_TYPE_DATE:
      begin
        FGDSLibrary.isc_decode_sql_date(FXSQLVAR.sqldata, tm_date);
        if not TDateTime.TryEncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
                               Word(tm_date.tm_mday), Result) then
          IBError(ibxeInvalidDataConversion, [nil]);
      end;
      SQL_TYPE_TIME:
      begin
        FGDSLibrary.isc_decode_sql_time(PISC_TIME(FXSQLVAR.sqldata), tm_date);
        if not TDateTime.TryEncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
                               Word(tm_date.tm_sec), 0, Result) then
          IBError(ibxeInvalidDataConversion, [nil]);
      end;
      SQL_TIMESTAMP: begin
        FGDSLibrary.isc_decode_date(FXSQLVAR.sqldata, tm_date);
        if not TDateTime.TryEncodeDateTime(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
                            Word(tm_date.tm_mday), Word(tm_date.tm_hour),
                            Word(tm_date.tm_min), Word(tm_date.tm_sec), 0, Result) then
          IBError(ibxeInvalidDataConversion, [nil]);
      end;
      else
        IBError(ibxeInvalidDataConversion, [nil]);
    end;
end;

function TIBXSQLVAR.GetAsDouble: Double;
begin
  result := 0;
  if not IsNull then begin
    case FXSQLVAR.SqlDef of
      SQL_TEXT, SQL_VARYING: begin
        try
          result := StrToFloat(AsString);
        except
          on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
        end;
      end;
      SQL_SHORT:
        result := AdjustScale(Marshal.ReadInt16(FXSQLVAR.sqldata),
                              FXSQLVAR.sqlscale);
      SQL_LONG:
        result := AdjustScale(Marshal.ReadInt32(FXSQLVAR.sqldata),
                              FXSQLVAR.sqlscale);
      SQL_INT64:
        result := AdjustScale(Marshal.ReadInt64(FXSQLVAR.sqldata), FXSQLVAR.sqlscale);
      SQL_FLOAT:
        result := BitConverter.ToSingle(BitConverter.GetBytes(Marshal.ReadInt32(FXSQLVAR.sqldata)), 0);
      SQL_DOUBLE, SQL_D_FLOAT:
        result := BitConverter.Int64BitsToDouble(Marshal.ReadInt64(FXSQLVAR.sqldata));
      SQL_BOOLEAN :
        case Marshal.ReadInt16(FXSQLVAR.sqldata) of
          ISC_TRUE : Result := 1;
          ISC_FALSE : Result := 0;
        end;
      else
        IBError(ibxeInvalidDataConversion, [nil]);
    end;
    if  FXSQLVAR.sqlscale <> 0 then
      result :=
        StrToFloat(FloatToStrF(result, fffixed, 15,
                  Abs(FXSQLVAR.sqlscale) ));
  end;
end;

function TIBXSQLVAR.GetAsFloat: Float;
begin
  result := 0;
  try
    result := AsDouble;
  except
    on E: Borland.Delphi.System.EOverflow do
      IBError(ibxeInvalidDataConversion, [nil]);
  end;
end;

function TIBXSQLVAR.GetAsLong: Long;
begin
  result := 0;
  if not IsNull then
    case FXSQLVAR.SqlDef of
      SQL_TEXT, SQL_VARYING: begin
        try
          result := StrToInt(AsString);
        except
          on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
        end;
      end;
      SQL_SHORT:
        result := Trunc(AdjustScale(Marshal.ReadInt16(FXSQLVAR.sqldata),
                                    FXSQLVAR.sqlscale));
      SQL_LONG:
        result := Trunc(AdjustScale(Marshal.ReadInt32(FXSQLVAR.sqldata),
                                    FXSQLVAR.sqlscale));
      SQL_INT64:
        result := Trunc(AdjustScale(Marshal.ReadInt64(FXSQLVAR.sqldata), FXSQLVAR.sqlscale));
      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
        result := Trunc(AsDouble);
      SQL_BOOLEAN :
        case Marshal.ReadInt16(FXSQLVAR.sqldata) of
          ISC_TRUE : Result := 1;
          ISC_FALSE : Result := 0;
        end;
      else
        IBError(ibxeInvalidDataConversion, [nil]);
    end;
end;

function TIBXSQLVAR.GetAsIntPtr: IntPtr;
begin
  if not IsNull then
    result := FXSQLVAR.sqldata
  else
    result := nil;
end;

function TIBXSQLVAR.GetAsQuad: TISC_QUAD;
begin
  result.gds_quad_high := 0;
  result.gds_quad_low := 0;
  if not IsNull then
    case FXSQLVAR.SqlDef of
      SQL_BLOB, SQL_ARRAY, SQL_QUAD:
        result := TISC_QUAD(Marshal.PtrToStructure(FXSQLVAR.sqldata, TypeOf(TISC_QUAD)));
      else
        IBError(ibxeInvalidDataConversion, [nil]);
    end;
end;

function TIBXSQLVAR.GetAsShort: Short;
begin
  result := 0;
  try
    result := AsLong;
  except
    on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
  end;
end;

function TIBXSQLVAR.GetAsString: String;
var
  sz : IntPtr;
  str_len : Integer;
  ss : TStringStream;
begin
  result := '';
  { Check null, if so return a default string }
  if not IsNull then
    case FXSQLVAR.SqlDef of
      SQL_ARRAY:
        result := '(Array)'; {do not localize}
      SQL_BLOB: begin
        ss := TStringStream.Create('');
        try
          SaveToStream(ss);
          result := ss.DataString;
        finally
          ss.Free;
        end;
      end;
      SQL_TEXT, SQL_VARYING: begin
        sz := FXSQLVAR.sqldata;
        if (FXSQLVAR.SqlDef = SQL_TEXT) then
          str_len := FXSQLVAR.sqllen
        else
        begin
          str_len := Marshal.ReadInt16(FXSQLVAR.sqldata);
          sz := IntPtr(Integer(sz) + 2);
        end;
        Result := Marshal.PtrToStringAnsi(sz,str_len);
      end;
      SQL_TYPE_DATE:
        case FSQL.Database.SQLDialect of
          1 : result := DateTimeToStr(AsDateTime);
          3 : result := DateToStr(AsDateTime);
        end;
      SQL_TYPE_TIME :
        result := TimeToStr(AsDateTime);
      SQL_TIMESTAMP:
        result := DateTimeToStr(AsDateTime);
      SQL_SHORT, SQL_LONG:
        if FXSQLVAR.sqlscale = 0 then
          result := IntToStr(AsLong)
        else if FXSQLVAR.sqlscale >= (-4) then
          result := CurrToStr(AsCurrency)
        else
          result := FloatToStr(AsDouble);
      SQL_INT64:
        if FXSQLVAR.sqlscale = 0 then
          result := IntToStr(AsInt64)
        else if FXSQLVAR.sqlscale >= (-4) then
          result := CurrToStr(AsCurrency)
        else
          result := FloatToStr(AsDouble);
      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
        result := FloatToStr(AsDouble);
      SQL_BOOLEAN:
        if AsBoolean then
          Result := STextTrue
        else
          Result := STextFalse;
      else
        IBError(ibxeInvalidDataConversion, [nil]);
    end;
end;

function TIBXSQLVAR.GetAsVariant: Variant;
begin
  if IsNull then
    result := NULL
  { Check null, if so return a default string }
  else
    case FXSQLVAR.SqlDef of
      SQL_ARRAY:
        result := '(Array)'; {do not localize}
      SQL_BLOB:
        result := '(Blob)'; {do not localize}
      SQL_TEXT, SQL_VARYING:
        result := AsString;
      SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
        result := AsDateTime;
      SQL_SHORT, SQL_LONG:
        if FXSQLVAR.sqlscale = 0 then
          result := AsLong
        else if FXSQLVAR.sqlscale >= (-4) then
          result := AsCurrency
        else
          result := AsDouble;
      SQL_INT64:
        if FXSQLVAR.sqlscale = 0 then
          Result := AsINT64
        else
          if FXSQLVAR.sqlscale >= (-4) then
            result := AsCurrency
          else
            result := AsDouble;
      SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
        result := AsDouble;
      SQL_BOOLEAN :
        Result := AsBoolean;
      else
        Result := Null;
        IBError(ibxeInvalidDataConversion, [nil]);
    end;
end;

function TIBXSQLVAR.GetIsNull: Boolean;
begin
  result := IsNullable and (MArshal.ReadInt16(FXSQLVAR.sqlind) = -1);
end;

function TIBXSQLVAR.GetIsNullable: Boolean;
begin
  result := (FXSQLVAR.sqltype and 1 = 1);
end;

procedure TIBXSQLVAR.LoadFromFile(const FileName: String);
var
  fs: TFileStream;
begin
  fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(fs);
  finally
    fs.Free;
  end;
end;

procedure TIBXSQLVAR.LoadFromStream(Stream: TStream);
var
  bs: TIBBlobStream;
begin
  bs := TIBBlobStream.Create;
  try
    bs.Mode := bmWrite;
    bs.Database := FSQL.Database;
    bs.Transaction := FSQL.Transaction;
    Stream.Seek(0, soBeginning);
    bs.LoadFromStream(Stream);
    bs.FinalizeBlob;
    AsQuad := bs.DBBlobID;
  finally
    bs.Free;
  end;
end;

procedure TIBXSQLVAR.SaveToFile(const FileName: String);
var
  fs: TFileStream;
begin
  fs := TFileStream.Create(FileName, fmCreate or fmShareExclusive);
  try
    SaveToStream(fs);
  finally
    fs.Free;
  end;
end;

procedure TIBXSQLVAR.SaveToStream(Stream: TStream);
var
  bs: TIBBlobStream;
begin
  bs := TIBBlobStream.Create;
  try
    bs.Mode := bmRead;
    bs.Database := FSQL.Database;
    bs.Transaction := FSQL.Transaction;
    bs.DBBlobID := AsQuad;
    bs.SaveToStream(Stream);
  finally
    bs.Free;
  end;
end;

function TIBXSQLVAR.GetSize: Integer;
begin
  result := FXSQLVAR.sqllen;
end;

function TIBXSQLVAR.GetSQLType: Integer;
begin
  result := FXSQLVAR.SqlDef;
end;

procedure TIBXSQLVAR.SetAsCurrency(Value: Currency);
var
  xvar: TIBXSQLVAR;
  i: Integer;
begin
  if FSQL.Database.SQLDialect < 3 then
    AsDouble := Value
  else
  begin
    if IsNullable then
      IsNull := False;
    for i := 0 to FParent.FCount - 1 do
      if FParent.FNames[i] = FName then
      begin
        xvar := FParent[i];
        xvar.FXSQLVAR.sqltype := SQL_INT64 or (xvar.FXSQLVAR.sqltype and 1);
        xvar.FXSQLVAR.sqlscale := -4;
        xvar.FXSQLVAR.sqllen := SizeOf(Int64);
        xvar.FXSQLVAR.SetDataSize(0, xvar.FXSQLVAR.sqllen);
        Marshal.StructureToPtr(TObject(Value), xvar.FXSQLVAR.sqldata, false);
        xvar.FModified := True;
      end;
  end;
end;

procedure TIBXSQLVAR.SetAsInt64(Value: Int64);
var
  i: Integer;
  xvar: TIBXSQLVAR;
begin
  if IsNullable then
    IsNull := False;
  for i := 0 to FParent.FCount - 1 do
    if FParent.FNames[i] = FName then
    begin
      xvar := FParent[i];
      xvar.FXSQLVAR.sqltype := SQL_INT64 or (xvar.FXSQLVAR.sqltype and 1);
      xvar.FXSQLVAR.sqlscale := 0;
      xvar.FXSQLVAR.sqllen := SizeOf(Int64);
      xvar.FXSQLVAR.SetDataSize(0, xvar.FXSQLVAR.sqllen);
      Marshal.WriteInt64(xvar.FXSQLVAR.sqldata, Value);
      xvar.FModified := True;
    end;
end;

procedure TIBXSQLVAR.SetAsDate(Value: TDateTime);
var
  i: Integer;
  tm_date: TCTimeStructure;
  Yr, Mn, Dy: Word;
  xvar: TIBXSQLVAR;
begin
  if FSQL.Database.SQLDialect < 3 then
  begin
    AsDateTime := Value;
    exit;
  end;
  if IsNullable then
    IsNull := False;
  for i := 0 to FParent.FCount - 1 do
    if FParent.FNames[i] = FName then
    begin
      xvar := FParent[i];
      xvar.FXSQLVAR.sqltype := SQL_TYPE_DATE or (xvar.FXSQLVAR.sqltype and 1);
      DecodeDate(Value, Yr, Mn, Dy);
      with tm_date do begin
        tm_sec := 0;
        tm_min := 0;
        tm_hour := 0;
        tm_mday := Dy;
        tm_mon := Mn - 1;
        tm_year := Yr - 1900;
      end;
      xvar.FXSQLVAR.sqllen := SizeOf(ISC_DATE);
      xvar.FXSQLVAR.SetDataSize(0, xvar.FXSQLVAR.sqllen);
      FGDSLibrary.isc_encode_sql_date(tm_date, xvar.FXSQLVAR.sqldata);
      xvar.FModified := True;
    end;
end;

procedure TIBXSQLVAR.SetAsTime(Value: TDateTime);
var
  i: Integer;
  tm_date: TCTimeStructure;
  Hr, Mt, S, Ms: Word;
  xvar: TIBXSQLVAR;
begin
  if FSQL.Database.SQLDialect < 3 then
  begin
    AsDateTime := Value;
    exit;
  end;
  if IsNullable then
    IsNull := False;
  for i := 0 to FParent.FCount - 1 do
    if FParent.FNames[i] = FName then
    begin
      xvar := FParent[i];
      xvar.FXSQLVAR.sqltype := SQL_TYPE_TIME or (xvar.FXSQLVAR.sqltype and 1);
      DecodeTime(Value, Hr, Mt, S, Ms);
      with tm_date do begin
        tm_sec := S;
        tm_min := Mt;
        tm_hour := Hr;
        tm_mday := 0;
        tm_mon := 0;
        tm_year := 0;
      end;
      xvar.FXSQLVAR.sqllen := SizeOf(ISC_TIME);
      xvar.FXSQLVAR.SetDataSize(0, xvar.FXSQLVAR.sqllen);
      FGDSLibrary.isc_encode_sql_time(tm_date, xvar.FXSQLVAR.sqldata);
      xvar.FModified := True;
    end;
end;

procedure TIBXSQLVAR.SetAsDateTime(Value: TDateTime);
var
  i: Integer;
  tm_date: TCTimeStructure;
  Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
  xvar: TIBXSQLVAR;
begin
  if IsNullable then
    IsNull := False;
  for i := 0 to FParent.FCount - 1 do
    if FParent.FNames[i] = FName then
    begin
      xvar := FParent[i];
      xvar.FXSQLVAR.sqltype := SQL_TIMESTAMP or (xvar.FXSQLVAR.sqltype and 1);
      DecodeDate(Value, Yr, Mn, Dy);
      DecodeTime(Value, Hr, Mt, S, Ms);
      with tm_date do begin
        tm_sec := S;
        tm_min := Mt;
        tm_hour := Hr;
        tm_mday := Dy;
        tm_mon := Mn - 1;
        tm_year := Yr - 1900;
      end;
      xvar.FXSQLVAR.sqllen := SizeOf(TISC_QUAD);
      xvar.FXSQLVAR.SetDataSize(0, xvar.FXSQLVAR.sqllen);
      FGDSLibrary.isc_encode_date(tm_date, xvar.FXSQLVAR.sqldata);
      xvar.FModified := True;
    end;
end;

procedure TIBXSQLVAR.SetAsDouble(Value: Double);
var
  i: Integer;
  xvar: TIBXSQLVAR;
begin
  if IsNullable then
    IsNull := False;
  for i := 0 to FParent.FCount - 1 do
    if FParent.FNames[i] = FName then
    begin
      xvar := FParent[i];
      xvar.FXSQLVAR.sqltype := SQL_DOUBLE or (xvar.FXSQLVAR.sqltype and 1);
      xvar.FXSQLVAR.sqllen := SizeOf(Double);
      xvar.FXSQLVAR.sqlscale := 0;
      xvar.FXSQLVAR.SetDataSize(0, xvar.FXSQLVAR.sqllen);
      Marshal.WriteInt64(xvar.FXSQLVAR.sqldata,
                   BitConverter.DoubleToInt64Bits(Value));
      xvar.FModified := True;
    end;
end;

procedure TIBXSQLVAR.SetAsFloat(Value: Float);
var
  i: Integer;
  xvar: TIBXSQLVAR;
begin
  if IsNullable then
    IsNull := False;
  for i := 0 to FParent.FCount - 1 do
    if FParent.FNames[i] = FName then
    begin
      xvar := FParent[i];
      xvar.FXSQLVAR.sqltype := SQL_FLOAT or (xvar.FXSQLVAR.sqltype and 1);
      xvar.FXSQLVAR.sqllen := SizeOf(Float);
      xvar.FXSQLVAR.sqlscale := 0;
      xvar.FXSQLVAR.SetDataSize(0, xvar.FXSQLVAR.sqllen);
      Marshal.Copy(BitConverter.GetBytes(Value), 0, xvar.FXSQLVAR.sqldata, 2);
      xvar.FModified := True;
    end;
end;

procedure TIBXSQLVAR.SetAsLong(Value: Long);
var
  i: Integer;
  xvar: TIBXSQLVAR;
begin
  if IsNullable then
    IsNull := False;
  for i := 0 to FParent.FCount - 1 do
    if FParent.FNames[i] = FName then
    begin
      xvar := FParent[i];
      xvar.FXSQLVAR.sqltype := SQL_LONG or (xvar.FXSQLVAR.sqltype and 1);
      xvar.FXSQLVAR.sqllen := SizeOf(Long);
      xvar.FXSQLVAR.sqlscale := 0;
      xvar.FXSQLVAR.SetDataSize(0, xvar.FXSQLVAR.sqllen);
      Marshal.WriteInt32(xvar.FXSQLVAR.sqldata, Value);
      xvar.FModified := True;
    end;
end;

procedure TIBXSQLVAR.SetAsIntPtr(Value: IntPtr);
var
  i: Integer;
  xvar: TIBXSQLVAR;
  b : TBytes;
begin
  if IsNullable and (Value = nil) then
    IsNull := True
  else begin
    IsNull := False;
    for i := 0 to FParent.FCount - 1 do
      if FParent.FNames[i] = FName then
      begin
        xvar := FParent[i];
        xvar.FXSQLVAR.sqltype := SQL_TEXT or (FXSQLVAR.sqltype and 1);
        SetLength(b, xvar.FXSQLVAR.sqllen);
        Marshal.Copy(Value, b, 0, xvar.FXSQLVAR.sqllen);
        Marshal.Copy(b, 0, xvar.FXSQLVAR.sqldata, xvar.FXSQLVAR.sqllen);
        xvar.FModified := True;
      end;
  end;
end;

procedure TIBXSQLVAR.SetAsQuad(Value: TISC_QUAD);
var
  i: Integer;
  xvar: TIBXSQLVAR;
begin
  if IsNullable then
    IsNull := False;
  for i := 0 to FParent.FCount - 1 do
    if FParent.FNames[i] = FName then
    begin
      xvar := FParent[i];
      if (xvar.FXSQLVAR.SqlDef <> SQL_BLOB) and
         (xvar.FXSQLVAR.SqlDef <> SQL_ARRAY) then
        IBError(ibxeInvalidDataConversion, [nil]);
      xvar.FXSQLVAR.sqllen := SizeOf(TISC_QUAD);
      xvar.FXSQLVAR.SetDataSize(0, xvar.FXSQLVAR.sqllen);
      Marshal.StructureToPtr(Value, xvar.FXSQLVAR.sqldata, False);
      xvar.FModified := True;
    end;
end;

procedure TIBXSQLVAR.SetAsShort(Value: Short);
var
  i: Integer;
  xvar: TIBXSQLVAR;
begin
  if IsNullable then
    IsNull := False;
  for i := 0 to FParent.FCount - 1 do
    if FParent.FNames[i] = FName then
    begin
      xvar := FParent[i];
      xvar.FXSQLVAR.sqltype := SQL_SHORT or (xvar.FXSQLVAR.sqltype and 1);
      xvar.FXSQLVAR.sqllen := SizeOf(Short);
      xvar.FXSQLVAR.sqlscale := 0;
      xvar.FXSQLVAR.SetDataSize(0, xvar.FXSQLVAR.sqllen);
      Marshal.WriteInt16(xvar.FXSQLVAR.sqldata, Value);
      xvar.FModified := True;
    end;
end;

procedure TIBXSQLVAR.SetAsString(Value: String);
var
  stype: Integer;
  ss: TMemoryStream;

  procedure SetStringValue;
  var
    i : Integer;
    xvar: TIBXSQLVAR;
    b : TBytes;
  begin
    SetLength(b, Length(BytesOf(Value)));
    b := BytesOf(Value);
    for i := 0 to FParent.FCount - 1 do
      if FParent.FNames[i] = FName then
      begin
        xvar := FParent[i];
        if (xvar.FXSQLVAR.sqlname = 'DB_KEY') or {do not localize}
           (xvar.FXSQLVAR.sqlname = 'RDB$DB_KEY') then {do not localize}
          Marshal.Copy(b, 0, xvar.FXSQLVAR.sqldata, Length(b))
        else
        begin
          xvar.FXSQLVAR.sqltype := SQL_TEXT or (FXSQLVAR.sqltype and 1);
          if (FMaxLen > 0) and (Length(b) > FMaxLen) then
            IBError(ibxeStringTooLarge, [Length(b), FMaxLen]);
          xvar.FXSQLVAR.sqllen := Length(b);
          xvar.FXSQLVAR.SetDataSize(0, xvar.FXSQLVAR.sqllen + 1);
          if (Length(b) > 0) then
            Marshal.Copy(b, 0, xvar.FXSQLVAR.sqldata, Length(BytesOf(b)));
        end;
        xvar.FModified := True;
      end;
  end;

begin
  if IsNullable then
    IsNull := False;
  stype := FXSQLVAR.SqlDef;
  if (stype = SQL_TEXT) or (stype = SQL_VARYING) then
    SetStringValue
  else
  begin
    if (stype = SQL_BLOB) then
    begin
      ss := TMemoryStream.Create;
      ss.Write(BytesOf(Value), Length(BytesOf(Value)));
      try
        LoadFromStream(ss);
      finally
        ss.Free;
      end;
    end
    else
      if Value = '' then
        IsNull := True
      else
        if (stype = SQL_TIMESTAMP) or (stype = SQL_TYPE_DATE) or
          (stype = SQL_TYPE_TIME) then
          SetAsDateTime(StrToDateTime(Value))
        else
          SetStringValue;
  end;
end;

procedure TIBXSQLVAR.SetAsVariant(Value: Variant);
begin
  if VarIsNull(Value) then
    IsNull := True
  else
  case VarType(Value) of
    varEmpty, varNull:
      IsNull := True;
    varSmallint, varInteger, varByte, varShortInt, varWord, varLongWord:
      AsLong := Value;
    varSingle, varDouble:
      AsDouble := Value;
    varDecimal:
      AsCurrency := Value;
    varBoolean:
      if Value = true then
        AsBoolean := true
      else
        AsBoolean := false;
    varDateTime:
      AsDateTime := Value;
    varString:
      AsString := Value;
    varArray:
      IBError(ibxeNotSupported, [nil]);
    varError, varObject:
      IBError(ibxeNotPermitted, [nil]);
    varInt64:
      AsInt64 := Value;
    else
      IBError(ibxeNotSupported, [nil]);
  end;
end;

procedure TIBXSQLVAR.SetIsNull(Value: Boolean);
var
  i: Integer;
  xvar: TIBXSQLVAR;
begin
  if Value then
  begin
    if not IsNullable then
      IsNullable := True;
    for i := 0 to FParent.FCount - 1 do
      if FParent.FNames[i] = FName then
      begin
        xvar := FParent[i];
        if Assigned(xvar.FXSQLVAR.sqlind) then
          Marshal.WriteInt16(xvar.FXSQLVAR.sqlind, -1);
        xvar.FModified := True;
      end;
  end
  else
    if ((not Value) and IsNullable) then
    begin
      for i := 0 to FParent.FCount - 1 do
        if FParent.FNames[i] = FName then
        begin
          xvar := FParent[i];
          if Assigned(xvar.FXSQLVAR.sqlind) then
            Marshal.WriteInt16(xvar.FXSQLVAR.sqlind, 0);
          xvar.FModified := True;
        end;
    end;
end;

procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
var
  i: Integer;
  xvar: TIBXSQLVAR;
begin
  for i := 0 to FParent.FCount - 1 do
    if FParent.FNames[i] = FName then
    begin
      xvar := FParent[i];
      if (Value <> IsNullable) then
      begin
        if Value then
        begin
          xvar.FXSQLVAR.sqltype := xvar.FXSQLVAR.sqltype or 1;
          xvar.FXSQLVAR.SetIndSize(0, SizeOf(Short));
        end
        else
        begin
          xvar.FXSQLVAR.sqltype := xvar.FXSQLVAR.SqlDef;
          xvar.FXSQLVAR.SetIndSize(0, 0);
        end;
      end;
    end;
end;

procedure TIBXSQLVAR.Clear;
begin
  IsNull := true;
end;

procedure TIBXSQLVAR.SetAsTrimString(const Value: String);
begin
  SetAsString(TrimRight(Value));
end;

function TIBXSQLVAR.GetAsTrimString: String;
begin
  Result := TrimRight(GetAsString);
end;

function TIBXSQLVAR.GetAsBoolean: Boolean;
begin
  result := false;
  if not IsNull then
    case FXSQLVAR.SqlDef of
      SQL_BOOLEAN:
        Result := Marshal.ReadInt16(FXSQLVAR.sqldata) = ISC_TRUE;
      else
        IBError(ibxeInvalidDataConversion, [nil]);
    end;
end;

procedure TIBXSQLVAR.SetAsBoolean(const Value: Boolean);
begin
  if Value then
    Marshal.WriteInt16(FXSQLVAR.sqldata, ISC_TRUE)
  else
    Marshal.WriteInt16(FXSQLVAR.sqldata, ISC_FALSE);
end;

procedure TIBXSQLVAR.SetFXSQLVAR(const Value: TSQLVAR);
var
  i : Integer;
  xvar: TIBXSQLVAR;
  sqlind: PShort;
  sqldata: IntPtr;
  local_sqllen: Integer;
  b : TBytes;
begin
  for i := 0 to FParent.FCount - 1 do
    if FParent.FNames[i] = FName then
    begin
      xvar := FParent[i];
      sqlind := xvar.FXSQLVAR.sqlind;
      sqldata := xvar.FXSQLVAR.sqldata;
      if xvar.FXSQLVAR is TSQLVAR_V1 then
      begin
        SetLength(b, Marshal.SizeOf(TypeOf(TXSQLVAR_V1)));
        Marshal.Copy(Value.XSQLVAR, b, 0, Marshal.SizeOf(TypeOf(TXSQLVAR_V1)));
        Marshal.Copy(b, 0, xvar.FXSQLVAR.XSqlVar, Marshal.SizeOf(TypeOf(TXSQLVAR_V1)));
      end
      else
      begin
        SetLength(b, Marshal.SizeOf(TypeOf(TXSQLVAR)));
        Marshal.Copy(Value.XSQLVAR, b, 0, Marshal.SizeOf(TypeOf(TXSQLVAR)));
        Marshal.Copy(b, 0, xvar.FXSQLVAR.XSqlVar, Marshal.SizeOf(TypeOf(TXSQLVAR)));
      end;
      xvar.FXSQLVAR.sqlind := sqlind;
      xvar.FXSQLVAR.sqldata := sqldata;
      if (Value.sqltype and 1 = 1) then
      begin
        if (xvar.FXSQLVAR.sqlind = nil) then
          xvar.FXSQLVAR.SetIndSize(0, SizeOf(Short));
        Marshal.WriteInt16(xvar.FXSQLVAR.sqlind, Marshal.ReadInt16(Value.sqlind));
      end
      else
        if (xvar.FXSQLVAR.sqlind <> nil) then
          xvar.FXSQLVAR.SetIndSize(0, 0);
      if ((xvar.FXSQLVAR.SqlDef) = SQL_VARYING) then
        local_sqllen := xvar.FXSQLVAR.sqllen + 2
      else
        local_sqllen := xvar.FXSQLVAR.sqllen;
      FXSQLVAR.sqlscale := Value.sqlscale;
      xvar.FXSQLVAR.SetDataSize(0, local_sqllen);

      SetLength(b, local_sqllen);
      Marshal.Copy(xvar.FXSQLVAR.sqldata, b, 0, local_sqllen);
      Marshal.Copy(b, 0, Value.SqlData, sizeof(local_sqllen));
      xvar.FModified := True;
    end;
end;

destructor TIBXSQLVAR.Destroy;
begin
  FreeAndNil(FXSQLVAR);
  FGDSLibrary := nil;
  inherited;
end;

function TIBXSQLVAR.AdjustScaleToBCD(Value: Int64; Scale: Integer): TBcd;
var
  BCDStr : String;
begin
  BCDStr := IntToStr(Value);
  BCDStr := Copy(BCDStr, 1, Length(BCDStr) + Scale) + DecimalSeparator +
            Copy(BCDStr, Length(BCDStr) + Scale + 1, Length(BCDStr));
  Result := TBcd.Parse(BCDStr);
end;

function TIBXSQLVAR.GetAsBCD: TBcd;
begin
  result := 0;
  if FSQL.Database.SQLDialect < 3 then
    result := GetAsDouble
  else
  begin
    if not IsNull then
      case FXSQLVAR.SqlDef of
        SQL_TEXT, SQL_VARYING: begin
          try
            result := TBcd.Parse(AsString);
          except
            on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
          end;
        end;
        SQL_SHORT:
          result := AdjustScaleToBcd(Marshal.ReadInt16(FXSQLVAR.sqldata),
                                      FXSQLVAR.sqlscale);
        SQL_LONG:
          result := AdjustScaleToBcd(Marshal.ReadInt32(FXSQLVAR.sqldata),
                                      FXSQLVAR.sqlscale);
        SQL_INT64:
          result := AdjustScaleToBcd(Marshal.ReadInt64(FXSQLVAR.sqldata),
                                      FXSQLVAR.sqlscale);
        SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
          result := GetAsDouble;
        else
          IBError(ibxeInvalidDataConversion, [nil]);
      end;
    end;
end;

procedure TIBXSQLVAR.SetAsBcd(const Value: TBcd);
var
  xvar: TIBXSQLVAR;
  i: Integer;

  function AdjustBCDToInt64(Value: TBcd; Scale: Integer): Int64;
  var
    Scaling : Int64;
    i : Integer;
  begin
    Scaling := 1;
    if Scale > 0 then
    begin
      for i := 1 to Scale do
        Scaling := Scaling * 10;
      Value :=  Scaling * Value;
    end
    else
      if Scale < 0 then
      begin
        for i := -1 downto Scale do
          Scaling := Scaling * 10;
        Value := Value / Scaling;
      end;
    Result := StrToInt64(Value.ToString)
  end;

begin
  if FSQL.Database.SQLDialect < 3 then
    AsDouble := Value
  else
  begin
    if IsNullable then
      IsNull := False;
    for i := 0 to FParent.FCount - 1 do
      if FParent.FNames[i] = FName then
      begin
        xvar := FParent[i];
        xvar.FXSQLVAR.sqltype := SQL_INT64 or (xvar.FXSQLVAR.sqltype and 1);
        xvar.FXSQLVAR.sqlscale := -1 * Value.Scale;
        xvar.FXSQLVAR.sqllen := SizeOf(Int64);
        xvar.FXSQLVAR.SetDataSize(0, xvar.FXSQLVAR.sqllen);
        Marshal.WriteInt64(xvar.FXSQLVAR.sqldata, AdjustBCDToInt64(Value, Value.Scale));
        xvar.FModified := True;
      end;
  end;
end;

{ TIBXSQLDA }
constructor TIBXSQLDA.Create(Query: TIBSQL);
begin
  inherited Create;
  FSQL := Query;
  FNames := TStringList.Create;
  FSize := 0;
  FUniqueRelationName := '';
  FGDSLibrary := GetGDSLibrary;
end;

destructor TIBXSQLDA.Destroy;
var
  i: Integer;
begin
  FNames.Free;
  if FXSQLDA <> nil then
  begin
    for i := 0 to FSize - 1 do
    begin
      Marshal.FreeHGlobal(FXSQLVARs[i].FXSQLVAR.sqldata);
      Marshal.FreeHGlobal(FXSQLVARs[i].FXSQLVAR.sqlind);
      FXSQLVARs[i].Free ;
    end;
    Marshal.FreeHGlobal(FXSQLDA);
    FXSQLDA := nil;
    FXSQLVARs := nil;
  end;
  FGDSLibrary := nil;
  inherited Destroy;
end;

procedure TIBXSQLDA.AddName(FieldName: String; Idx: Integer);
var
  fn: String;
begin
  fn := FormatIdentifierValue(FSQL.Database.SQLDialect, FieldName);
  while FNames.Count <= Idx do
    FNames.Add('');
  FNames[Idx] := fn;
  FXSQLVARs[Idx].FName := fn;
  FXSQLVARs[Idx].FIndex := Idx;
end;

function TIBXSQLDA.GetModified: Boolean;
var
  i: Integer;
begin
  result := False;
  for i := 0 to FCount - 1 do
    if FXSQLVARs[i].Modified then
    begin
      result := True;
      exit;
    end;
end;

function TIBXSQLDA.GetNames: String;
begin
  result := FNames.Text;
end;

function TIBXSQLDA.GetRecordSize: Integer;
begin
  result := SizeOf(TIBXSQLDA) + XSQLDA_LENGTH(FSize);
end;

function TIBXSQLDA.GetXSQLDA: PXSQLDA;
begin
  result := FXSQLDA;
end;

function TIBXSQLDA.GeTSQLVAR(Idx: Integer): TIBXSQLVAR;
begin
  if (Idx < 0) or (Idx >= FCount) then
    IBError(ibxeXSQLDAIndexOutOfRange, [nil]);
  result := FXSQLVARs[Idx]
end;

function TIBXSQLDA.ByName(Idx: String): TIBXSQLVAR;
begin
  result := GeTSQLVARByName(Idx);
  if result = nil then
    IBError(ibxeFieldNotFound, [Idx]);
end;

function TIBXSQLDA.GeTSQLVARByName(Idx: String): TIBXSQLVAR;
var
  s: String;
  i, Cnt: Integer;
begin
  s := FormatIdentifierValue(FSQL.Database.SQLDialect, Idx);
  i := 0;
  Cnt := FNames.Count;
  while (i < Cnt) and (FNames[i] <> s) do Inc(i);
  if i = Cnt then
    result := nil
  else
    result := GeTSQLVAR(i);
end;

procedure TIBXSQLDA.Initialize;
var
  i, j, j_len: Integer;
  NamesWereEmpty: Boolean;
  st: String;
  bUnique: Boolean;
  MetaLength : Integer;
begin
  bUnique := True;
  if FGDSLibrary.GetIBClientVersion >= 7 then
    MetaLength := 68
  else
    MetaLength := 32;
  NamesWereEmpty := (FNames.Count = 0);
  if FXSQLDA <> nil then
  begin
    for i := 0 to FCount - 1 do
    begin
      with FXSQLVARs[i].Data do
      begin
        if bUnique and (relname <> '') then
        begin
          if FUniqueRelationName = '' then
            FUniqueRelationName := relname
          else
            if relname <> FUniqueRelationName then
            begin
              FUniqueRelationName := '';
              bUnique := False;
            end;
        end;
        if NamesWereEmpty then
        begin
          st := aliasname;
          if st = '' then
          begin
            st := 'F_'; {do not localize}
            j := 1;
            aliasname := st + IntToStr(j);
          end
          else
          begin
            aliasname := st;
            j := 0;
          end;
          while GeTSQLVARByName(aliasname) <> nil do
          begin
            Inc(j); j_len := Length(IntToStr(j));
            if j_len + Length(aliasname) > (METALENGTH - 1) then
              aliasname := Copy(st, 1, (METALENGTH - 1) - j_len) + IntToStr(j)
            else
              aliasname := st + IntToStr(j);
          end;
          AddName(aliasname, i);
        end;
        if (SqlDef = SQL_TEXT) or
           (SqlDef = SQL_VARYING) then
          FXSQLVARs[i].FMaxLen := sqllen
        else
          FXSQLVARs[i].FMaxLen := 0;
        case SqlDef of
          SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
          SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT,
          SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT, SQL_BOOLEAN:
          begin
            if (sqllen = 0) then
              { Make sure you get a valid IntPtr anyway
               select '' from foo }
              SetDataSize(0, 1)
            else
              SetDataSize(0, sqllen)
          end;
          SQL_VARYING:
          begin
            SetDataSize(0, sqllen + 2);
          end;
          else
            IBError(ibxeUnknownSQLDataType, [SqlDef])
        end;
        if (sqltype and 1 = 1) then
          SetIndSize(0, SizeOf(Short))
        else
          if (sqlind <> nil) then
            SetIndSize(0, 0);
      end;
    end;
  end;
end;

procedure TIBXSQLDA.SetCount(Value: Integer);
var
  i, OldSize: Integer;
  p : PXSQLVAR;
  XSQLVar_Size : Integer;
begin
  FNames.Clear;
  FCount := Value;
  if FCount = 0 then
    FUniqueRelationName := ''
  else
  begin
    if FSize > 0 then
      OldSize := XSQLDA_LENGTH(FSize)
    else
      OldSize := 0;
    if FCount > FSize then
    begin
      IBAlloc(FXSQLDA, OldSize, XSQLDA_LENGTH(FCount));
      SetLength(FXSQLVARs, FCount);
      if FGDSLibrary.GetIBClientVersion >= 7 then
      begin
        Marshal.WriteInt16(FXSQLDA,
           Integer(Marshal.OffsetOf(TypeOf(TXSQLDA), 'version')), SQLDA_VERSION2);
        XSQLVar_Size := Marshal.SizeOf(TypeOf(TXSQLVAR));
      end
      else
      begin
        Marshal.WriteInt16(FXSQLDA,
           Integer(Marshal.OffsetOf(TypeOf(TXSQLDA), 'version')), SQLDA_VERSION1);
        XSQLVar_Size := Marshal.SizeOf(TypeOf(TXSQLVAR_V1));
      end;

      p := IntPtr(Integer(FXSQLDA) + Integer(Marshal.OffsetOf(TypeOf(TXSQLDA), 'sqlvar')));
      for i := 0 to FCount - 1 do
      begin
        if i >= FSize then
          FXSQLVARs[i] := TIBXSQLVAR.Create(self, FSQL);
        FXSQLVARs[i].FXSQLVAR.XSqlVar := p;
        p := IntPtr(Integer(p) + XSQLVar_Size);
      end;
      FSize := FCount;
    end;
    if FSize > 0 then
    begin
      Marshal.WriteInt16(FXSQLDA, Integer(Marshal.OffsetOf(TypeOf(TXSQLDA), 'sqln')), Value);
      Marshal.WriteInt16(FXSQLDA, Integer(Marshal.OffsetOf(TypeOf(TXSQLDA), 'sqld')), Value);
    end;
  end;
end;

{ TIBOutputDelimitedFile }

destructor TIBOutputDelimitedFile.Destroy;
begin
  FFile.Free;
  inherited Destroy;
end;

procedure TIBOutputDelimitedFile.ReadyFile;
var
  i: Integer;
  st: string;
begin
  if FColDelimiter = '' then
    FColDelimiter := TAB;
  if FRowDelimiter = '' then
    FRowDelimiter := CRLF;
  FFile := TFileStream.Create(FFilename, fmCreate or fmShareDenyWrite);
  if FOutputTitles then
  begin
    for i := 0 to Columns.Count - 1 do
      if i = 0 then
        st := Columns[i].Data.aliasname
      else
        st := st + FColDelimiter + Columns[i].Data.aliasname;
    st := st + FRowDelimiter;
    FFile.Write(st[1], Length(st));
  end;
end;

function TIBOutputDelimitedFile.WriteColumns: Boolean;
var
  i: Integer;
  BytesWritten: DWORD;
  st: string;
begin
  result := False;
  if Assigned(FFile) then
  begin
    st := '';
    for i := 0 to Columns.Count - 1 do
    begin
      if i > 0 then
        st := st + FColDelimiter;
      st := st + StripString(Columns[i].AsString, FColDelimiter + FRowDelimiter);
    end;
    st := st + FRowDelimiter;
    BytesWritten := FFile.Write(st[1], Length(st));
    if BytesWritten = DWORD(Length(st)) then
      result := True;
  end
end;

 { TIBInputDelimitedFile }

destructor TIBInputDelimitedFile.Destroy;
begin
  FFile.Free;
  inherited Destroy;
end;

function TIBInputDelimitedFile.GetColumn(var Col: string): Integer;
var
  c: Char;
  BytesRead: Integer;

  procedure ReadInput;
  begin
    if FLookAhead <> NULL_TERMINATOR then
    begin
      c := FLookAhead;
      BytesRead := 1;
      FLookAhead := NULL_TERMINATOR;
    end else
      BytesRead := FFile.Read(c, 1);
  end;

  procedure CheckCRLF(Delimiter: string);
  begin
    if (c = CR) and (Pos(LF, Delimiter) > 0) then {mbcs ok}
    begin
      BytesRead := FFile.Read(c, 1);
      if (BytesRead = 1) and (c <> #10) then
        FLookAhead := c
    end;
  end;

begin
  Col := '';
  result := 0;
  ReadInput;
  while BytesRead <> 0 do begin
    if Pos(c, FColDelimiter) > 0 then {mbcs ok}
    begin
      CheckCRLF(FColDelimiter);
      result := 1;
      break;
    end else if Pos(c, FRowDelimiter) > 0 then {mbcs ok}
    begin
      CheckCRLF(FRowDelimiter);
      result := 2;
      break;
    end else
      Col := Col + c;
    ReadInput;
  end;
end;

function TIBInputDelimitedFile.ReadParameters: Boolean;
var
  i, curcol: Integer;
  Col: string;
begin
  result := False;
  if not FEOF then
  begin
    curcol := 0;
    repeat
      i := GetColumn(Col);
      if (i = 0) then
        FEOF := True;
      if (curcol < Params.Count) then
      begin
        try
          if (Col = '') and
             (ReadBlanksAsNull) then
            Params[curcol].IsNull := True
          else
            Params[curcol].AsString := Col;
          Inc(curcol);
        except
          on E: Exception do
          begin
            if not (FEOF and (curcol = Params.Count)) then
              raise;
          end;
        end;
      end;
    until (FEOF) or (i = 2);
    result := ((FEOF) and (curcol = Params.Count)) or
              (not FEOF);
  end;
end;

procedure TIBInputDelimitedFile.ReadyFile;
var
  col : String;
  curcol : Integer;
begin
  if FColDelimiter = '' then
    FColDelimiter := TAB;
  if FRowDelimiter = '' then
    FRowDelimiter := CRLF;
  FLookAhead := NULL_TERMINATOR;
  FEOF := False;
  if FFile <> nil then
    FFile.Free;
  FFile := TFileStream.Create(FFilename, fmOpenRead or fmShareDenyWrite);
  if FSkipTitles then
  begin
    curcol := 0;
    while curcol < Params.Count do
    begin
      GetColumn(Col);
      Inc(CurCol)
    end;
  end;
end;

{ TIBOutputRawFile }
destructor TIBOutputRawFile.Destroy;
begin
  FFile.Free;
  inherited Destroy;
end;
                                                           
procedure TIBOutputRawFile.ReadyFile;
begin
  if Assigned(FFile) then
    FreeAndNil(FFile);
  FFile := TFileStream.Create(Filename, fmCreate);
end;

function TIBOutputRawFile.WriteColumns: Boolean;
var
  i: Integer;
  BytesWritten, BytesToWrite : LongInt;
  SQLVar : TSQLVAR;
  bs : TMemoryStream;
  B : TBytes;
begin
  result := False;
  if Assigned(FFile) then
  begin
    for i := 0 to Columns.Count - 1 do
    begin
      SQLVar := Columns[i].Data;
      case SQLVar.SqlDef of
        SQL_VARYING:
        begin
          BytesToWrite := SQLVar.sqllen + 2;
          SetLength(B, BytesToWrite);
          Marshal.Copy(SQLVar.sqldata, B, 0, BytesToWrite);
          BytesWritten := FFile.Write(B, 0, BytesToWrite);
          if (BytesWritten <> BytesToWrite) then
            exit;
        end;
        SQL_BLOB:
        begin
          bs := TMemoryStream.Create;
          try
            Columns[i].SaveToStream(bs);
            BytesToWrite := bs.Size;
            FFile.Write(BytesToWrite, sizeof(BytesToWrite));
            BytesWritten := FFile.CopyFrom(bs, 0);
            if BytesWritten <> BytesToWrite then
            begin
              FreeAndNil(bs);
              exit;
            end;
          finally
            bs.Free;
          end;
        end;
        else
        begin
          BytesToWrite := SQLVar.sqllen;
          SetLength(B, BytesToWrite);
          Marshal.Copy(SQLVar.sqldata, B, 0, BytesToWrite);
          BytesWritten := FFile.Write(B, 0, BytesToWrite);
          if BytesWritten <> SQLVar.sqllen then
            exit;
        end;
      end;
      // Have to write out the nil indicator
      FFile.Write(Marshal.ReadInt16(SQLVar.sqlind), sizeof(SQLVar.sqlind));
    end;
    result := True;
  end;
end;

{ TIBInputRawFile }
destructor TIBInputRawFile.Destroy;
begin
  FFile.Free;
  inherited Destroy;
end;

function TIBInputRawFile.ReadParameters: Boolean;
var
  i: Integer;
  BytesRead, BytesToRead : LongInt;
  SQLVar : TSQLVAR;
  bs: TMemoryStream;
  B : TBytes;
  ind : Int16;
begin
  result := False;
  if Assigned(FFile) then
  begin
    for i := 0 to Params.Count - 1 do
    begin
      SQLVar := Params[i].Data;

      case SQLVar.SqlDef of
        SQL_VARYING:
        begin
          BytesToRead := SQLVar.sqllen + 2;
          SetLength(B, BytesToRead);
          BytesRead := FFile.Read(B, BytesToRead);
          Marshal.Copy(B, 0, SQLVar.sqldata, BytesRead);
          if BytesRead <> BytesToRead then
            Exit;
        end;
        SQL_BLOB:
        begin
          bs := TMemoryStream.Create;
          try
            FFile.Read(BytesToRead, sizeof(BytesToRead));
            if BytesToRead = 0 then
              Marshal.WriteInt16(SQLVar.sqlind, -1)
            else
            begin
              BytesRead := bs.CopyFrom(FFile, BytesToRead);
              if BytesRead <> BytesToRead then
              begin
                FreeAndNil(bs);
                Exit;
              end;
              bs.Position := 0;
              Params[i].LoadFromStream(bs);
            end;
          finally
            bs.Free;
          end;
        end;
        else
        begin
          SetLength(B, SQLVar.sqllen);
          BytesRead := FFile.Read(B, SQLVar.sqllen);
          Marshal.Copy(B, 0, SQLVar.sqldata, BytesRead);
          if BytesRead <> SQLVar.sqllen then
            exit;
        end;
      end;
      // Have to read in the nil indicator
      FFile.Read(ind, sizeof(SQLVar.sqlind));
      Marshal.WriteInt16(SQLVar.SqlInd, ind);
    end;
    result := True;
  end;
end;

procedure TIBInputRawFile.ReadyFile;
begin
  if Assigned(FFile)  then
    FreeAndNil(FFile);
  FFile := TFileStream.Create(FileName, fmOpenRead);
end;

{ TIBSQL }
constructor TIBSQL.Create(AOwner: TComponent);
var
  GUID : TGUID;
begin
  inherited Create(AOwner);
  FGDSLibrary := GetGDSLibrary;
  FIBLoaded := False;
  FGDSLibrary.CheckIBLoaded;
  FIBLoaded := True;
  FGenerateParamNames := False;
  FGoToFirstRecordOnExecute := True;
  FBase := TIBBase.Create(Self);
  FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
  FBase.BeforeTransactionEnd := BeforeTransactionEnd;
  FBOF := False;
  FEOF := False;
  FPrepared := False;
  FRecordCount := 0;
  FSQL := TStringList.Create;
  TStringList(FSQL).OnChanging := SQLChanging;
  FProcessedSQL := TStringList.Create;
  FHandle := Marshal.AllocHGlobal(SizeOf(TISC_STMT_HANDLE));
  HandleValue := nil;
  FSQLParams := TIBXSQLDA.Create(self);
  FSQLRecord := TIBXSQLDA.Create(self);
  FSQLType := SQLUnknown;
  FParamCheck := True;
  CreateGuid(GUID);
  FCursor := Marshal.StringToHGlobalAnsi(GUIDToString(GUID));
  if AOwner is TIBDatabase then
    Database := TIBDatabase(AOwner)
  else
    if AOwner is TIBTransaction then
      Transaction := TIBTransaction(AOwner);
end;

destructor TIBSQL.Destroy;
begin
  if FIBLoaded then
  begin
    if (FOpen) then
      Close;
    if (HandleValue <> nil) then
      FreeHandle;
    FSQL.Free;
    FProcessedSQL.Free;
    FBase.Free;
    FSQLParams.Free;
    FSQLRecord.Free;
  end;
  Marshal.FreeHGlobal(FHandle);
  Marshal.FreeHGlobal(FCursor);
  FGDSLibrary := nil;
  inherited Destroy;
end;

function TIBSQL.GetHandleValue : TISC_STMT_HANDLE;
begin
  Result := Marshal.ReadIntPtr(FHandle);
end;

procedure TIBSQL.SetHandleValue(const Value : TISC_STMT_HANDLE);
begin
  Marshal.WriteIntPtr(FHandle, Value);
end;

procedure TIBSQL.BatchInput(InputObject: TIBBatchInput);
begin
  if not Prepared then
    Prepare;
  InputObject.Params := Self.FSQLParams;
  InputObject.ReadyFile;
  if FSQLType in [SQLInsert, SQLUpdate, SQLDelete, SQLExecProcedure] then
    while InputObject.ReadParameters do
      ExecQuery;
end;

procedure TIBSQL.BatchOutput(OutputObject: TIBBatchOutput);
begin
  CheckClosed;
  if not Prepared then
    Prepare;
  if FSQLType = SQLSelect then begin
    try
      ExecQuery;
      OutputObject.Columns := Self.FSQLRecord;
      OutputObject.ReadyFile;
      if not FGoToFirstRecordOnExecute then
        Next;
      while (not Eof) and (OutputObject.WriteColumns) do
        Next;
    finally
      Close;
    end;
  end;
end;

procedure TIBSQL.CheckClosed;
begin
  if FOpen then
    IBError(ibxeSQLOpen, [nil]);
end;

procedure TIBSQL.CheckOpen;
begin
  if not FOpen then
    IBError(ibxeSQLClosed, [nil]);
end;

procedure TIBSQL.CheckValidStatement;
begin
  FBase.CheckTransaction;
  if (HandleValue = nil) then
    IBError(ibxeInvalidStatementHandle, [nil]);
end;

procedure TIBSQL.Close;
var
  isc_res: ISC_STATUS;
begin
  try
    if (HandleValue <> nil) and (SQLType = SQLSelect) and FOpen then
    begin
      isc_res := Call(
                   FGDSLibrary.isc_dsql_free_statement(StatusVector, FHandle, DSQL_close),
                   False);
      if (Marshal.ReadByte(StatusVector) = 1) and (isc_res > 0) and
        not CheckStatusVector([isc_bad_stmt_handle, isc_dsql_cursor_close_err]) then
        if isc_res = isc_lost_db_connection then
          FBase.Database.Call(isc_res, true)
        else
          IBDatabaseError;
    end;
  finally
    FEOF := False;
    FBOF := False;
    FOpen := False;
    FRecordCount := 0;
  end;
end;

function TIBSQL.Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
begin
  result := 0;
 if Transaction <> nil then
    result := Transaction.Call(ErrCode, RaiseError)
  else
  if RaiseError and (ErrCode > 0) then
    IBDatabaseError;
end;

function TIBSQL.Current: TIBXSQLDA;
begin
  result := FSQLRecord;
end;

procedure TIBSQL.DoBeforeDatabaseDisconnect(Sender: TObject);
begin
  if (HandleValue <> nil) then
  begin
    Close;
    FreeHandle;
  end;
end;

procedure TIBSQL.ExecQuery;
var
  fetch_res: ISC_STATUS;
  pString : IntPtr;
begin
  CheckClosed;
  if not Prepared then
    Prepare;
  CheckValidStatement;
  if not (csDesigning in ComponentState) then
    MonitorHook.SQLExecute(Self);
  case FSQLType of
    SQLSelect:
    begin
      Call(FGDSLibrary.isc_dsql_execute2(StatusVector,
                            TRHandle,
                            FHandle,
                            Database.SQLDialect,
                            FSQLParams.AsXSQLDA,
                            nil), True);
        Call(
          FGDSLibrary.isc_dsql_set_cursor_name(StatusVector, FHandle, FCursor, 0),
          True);
      FOpen := True;
      FBOF := True;
      FEOF := False;
      FRecordCount := 0;
      if FGoToFirstRecordOnExecute then
        Next;
    end;
    SQLExecProcedure:
    begin
      fetch_res := Call(FGDSLibrary.isc_dsql_execute2(StatusVector,
                            TRHandle,
                            FHandle,
                            Database.SQLDialect,
                            FSQLParams.AsXSQLDA,
                            FSQLRecord.AsXSQLDA), False);
      if (fetch_res <> 0) then
      begin
        if (fetch_res <> isc_lock_conflict) then
        begin
           { Sometimes a prepared stored procedure appears to get
             off sync on the server ....This code is meant to try
             to work around the problem simply by "retrying". This
             need to be reproduced and fixed.
           }
          pString := Marshal.StringToHGlobalAnsi(FProcessedSQL.Text);
          try
            FGDSLibrary.isc_dsql_prepare(StatusVector, TRHandle, FHandle, 0,
              pString, Database.SQLDialect, nil);
            Call(FGDSLibrary.isc_dsql_execute2(StatusVector,
                                TRHandle,
                                FHandle,
                                Database.SQLDialect,
                                FSQLParams.AsXSQLDA,
                                FSQLRecord.AsXSQLDA), True);
          finally
            Marshal.FreeHGlobal(pString);
          end;
        end
        else
          IBDatabaseError;  // go ahead and raise the lock conflict
      end;
    end
    else
      Call(FGDSLibrary.isc_dsql_execute(StatusVector,
                           TRHandle,
                           FHandle,
                           Database.SQLDialect,
                           FSQLParams.AsXSQLDA), True);
  end;
end;

function TIBSQL.GetEOF: Boolean;
begin
  result := FEOF or not FOpen;
end;

function TIBSQL.FieldByName(FieldName: String): TIBXSQLVAR;
var
  i: Integer;
begin
  i := GetFieldIndex(FieldName);
  if (i < 0) then
    IBError(ibxeFieldNotFound, [FieldName]);
  result := GetFields(i);
end;

function TIBSQL.GetFields(const Idx: Integer): TIBXSQLVAR;
begin
  if (Idx < 0) or (Idx >= FSQLRecord.Count) then
    IBError(ibxeFieldNotFound, [IntToStr(Idx)]);
  result := FSQLRecord[Idx];
end;

function TIBSQL.GetFieldIndex(FieldName: String): Integer;
begin
  if (FSQLRecord.GetSQLVARByName(FieldName) = nil) then
    result := -1
  else
    result := FSQLRecord.GetSQLVARByName(FieldName).Index;
end;

function TIBSQL.Next: TIBXSQLDA;
var
  fetch_res: ISC_STATUS;
begin
  result := nil;
  if not FEOF then
  begin
    CheckOpen;
    { Go to the next record... }
    fetch_res := Call(FGDSLibrary.isc_dsql_fetch(StatusVector, FHandle,
                       Database.SQLDialect, FSQLRecord.AsXSQLDA), False);
    if (fetch_res = 100) or
       (CheckStatusVector([isc_dsql_cursor_err])) then
    begin
      FEOF := True;
    end
    else
      if (fetch_res > 0) then
      begin
        try
          IBDatabaseError;
        except
          Close;
          raise;
        end;
      end
      else
      begin
        Inc(FRecordCount);
        FBOF := False;
        result := FSQLRecord;
      end;
    if not (csDesigning in ComponentState) then
      MonitorHook.SQLFetch(Self);
  end;
end;

procedure TIBSQL.FreeHandle;
var
  isc_res: ISC_STATUS;
begin
  try
    { The following two lines merely set the SQLDA count
     variable FCount to 0, but do not deallocate
     That way the allocations can be reused for
     a new query sring in the same SQL instance }
//    FSQLRecord.Count := 0;
//    FSQLParams.Count := 0;
    if (HandleValue <> nil) and Database.Connected then
    begin
      isc_res :=
        Call(FGDSLibrary.isc_dsql_free_statement(StatusVector, FHandle, DSQL_drop), False);
      if (Marshal.ReadByte(StatusVector) = 1) and (isc_res > 0) and
         (isc_res <> isc_bad_stmt_handle) and
         (isc_res <> isc_lost_db_connection) then
        IBDatabaseError;
    end;
  finally
    FPrepared := False;
    HandleValue := nil;
  end;
end;

function TIBSQL.GetDatabase: TIBDatabase;
begin
  result := FBase.Database;
end;

function TIBSQL.GetDBHandle: PISC_DB_HANDLE;
begin
  result := FBase.DBHandle;
end;

function TIBSQL.GetPlan: String;
const
  buffer_size = 16585;
var
  result_buffer, info_request: IntPtr;
  result_length : Integer;
begin
  if (not Prepared) or
     (not (FSQLType in [SQLSelect, SQLSelectForUpdate,
                                 
       SQLUpdate, SQLDelete])) then
    result := ''
  else
  begin
    info_request := Marshal.AllocHGlobal(SizeOf(Byte));
    Marshal.WriteByte(info_request, isc_info_sql_get_plan);
    result_buffer := Marshal.AllocHGlobal(buffer_size);
    try
      Call(FGDSLibrary.isc_dsql_sql_info(StatusVector, FHandle, 2, info_request,
                             buffer_size, result_buffer), True);
      if (Marshal.ReadByte(result_buffer) <> isc_info_sql_get_plan) then
      begin
        Result := 'Plan unavailable';
      end
      else
      begin
        result_length := Marshal.ReadInt16(result_buffer, 1);
        Result := Marshal.PtrToStringAnsi(IntPtr(Integer(result_buffer) + 3), result_length);
        Result := Trim(result);
      end;
    finally
      Marshal.FreeHGlobal(result_buffer);
      Marshal.FreeHGlobal(info_request);
    end;
  end;
end;

function TIBSQL.GetRecordCount: Integer;
begin
  result := FRecordCount;
end;

function TIBSQL.GetRowsAffected: integer;
const
  buffer_size = 1049;
var
  result_buffer, info_request : IntPtr;
begin
  if not Prepared then
    result := -1
  else
  begin
    info_request := Marshal.AllocHGlobal(SizeOf(Byte));
    Marshal.WriteByte(info_request, isc_info_sql_records);
    result_buffer := Marshal.AllocHGlobal(buffer_size);
    try
      if FGDSLibrary.isc_dsql_sql_info(StatusVector, FHandle, 1, info_request,
                           buffer_size, result_buffer) > 0 then
        IBDatabaseError;
      if (Marshal.ReadByte(result_buffer) <> isc_info_sql_records) then
        result := -1
      else
      case SQLType of
        SQLUpdate:   Result := Marshal.ReadInt32(result_buffer, 6);
        SQLDelete:   Result := Marshal.ReadInt32(result_buffer, 13);
        SQLInsert:   Result := Marshal.ReadInt32(result_buffer, 27);
      else
        Result := -1;
      end ;
    finally
      Marshal.FreeHGlobal(result_buffer);
      Marshal.FreeHGlobal(info_request);
    end;
  end;
end;

function TIBSQL.GetSQLParams: TIBXSQLDA;
var
  FTransactionStarted : Boolean;
begin
  FTransactionStarted := not Transaction.InTransaction;
  if FTransactionStarted then
    Transaction.StartTransaction;
  if not Prepared then
    Prepare;
  result := FSQLParams;
  if FTransactionStarted then
    Transaction.Commit;
end;

function TIBSQL.GetTransaction: TIBTransaction;
begin
  result := FBase.Transaction;
end;

function TIBSQL.GetTRHandle: PISC_TR_HANDLE;
begin
  result := FBase.TRHandle;
end;

{
 Preprocess SQL
 Using FSQL, process the typed SQL and put the process SQL
 in FProcessedSQL and parameter names in FSQLParams
}
procedure TIBSQL.PreprocessSQL;
var
  cCurChar, cNextChar, cQuoteChar: Char;
  sSQL, sProcessedSQL, sParamName: String;
  i, iLenSQL, iSQLPos: Integer;
  iCurState, iCurParamState: Integer;
  iParamSuffix: Integer;
  slNames: TStrings;

const
  DefaultState = 0;
  CommentState = 1;
  QuoteState = 2;
  ParamState = 3;
  ParamDefaultState = 0;
  ParamQuoteState = 1;

  procedure AddToProcessedSQL(cChar: Char);
  begin
    sProcessedSQL[iSQLPos] := cChar;
    Inc(iSQLPos);
  end;

begin
  slNames := TStringList.Create;
  try
    { Do some initializations of variables }
    iParamSuffix := 0;
    cQuoteChar := '''';
    sSQL := FSQL.Text;
    iLenSQL := Length(sSQL);
    SetLength(sProcessedSQL, iLenSQL + 1);
    i := 1;
    iSQLPos := 1;
    iCurState := DefaultState;
    iCurParamState := ParamDefaultState;
    { Now, traverse through the SQL string, character by character,
     picking out the parameters and formatting correctly for InterBase }
    while (i <= iLenSQL) do begin
      { Get the current token and a look-ahead }
      cCurChar := sSQL[i];
      if i = iLenSQL then
        cNextChar := #0
      else
        cNextChar := sSQL[i + 1];
      { Now act based on the current state }
      case iCurState of
        DefaultState: begin
          case cCurChar of
            '''', '"': begin
              cQuoteChar := cCurChar;
              iCurState := QuoteState;
            end;
            '?', ':': begin
              iCurState := ParamState;
              AddToProcessedSQL('?');
            end;
            '/': if (cNextChar = '*') then begin
              AddToProcessedSQL(cCurChar);
              Inc(i);
              iCurState := CommentState;
            end;
          end;
        end;
        CommentState: begin
          if (cNextChar = #0) then
            IBError(ibxeSQLParseError, [SEOFInComment])
          else if (cCurChar = '*') then begin
            if (cNextChar = '/') then
              iCurState := DefaultState;
          end;
        end;
        QuoteState: begin
          if cNextChar = #0 then
            IBError(ibxeSQLParseError, [SEOFInString])
          else if (cCurChar = cQuoteChar) then begin
            if (cNextChar = cQuoteChar) then begin
              AddToProcessedSQL(cCurChar);
              Inc(i);
            end else
              iCurState := DefaultState;
          end;
        end;
        ParamState:
        begin
          { collect the name of the parameter }
          if iCurParamState = ParamDefaultState then
          begin
            if cCurChar = '"' then
              iCurParamState := ParamQuoteState
            else
              if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
                sParamName := sParamName + cCurChar
            else if FGenerateParamNames then
            begin
              sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
              Inc(iParamSuffix);
              iCurState := DefaultState;
              slNames.Add(sParamName);
              sParamName := '';
            end
            else
              IBError(ibxeSQLParseError, [SParamNameExpected]);
          end
          else begin
            { determine if Quoted parameter name is finished }
            if cCurChar = '"' then
            begin
              Inc(i);
              slNames.Add(sParamName);
              SParamName := '';
              iCurParamState := ParamDefaultState;
              iCurState := DefaultState;
            end
            else
              sParamName := sParamName + cCurChar
          end;
          { determine if the unquoted parameter name is finished }
          if (iCurParamState <> ParamQuoteState) and
            (iCurState <> DefaultState) then
          begin
            if not (cNextChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
            begin
              Inc(i);
              iCurState := DefaultState;
              slNames.Add(sParamName);
              sParamName := '';
            end;
          end;
        end;
      end;
      if iCurState <> ParamState then
        AddToProcessedSQL(sSQL[i]);
      Inc(i);
    end;
    AddToProcessedSQL(#0);
    FSQLParams.Count := slNames.Count;
    for i := 0 to slNames.Count - 1 do
      FSQLParams.AddName(slNames[i], i);
    FProcessedSQL.Text := sProcessedSQL;
  finally
    slNames.Free;
  end;
end;

procedure TIBSQL.SetDatabase(Value: TIBDatabase);
begin
  if FBase.Database <> Value then
    FBase.Database := Value;
end;

procedure TIBSQL.Prepare;
var
  stmt_len : Integer;
  res_buffer: IntPtr;
  type_item: IntPtr;
  sqlda : TXSQLDA;
  pString : IntPtr;
begin
  CheckClosed;
  FBase.CheckDatabase;
  FBase.CheckTransaction;
  if FPrepared then
    exit;
  if (FSQL.Text = '') then
    IBError(ibxeEmptyQuery, [nil]);
  if not ParamCheck then
    FProcessedSQL.Text := FSQL.Text
  else
    PreprocessSQL;
  if (FProcessedSQL.Text = '') then
    IBError(ibxeEmptyQuery, [nil]);
  try
    Call(FGDSLibrary.isc_dsql_alloc_statement2(StatusVector, DBHandle,
                                    FHandle), True);
    pString := Marshal.StringToHGlobalAnsi(FProcessedSQL.Text);
    try
      Call(FGDSLibrary.isc_dsql_prepare(StatusVector, TRHandle, FHandle, 0,
              pString, Database.SQLDialect, nil), True);
    finally
      Marshal.FreeHGlobal(pString);
    end;
    { After preparing the statement, query the stmt type and possibly
      create a FSQLRecord "holder" }
    { Get the type of the statement }
    type_item := Marshal.AllocHGlobal(SizeOf(Byte));
    Marshal.WriteByte(type_item, isc_info_sql_stmt_type);
    res_buffer := Marshal.AllocHGlobal(8);
    try
      Call(FGDSLibrary.isc_dsql_sql_info(StatusVector, FHandle, 1, type_item,
                           8, res_buffer), True);
      if (Marshal.ReadByte(res_buffer) <> isc_info_sql_stmt_type) then
        IBError(ibxeUnknownError, [nil]);
      stmt_len := Marshal.ReadInt16(res_buffer, 1);
      case stmt_len of
        2 : FSQLType := TIBSQLTypes(Marshal.ReadInt16(res_buffer, 3));
        4 : FSQLType := TIBSQLTypes(Marshal.ReadInt32(res_buffer, 3));
        8 : FSQLType := TIBSQLTypes(Marshal.ReadInt64(res_buffer, 3));
      end;
    finally
      Marshal.FreeHGlobal(res_buffer);
      Marshal.FreeHGlobal(type_item);
    end;
    { Done getting the type }
    case FSQLType of
      SQLGetSegment,
      SQLPutSegment,
      SQLStartTransaction:
      begin
        FreeHandle;
        IBError(ibxeNotPermitted, [nil]);
      end;
      SQLCommit,
      SQLRollback,
      SQLDDL, SQLSetGenerator,
      SQLInsert, SQLUpdate, SQLDelete, SQLSelect, SQLSelectForUpdate,
      SQLExecProcedure:
      begin
        { We already know how many inputs there are, so... }
        if (FSQLParams.FXSQLDA <> nil) and
           (Call(FGDSLibrary.isc_dsql_describe_bind(StatusVector, FHandle, Database.SQLDialect,
                                        FSQLParams.FXSQLDA), False) > 0) then
          IBDatabaseError;

        FSQLParams.Initialize;
        if FSQLType in [SQLSelect, SQLSelectForUpdate,
                        SQLExecProcedure] then
        begin
          { Allocate an initial output descriptor (with one column) }
          FSQLRecord.Count := 1;
          { Using isc_dsql_describe, get the right size for the columns... }
          Call(FGDSLibrary.isc_dsql_describe(StatusVector, FHandle,
                           Database.SQLDialect, FSQLRecord.FXSQLDA), True);
          sqlda := TXSQLDA(Marshal.PtrToStructure(FSQLRecord.FXSQLDA, TypeOf(TXSQLDA)));
          if sqlda.sqld > sqlda.sqln then
          begin
            FSQLRecord.Count := sqlda.sqld;
            Call(FGDSLibrary.isc_dsql_describe(StatusVector, FHandle,
               Database.SQLDialect, FSQLRecord.FXSQLDA), True);
          end
          else
            if sqlda.sqld = 0 then
              FSQLRecord.Count := 0;

          FSQLRecord.Initialize;
        end;
      end;
    end;
    FPrepared := True;
    if not (csDesigning in ComponentState) then
      MonitorHook.SQLPrepare(Self);
  except
    on E: Exception do
    begin
      if (HandleValue <> nil) then
        FreeHandle;
      raise;
    end;
  end;
end;

function TIBSQL.GetUniqueRelationName: String;
begin
  if FPrepared and (FSQLType = SQLSelect) then
    result := FSQLRecord.UniqueRelationName
  else
    result := '';
end;

procedure TIBSQL.SetSQL(Value: TStrings);
begin
  if FSQL.Text <> Value.Text then
  begin
    FSQL.BeginUpdate;
    try
      FSQL.Assign(Value);
    finally
      FSQL.EndUpdate;
    end;
  end;
end;

procedure TIBSQL.SetTransaction(Value: TIBTransaction);
begin
  if FBase.Transaction <> Value then
  begin
    if Prepared then
      FreeHandle;
    FBase.Transaction := Value;
  end;
end;

procedure TIBSQL.SQLChanging(Sender: TObject);
begin
  if Assigned(OnSQLChanging) then
    OnSQLChanging(Self);
  if HandleValue <> nil then
    FreeHandle;
end;

procedure TIBSQL.BeforeTransactionEnd(Sender: TObject);
begin
  if FOpen then
    Close;
end;

function TIBSQL.ParamByName(Idx: String): TIBXSQLVAR;
begin
  if not Prepared then
    Prepare;
  result := FSQLParams.ByName(Idx);
end;

procedure TIBSQL.OutputXML(OutputObject: TIBOutputXML);
var
  OldGotoValue : Boolean;
begin
  CheckClosed;
  if not Prepared then
    Prepare;
  if FSQLType = SQLSelect then
  begin
    OldGotoValue := FGoToFirstRecordOnExecute;
    FGoToFirstRecordOnExecute := false;
    ExecQuery;
    try
      OutputObject.WriteXML(self);
    finally
      Close;
      FGoToFirstRecordOnExecute := OldGotoValue;
    end;
  end;
end;

function TIBSQL.GetFieldCount: Integer;
begin
  Result := Current.Count;
end;

procedure TIBSQL.Unprepare;
begin
  FreeHandle;
end;

{ TIBOutputXML }

procedure TIBOutputXML.WriteXML(SQL : TIBSQL);
var
  xmlda : Tib_xmlda;
  buffer : IntPtr;
  buffer_size, size : Integer;
  done : Boolean;
begin
  buffer_size := 1024;
  buffer := Marshal.AllocHGlobal(buffer_size);
  try
    xmlda.xmlda_status := 0;
    xmlda.xmlda_version := 1;
    if FHeaderTag <> '' then
      xmlda.xmlda_header_tag := Marshal.StringToHGlobalAnsi(FHeaderTag)
    else
      xmlda.xmlda_header_tag := Marshal.StringToHGlobalAnsi('<?xml version = "1.0"?>' + #10#13 + '<!-- XML from IB -->' + #10#13); {do not localize}
    xmlda.xmlda_database_tag := Marshal.StringToHGlobalAnsi(FDatabaseTag);
    xmlda.xmlda_table_tag := Marshal.StringToHGlobalAnsi(FTableTag);
    xmlda.xmlda_row_tag := Marshal.StringToHGlobalAnsi(FRowTag);
    xmlda.xmlda_flags := 0;

    if xmlAttribute in FFlags then
      xmlda.xmlda_flags := (xmlda.xmlda_flags or XMLDA_ATTRIBUTE_FLAG);
    if xmlDisplayNull in FFlags then
      xmlda.xmlda_flags := (xmlda.xmlda_flags or XMLDA_DISPLAY_NULL_FLAG);
    if xmlNoHeader in FFlags then
      xmlda.xmlda_flags := (xmlda.xmlda_flags or XMLDA_NO_HEADER_FLAG);


    xmlda.xmlda_file_name := Marshal.StringToHGlobalAnsi('');
    done := false;
    while not done do
    begin
      size := SQL.Call(_isc_dsql_xml_buffer_fetch(StatusVector,
        SQL.Handle, buffer, buffer_size, 1, SQL.Current.AsXSQLDA, xmlda), false);
      case size of
        ERR_BUFFERSIZE_NOT_ENOUGH :
        begin
          Inc(buffer_size, 1024);
          buffer := Marshal.ReAllocHGlobal(buffer, IntPtr(buffer_size));
        end;
        ERR_NOT_ENOUGH_MEMORY :
          raise EIBClientError.Create(0, SIBMemoryError);
        else
        begin
          Size := Length(Marshal.PtrToStringAnsi(Buffer));
          FStream.WriteBuffer(BytesOf(Marshal.PtrToStringAnsi(Buffer)), Size);
          Done := (xmlda.xmlda_more_data = 0);
        end;
      end;
    end;
  finally
    Marshal.FreeHGlobal(buffer);
    Marshal.FreeHGlobal(xmlda.xmlda_header_tag);
    Marshal.FreeHGlobal(xmlda.xmlda_database_tag);
    Marshal.FreeHGlobal(xmlda.xmlda_table_tag);
    Marshal.FreeHGlobal(xmlda.xmlda_row_tag);
    Marshal.FreeHGlobal(xmlda.xmlda_file_name);
  end;
end;

procedure OutputXML(sqlObject : TIBSQL; OutputObject: TIBOutputXML);
var
  OldGotoValue : Boolean;
begin
  sqlObject.CheckClosed;
  if not sqlObject.Prepared then
    sqlObject.Prepare;
  if sqlObject.SQLType = SQLSelect then
  begin
    OldGotoValue := sqlObject.GoToFirstRecordOnExecute;
    sqlObject.GoToFirstRecordOnExecute := false;
    sqlObject.ExecQuery;
    try
      OutputObject.WriteXML(sqlObject);
    finally
      sqlObject.Close;
      sqlObject.GoToFirstRecordOnExecute := OldGotoValue;
    end;
  end;
end;

{ TSQLVAR_V1 }

procedure TSQLVAR_V1.SetCharValue(Length_name, Value : String);
var
  OffSet : Integer;
begin
  OffSet := Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR_V1), Length_name));
  Marshal.WriteInt16(FXSQLVAR, OffSet, Length(BytesOf(Value)));
  Marshal.Copy(BytesOf(Value), 0, IntPtr(Integer(FXSQLVAR) +
                 OffSet + 2), Length(BytesOf(Value)));
end;

function TSQLVAR_V1.GetAliasName: String;
begin
  result := TXSQLVAR_V1(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR_V1))).aliasname;
end;

function TSQLVAR_V1.GetOwnName: String;
begin
  result := TXSQLVAR_V1(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR_V1))).ownname;
end;

function TSQLVAR_V1.GetRelName: String;
begin
  result := TXSQLVAR_V1(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR_V1))).relname;
end;

function TSQLVAR_V1.GetSqlData: IntPtr;
begin
  result := TXSQLVAR_V1(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR_V1))).sqldata;
end;

function TSQLVAR_V1.GetSqlInd: PShort;
begin
  result := TXSQLVAR_V1(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR_V1))).sqlind;
end;

function TSQLVAR_V1.GetSqlLen: Short;
begin
  result := TXSQLVAR_V1(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR_V1))).sqllen;
end;

function TSQLVAR_V1.GetSqlName: String;
begin
  result := TXSQLVAR_V1(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR_V1))).sqlname;
end;

function TSQLVAR_V1.GetSqlPrecision: Short;
begin
  case sqltype and not 1 of
    SQL_SHORT:
      Result := 4;
    SQL_LONG:
      Result := 9;
    SQL_INT64:
      Result := 18;
    else
      Result := 0;
  end;
end;

function TSQLVAR_V1.GetSqlScale: Short;
begin
  result := TXSQLVAR_V1(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR_V1))).sqlscale;
end;

function TSQLVAR_V1.GetSqlSubtype: Short;
begin
  result := TXSQLVAR_V1(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR_V1))).sqlsubtype;
end;

function TSQLVAR_V1.GetSqlType: Short;
begin
  result := TXSQLVAR_V1(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR_V1))).sqltype;
end;

function TSQLVAR_V1.GetSQLVAR: IntPtr;
begin
  Result := FXSQLVAR;
end;

procedure TSQLVAR_V1.SetAliasName(const Value: String);
begin
   SetCharValue('aliasname_length', Value )
end;

procedure TSQLVAR_V1.SetDataSize(oldsize, newsize: Integer);
var
  sqldata : IntPtr;
begin
  IBAlloc(sqldata, oldsize, newsize);
  Marshal.WriteIntPtr(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR_V1), 'sqldata'))), sqldata);
end;

procedure TSQLVAR_V1.SetIndSize(oldsize, newsize: Integer);
var
  sqlind : IntPtr;
begin
  IBAlloc(sqlind, oldsize, newsize);
  Marshal.WriteIntPtr(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR_V1), 'sqlind'))), sqlind);
end;

procedure TSQLVAR_V1.SetOwnName(const Value: String);
begin
  SetCharValue('ownname_length', Value )
end;

procedure TSQLVAR_V1.SetRelName(const Value: String);
begin
  SetCharValue('relname_length', Value )
end;

procedure TSQLVAR_V1.SetSqlData(const Value : IntPtr);
begin
  Marshal.WriteIntPtr(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR_V1), 'sqldata'))), Value);
end;

procedure TSQLVAR_V1.SetSqlInd(const Value: PShort);
begin
  Marshal.WriteIntPtr(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR_V1), 'sqlind'))), Value);
end;

procedure TSQLVAR_V1.SetSqlLen(const Value: Short);
begin
  Marshal.WriteInt16(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR_V1), 'sqllen'))), Value);
end;

procedure TSQLVAR_V1.SetSqlName(const Value: String);
begin
  SetCharValue('sqlname_length', Value);
end;

procedure TSQLVAR_V1.SetSqlPrecision(const Value: Short);
begin
  IBError(ibxeNotSupported, []);
end;

procedure TSQLVAR_V1.SetSqlScale(const Value: Short);
begin
  Marshal.WriteInt16(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR_V1), 'sqlscale'))), Value);
end;

procedure TSQLVAR_V1.SetSqlSubtype(const Value: Short);
begin
  Marshal.WriteInt16(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR_V1), 'sqlsubtype'))), Value);
end;

procedure TSQLVAR_V1.SetSqlType(const Value: Short);
begin
  Marshal.WriteInt16(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR_V1), 'sqltype'))), Value);
end;

procedure TSQLVAR_V1.SetSQLVAR(const Value: IntPtr);
begin
  FXSQLVAR := Value;
end;


{ TSQLVAR_V2 }

procedure TSQLVAR_V2.SetCharValue(Length_name, Value : String);
var
  OffSet : Integer;
begin
  OffSet := Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR), Length_name));
  Marshal.WriteInt16(FXSQLVAR, OffSet, Length(BytesOf(Value)));
  Marshal.Copy(BytesOf(Value), 0, IntPtr(Integer(FXSQLVAR) +
                 OffSet + 2), Length(BytesOf(Value)));
end;

function TSQLVAR_V2.GetAliasName: String;
begin
  result := TXSQLVAR(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR))).aliasname;
end;

function TSQLVAR_V2.GetOwnName: String;
begin
  result := TXSQLVAR(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR))).ownname;
end;

function TSQLVAR_V2.GetRelName: String;
begin
  result := TXSQLVAR(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR))).relname;
end;

function TSQLVAR_V2.GetSqlData: IntPtr;
begin
  result := TXSQLVAR(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR))).sqldata;
end;

function TSQLVAR_V2.GetSqlInd: PShort;
begin
  result := TXSQLVAR(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR))).sqlind;
end;

function TSQLVAR_V2.GetSqlLen: Short;
begin
  result := TXSQLVAR(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR))).sqllen;
end;

function TSQLVAR_V2.GetSqlName: String;
begin
  result := TXSQLVAR(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR))).sqlname;
end;

function TSQLVAR_V2.GetSqlPrecision: Short;
begin
  Result := TXSQLVAR(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR))).sqlprecision;
  if Result = 0 then
    case sqltype and not 1 of
      SQL_SHORT:
        Result := 4;
      SQL_LONG:
        Result := 9;
      SQL_INT64:
        Result := 18;
      else
        Result := 0;
    end;
end;

function TSQLVAR_V2.GetSqlScale: Short;
begin
  result := TXSQLVAR(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR))).sqlscale;
end;

function TSQLVAR_V2.GetSqlSubtype: Short;
begin
  result := TXSQLVAR(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR))).sqlsubtype;
end;

function TSQLVAR_V2.GetSqlType: Short;
begin
  Result := TXSQLVAR(Marshal.PtrToStructure(FXSQLVAR, TypeOf(TXSQLVAR))).sqltype;
end;

function TSQLVAR_V2.GetSQLVAR: IntPtr;
begin
  Result := FXSQLVAR;
end;

procedure TSQLVAR_V2.SetAliasName(const Value: String);
begin
  SetCharValue('aliasname_length', Value )
end;

procedure TSQLVAR_V2.SetDataSize(oldsize, newsize : Integer);
var
  sqldata : IntPtr;
begin
  IBAlloc(sqldata, oldsize, newsize);
  Marshal.WriteIntPtr(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR), 'sqldata'))), sqldata);
end;

procedure TSQLVAR_V2.SetIndSize(oldsize, newsize: Integer);
var
  sqlind : IntPtr;
begin
  IBAlloc(sqlind, oldsize, newsize);
  Marshal.WriteIntPtr(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR), 'sqlind'))), sqlind);
end;

procedure TSQLVAR_V2.SetOwnName(const Value: String);
begin
  SetCharValue('ownname_length', Value )
end;

procedure TSQLVAR_V2.SetRelName(const Value: String);
begin
  SetCharValue('relname_length', Value )
end;

procedure TSQLVAR_V2.SetSqlData(const Value : IntPtr);
begin
  Marshal.WriteIntPtr(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR), 'sqldata'))), Value);
end;

procedure TSQLVAR_V2.SetSqlInd(const Value: PShort);
begin
  Marshal.WriteIntPtr(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR), 'sqlind'))), Value);
end;

procedure TSQLVAR_V2.SetSqlLen(const Value: Short);
begin
  Marshal.WriteInt16(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR), 'sqllen'))), Value);
end;

procedure TSQLVAR_V2.SetSqlName(const Value: String);
begin
  SetCharValue('sqlname_length', Value);
end;

procedure TSQLVAR_V2.SetSqlPrecision(const Value: Short);
begin
  Marshal.WriteInt16(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR), 'sqlprecision'))), Value);
end;

procedure TSQLVAR_V2.SetSqlScale(const Value: Short);
begin
  Marshal.WriteInt16(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR), 'sqlscale'))), Value);
end;

procedure TSQLVAR_V2.SetSqlSubtype(const Value: Short);
begin
  Marshal.WriteInt16(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR), 'sqlsubtype'))), Value);
end;

procedure TSQLVAR_V2.SetSqlType(const Value: Short);
begin
  Marshal.WriteInt16(IntPtr(Integer(FXSQLVAR) +
         Integer(Marshal.OffsetOf(TypeOf(TXSQLVAR), 'sqltype'))), Value);
end;

procedure TSQLVAR_V2.SetSQLVAR(const Value: IntPtr);
begin
  FXSQLVAR := Value;
end;

{ TSQLVAR }

function TSQLVAR.GetSqlDef: Short;
begin
  Result := SqlType and (not 1);
end;

end.
