fibquery.pas

FIBPlus is a component suite intended for work with InterBase. It is direct, fast and flexible Inter

{***************************************************************}
{ FIBPlus - component library for direct access to Firebird and }
{ InterBase databases                                           }
{                                                               }
{    FIBPlus is based in part on the product                    }
{    Free IB Components, written by Gregory H. Deatz for        }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.            }
{    mailto:[e-mail]                                    }
{                                                               }
{    Copyright (c) 1998-2007 Devrace Ltd.                       }
{    Written by Serge Buzadzhy ([e-mail])               }
{                                                               }
{ ------------------------------------------------------------- }
{    FIBPlus home page: http://www.fibplus.com/                 }
{    FIBPlus support  : http://www.devrace.com/support/         }
{ ------------------------------------------------------------- }
{                                                               }
{  Please see the file License.txt for full license information }
{***************************************************************}

unit FIBQuery;


interface

{$I FIBPlus.inc}

uses
  SysUtils, Classes, ibase,IB_Intf, IB_Externals,
  DB, fib, FIBDatabase, StdFuncs,IB_ErrorCodes,SqlTxtRtns,pFIBProps,
  pFIBInterfaces, 
 {$IFDEF SUPPORT_ARRAY_FIELD}   pFIBArray,  {$ENDIF}
 {$IFDEF WINDOWS}
   Windows {$IFDEF D6+},FMTBcd,  Variants{$ENDIF}
   ;
 {$ENDIF}
 {$IFDEF LINUX}
   Types, FMTBcd , Variants;
 {$ENDIF}

type
  TFIBQuery = class;
  TFIBXSQLDA = class;
  TFIBXSQLVAR = class;

  TExtDescribeSQLVar =
  record
   sql_relation_alias: array[0..LENGTH_METANAMES-1] of Char;
  end;
  


  TTypeSetToParam =(tspNull,tspIsNullable,tspScale, tspValue,tspSqlVar);

  (* TFIBXSQLVAR *)
  TFIBXSQLVAR = class(TObject)
  private
    function  GetAsBoolean: boolean;
    procedure SetAsBoolean(const Value: boolean);
  protected
    FIndex: Integer;
    FModified: Boolean;
    FName: string;
    FQuery: TFIBQuery;
    FVariantFalse,
    FVariantTrue: Variant;
    FXSQLVAR: PXSQLVAR;       // Point to the PXSQLVAR in the owner object
    FParent : TFIBXSQLDA;
// Added variables
    FIsMacro :boolean;
    FQuoted  :boolean;
    FOldValue:Variant; // Value Param from last ExecQuery
    FDefMacroValue :string;
    FSrvSQLType    :integer;
    FSrvSQLSubType :integer;
    FSrvSQLLen     :Smallint;
    FSrvSQLScale   :Smallint;
    FInWhereClause :boolean;
    FCanForceIsNull:boolean;
    FInitialized   :boolean;
    FBeginPosInText:integer;
    FEndPosInText  :integer;
    FIsDefferedSetting:boolean;
    FStreamValue   :TMemoryStream;
    FWideTempValue :WideString;
 {$IFDEF SUPPORT_ARRAY_FIELD}
    vFIBArray:TpFIBArray;
 {$ENDIF}

    function AdjustScale(Value: Int64; Scale: Integer): Double; {$IFDEF D6+} deprecated; {$ENDIF}
    function AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency; {$IFDEF D6+} deprecated;{$ENDIF}
    function AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;{$IFDEF D6+} deprecated;{$ENDIF}
    function GetAsInt64: Int64;

    function GetAsCurrency: Currency;
 {$IFNDEF NO_USE_COMP}
    function GetAsComp: Comp;
 {$ENDIF}    
    function GetAsDateTime: TDateTime;
    function GetAsTimeStamp: TTimeStamp;
    function GetAsDouble: Double;
    function GetAsFloat: Double;
    function GetAsSingle: Float;
    function GetAsLong: Long;
    function GetAsPointer: Pointer;
    function GetAsQuad: TISC_QUAD;
    function GetAsShort: Short;
    function GetAsString: string;
    function GetAsVariant:  Variant;
    function GetAsExtended: Extended;
    function GetAsXSQLVAR: PXSQLVAR;
    function GetIsNull: Boolean;
    function GetIsNullable: Boolean;
    function GetSize: Integer;
    function GetSQLType: Integer;
    function GetServerSQLType:Integer;
    function GetSQLSubtype: Short;
    function GetServerSQLSubType:Integer;
    function GetServerSQLSize:Integer;
    function GetServerSQLScale:Integer;    
//  Array Support
 {$IFDEF SUPPORT_ARRAY_FIELD}
    procedure CheckArrayType;
    function GetDimensionCount:Integer;
    function GetDimension(Index: Integer): TISC_ARRAY_BOUND;
    function GetSliceSize:integer;
    function GetElementType:TFieldType;
    function GetArraySize:integer;
  {$ENDIF}
//
    procedure SetValue(aSQLType,aSize:integer;ValueType:TTypeSetToParam;const aValue);

    procedure SetAsCurrency(aValue: Currency);
 {$IFNDEF NO_USE_COMP}
    procedure SetAsComp(aValue: comp); //patchInt64A
{$ENDIF}
    procedure SetAsInt64(aValue: Int64);
    procedure SetAsDateTime(aValue: TDateTime);
    procedure SetAsTime(aValue: TDateTime);
    procedure SetAsDate(aValue: TDateTime);
    procedure SetAsTimeStamp(aValue: TTimeStamp);
    procedure SetAsDouble(aValue: Double);
    procedure SetAsFloat(aValue: Double);
    procedure SetAsSingle(aValue: Float);
    procedure SetAsExtended(aValue: Extended);

    procedure SetAsLong(aValue: Long);
    procedure SetAsQuad(aValue: TISC_QUAD);
    procedure SetAsShort(aValue: Short);
    procedure InternalSetAsString(aValue:Pointer; IsWide:boolean; AdjustDeffered:boolean=False);
    procedure SetAsString(const aValue: string);
    procedure SetAsWideString(const aValue: WideString);
    function  GetAsWideString:WideString;

    procedure SetAsVariant(Value: Variant);

    procedure SetAsXSQLVAR(aValue: PXSQLVAR);
    procedure SetIsNull(aValue: Boolean);
    procedure SetIsNullable(aValue: Boolean);
    function  GetScale: integer;

    procedure SetScale(Value: integer);
    function  GetAsBcd: TBcd;
    procedure SetAsBcd(Value: TBcd);

    function  GetAsGUID: TGUID;
    procedure SetAsGuid(aValue: TGUID);
  public
    constructor Create(AParent: TFIBXSQLDA);
    destructor  Destroy; override;
    procedure   Assign(Source: TFIBXSQLVAR);


    procedure SetSQLLen(A:SmallInt);

    function IsNumericType(SQLType:Integer):boolean;
    function IsRealType(SQLType:Integer):boolean;
    function IsDateTimeType(SQLType:Integer):boolean;

    procedure LoadFromFile(const FileName: string);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    procedure SaveToStream(Stream: TStream);
    procedure Clear;
    function  IsParam:boolean;
    function  IsBlob:boolean;
    function  SqlName:string;
    function  AliasName:string;
    function  RelationName:string;
    function  CharacterSet :string;
// Array Support
{$IFDEF SUPPORT_ARRAY_FIELD}
    function  IsArray:boolean;
    function  GetArrayElement(Indexes: array of Integer):Variant;
    function  GetArrayValues:Variant;
    procedure SetArrayValue(Value:Variant);
{$ENDIF}
    function  IsDefMacroValue :boolean;
    procedure SetDefMacroValue;
//

    property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
 {$IFNDEF NO_USE_COMP}
    property AsComp: comp read GetAsComp write SetAsComp;
 {$ENDIF}
    property AsExtended: Extended read GetAsExtended write SetAsExtended;
    property AsInt64: Int64 read GetAsInt64 write SetAsInt64;
    property AsBcd: TBcd read GetAsBcd write SetAsBcd;
    property AsGuid:TGUID read GetAsGUID write SetAsGUID ;    
    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
    property AsDate: TDateTime read GetAsDateTime write SetAsDate;
    property AsTime: TDateTime read GetAsDateTime write SetAsTime;
    property AsTimeStamp:TTimeStamp read GetAsTimeStamp write SetAsTimeStamp;
    property AsDouble: Double read GetAsDouble write SetAsDouble;
    property AsFloat: Double read GetAsFloat write SetAsFloat;
    property AsSingle: Float read GetAsSingle write SetAsSingle;
    property AsInteger: Integer read GetAsLong write SetAsLong;
    property AsLong: Long read GetAsLong write SetAsLong;
    property AsPointer: Pointer read GetAsPointer ;
    property AsQuad: TISC_QUAD read GetAsQuad write SetAsQuad;
    property AsShort: Short read GetAsShort write SetAsShort;
    property AsString: string read GetAsString write SetAsString;
    property AsWideString: WideString read GetAsWideString write SetAsWideString;    
    property AsVariant: Variant read GetAsVariant write SetAsVariant;
    property AsXSQLVAR: PXSQLVAR read GetAsXSQLVAR write SetAsXSQLVAR;
    property AsBoolean: boolean  read GetAsBoolean write SetAsBoolean;
    property Data: PXSQLVAR read FXSQLVAR write FXSQLVAR;
    property IsNull: Boolean read GetIsNull write SetIsNull;
    property IsNullable: Boolean read GetIsNullable write SetIsNullable;
    property Scale: Integer read  GetScale write  SetScale;
    property Index: Integer read FIndex;
    property Modified: Boolean read FModified write FModified;
    property Name: string read FName;
    property Size: Integer read GetSize;
    property ServerSize: Integer read GetServerSQLSize;
    property SQLType: Integer read GetSQLType;
    property ServerSQLType: Integer read GetServerSQLType;
    property SQLSubtype:Short read GetSQLSubtype;
    property ServerSQLSubType: Integer read GetServerSQLSubType;    
    property Value: Variant read GetAsVariant write SetAsVariant;
    property OldValue: Variant read FOldValue;
    property VariantFalse: Variant read FVariantFalse write FVariantFalse;
    property VariantTrue: Variant read FVariantTrue write FVariantTrue;
// Added properties
    property IsMacro:boolean  read FIsMacro write FIsMacro;
    property Quoted :boolean  read FQuoted  write FQuoted;
    property DefMacroValue:string read FDefMacroValue write FDefMacroValue;
    property InWhereClause:boolean read FInWhereClause;
    property BeginPosInText:integer read FBeginPosInText;
    property EndPosInText  :integer read FEndPosInText;

//  Array Support
 {$IFDEF SUPPORT_ARRAY_FIELD}
    property FIBArray:TpFIBArray read vFIBArray;
    property DimensionCount:integer read GetDimensionCount;
    property Dimension[Index: Integer]: TISC_ARRAY_BOUND read GetDimension;
    property ElementType:TFieldType read GetElementType;
    property ArraySize:Integer read GetArraySize;
 {$ENDIF}

  end;

  TFIBXSQLVARArray = array[0..0] of TFIBXSQLVAR;
  PFIBXSQLVARArray = ^TFIBXSQLVARArray;

  (* TFIBXSQLVAR *)
  TFIBXSQLDA = class(TObject)
  private
    FEquelNames: TStringList;
    FCachedNames:TStringList;