fibquery.pas

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

    FCount: Integer;
    FHasDefferedSettings:Boolean;
    procedure AdjustDefferedSettings;
  protected
    FNames     : TStringList;
    FQuery: TFIBQuery;
    FSize: Integer;
    FXSQLDA: PXSQLDA;
    FXSQLVARs: PFIBXSQLVARArray; // array of FIBXQLVARs
    FIsParams: boolean;
    function   GetModified: Boolean;
    function   GetNames: string;
    function   GetRecordSize: Integer;
    function   GetXSQLDA: PXSQLDA;
    function   GetXSQLVAR(Idx: Integer): TFIBXSQLVAR;
    function   GetXSQLVARByName(const Idx: string): TFIBXSQLVAR;
    procedure  Initialize;
    procedure  SetCount(Value: Integer);
    procedure  AddName(const FieldName: string; Idx: Integer; Quoted:boolean);
    procedure  SetUnModifiedToVars;
  public
    constructor Create(aIsParams:boolean);
    destructor Destroy; override;
    procedure  ClearValues;
    function   FindParam(const aParamName: string): TFIBXSQLVAR;
    function   ParamByName(const aParamName: string): TFIBXSQLVAR;
    procedure  AssignValues(SourceSQLDA:TFIBXSQLDA);
    property AsXSQLDA: PXSQLDA read GetXSQLDA;
    property ByName[const Idx: string]: TFIBXSQLVAR read GetXSQLVARByName;
    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]: TFIBXSQLVAR read GetXSQLVAR; default;
  end;

  (* TFIBBatch - basis for batch input and batch output objects. *)
  TBatchState = (bsNotPrepared,bsFileReady,bsInProcess,bsInError);

  TFIBBatch = class(TObject)
  protected
    FFilename: string;
    FColumns: TFIBXSQLDA;
    FParams : TFIBXSQLDA;
    FState  : TBatchState;
  public
    constructor Create;
    procedure ReadyStream; virtual; abstract;
    property  Columns: TFIBXSQLDA read FColumns;
    property  Filename: string read FFilename write FFilename;
    property  Params: TFIBXSQLDA read FParams;
    property  State : TBatchState read FState ;
  end;

  (* TFIBBatchInputStream - see FIBMiscellaneous for good examples. *)
  TFIBBatchInputStream = class(TFIBBatch)
  public
    function ReadParameters: Boolean; virtual; abstract;
  end;
  TFIBBatchInputStreamClass = class of TFIBBatchInputStream;

  (* TFIBBatchOutputStream - see FIBMiscellaneous for good examples. *)
  TFIBBatchOutputStream = class(TFIBBatch)
  public
    function WriteColumns: Boolean; virtual; abstract;
  end;

  TFIBBatchOutputStreamClass = class of TFIBBatchOutputStream;

  (* TFIBQuery *)
  TFIBSQLTypes = (SQLUnknown, SQLSelect, SQLInsert,
                   SQLUpdate, SQLDelete, SQLDDL,
                   SQLGetSegment, SQLPutSegment,
                   SQLExecProcedure, SQLStartTransaction,
                   SQLCommit, SQLRollback,
                   SQLSelectForUpdate, SQLSetGenerator,SQLSavePointOperation
                  );

  TOnSQLFetch  =procedure (RecordNumber:integer;   var StopFetching:boolean
  ) of object;

  TBatchOperation =(boInput,boOutput,boOutputToQuery);
  TBatchAction    =(baContinue,baStop,baSkip);
  TBatchErrorAction =(beFail, beAbort, beRetry,beIgnore);

  TOnBatching     =
   procedure(BatchOperation:TBatchOperation;RecNumber:integer;var BatchAction :TBatchAction)
   of object;

  TOnBatchError  =  procedure(E:EFIBError;var BatchErrorAction:TBatchErrorAction)   of object;


  TAllRowsAffected =
  record
    Updates: integer;
    Deletes: integer;
    Selects: integer;
    Inserts: integer;
  end;

  TQueryRunStateValues=(qrsInPrepare,qrsInExecute);
  TQueryRunState = set of TQueryRunStateValues;

  TFIBQuery = class(TComponent,ISQLObject)
  private
   FOnBatching:TOnBatching;
   FDoParamCheck:boolean;
   FParser:    TSQLParser;
   FTransactionEnding:TNotifyEvent;
   FTransactionEnded :TNotifyEvent;
   FBeforeExecute :TNotifyEvent;
   FAfterExecute  :TNotifyEvent;
{$IFDEF CSMonitor}
   FCSMonitorSupport: TCSMonitorSupport;
   procedure SetMonitorSupport(Value:TCSMonitorSupport);   
   function GetCSMonText: string;
{$ENDIF}   
   function GetSQLKind: TSQLKind;
  protected
    FBase: TFIBBase;
    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?
    FHandle: TISC_STMT_HANDLE;     // 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: string;       // SQL Query (pre-processed for param labels)
    FSQLParams,                    // Any parameters to the query.
    FSQLRecord: TFIBXSQLDA;        // The current record
    FSQLType: TFIBSQLTypes;        // Select, update, delete, insert, create, alter, etc...


    FUserSQLParams:TFIBXSQLDA;
    FProcExecuted:boolean;
    FOnSQLFetch:TOnSQLFetch;
    FMacroChar :Char;
    vUserParamsCreated:boolean;
    FCountLockSQL:integer;
    FModifyTable:string;
    FOptions:TpFIBQueryOptions;
    vDiffParams:boolean;
    FOnlySrvParams :TStringList;
    FCallTime :Cardinal;
    FMacroChanged:boolean;
    FSQLTextChangeCount:integer;
    FHaveStreamParams:boolean;
    FQueryRunState:TQueryRunState;
    FCodePageApplied:boolean;
    FAutoCloseOnTransactionEnd:boolean;
  {$DEFINE FIB_INTERFACE}
   {$I FIBQueryPT.inc}
  {$UNDEF FIB_INTERFACE}
    procedure SaveStreamedParams;
    procedure ClearStreamedParams;    
    procedure SetParamCheck(Value:boolean);
    function  GetModifyTable:string;
    procedure DatabaseDisconnecting(Sender: TObject);
    function  GetDatabase: TFIBDatabase;
    function  GetDBHandle: PISC_DB_HANDLE;
    function  GetEOF: Boolean;
    function  GetFields(const Idx: Integer): TFIBXSQLVAR;
    function  GetFieldIndex(const FieldName: string): Integer;
    function  GetPlan: string;
    function  GetRecordCount: Integer;
    function  GetRowsAffected: Integer;
    function  GetAllRowsAffected: TAllRowsAffected ;

    function  GetSQLParams: TFIBXSQLDA;
    function  GetTransaction: TFIBTransaction;
    function  GetTRHandle: PISC_TR_HANDLE;
    procedure SetDatabase(Value: TFIBDatabase); virtual;
    procedure SetSQL(Value: TStrings);
    procedure SetMacroChar(Value:Char);
    procedure SetTransaction(Value: TFIBTransaction);
    procedure SQLChanging(Sender: TObject);
    procedure SQLChange(Sender: TObject);
    procedure DoTransactionEnding(Sender: TObject);
 // Added procedures
    procedure SaveRestoreValues(SQLDA:TFIBXSQLDA;IsSave:boolean);

    function  GetWhereClause(Index:Integer):string;
    procedure SetWhereClause(Index:Integer;const WhereClauseTxt:string);
    function  GetOrderString:string;
    procedure SetOrderString(const OrderTxt:string);

    function  GetGroupByString:string;
    procedure SetGroupByString(const GroupByTxt:string);

    function  GetFieldsClause:string;
    procedure SetFieldsClause(const NewFields:string);

    procedure PrepareUserParamsTypes;
    procedure StartStatisticExec(const stText:string);
    procedure EndStatisticExec(const stText:string);
    procedure DoStatisticPrepare(const stText:string);

    function  ParamsNotExist(const SQLText:string):boolean;
    procedure PreprocessSQL(const sSQL:string;IsUserSQL:boolean);
    procedure DoBeforeExecute;
    procedure DoAfterExecute;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   Loaded;  override;
    property Handle: TISC_STMT_HANDLE read FHandle;         
  private
    FExtSQLDA:array of TExtDescribeSQLVar;
    procedure FillExtDescribeSQLVars;
    procedure ConvertSQLTextToCodePage;
  public
    function TableAliasForField(FieldIndex:integer):string; overload;
    function TableAliasForFieldByName(const aFieldName:string):string;
 {$IFNDEF BCB}
    function TableAliasForField(const aFieldName:string):string; overload;
 {$ENDIF}
  private
    FOnBatchError :TOnBatchError  ;
    FCursorName   :string;
  public
    function BatchInput(InputObject: TFIBBatchInputStream) :boolean;
    function BatchOutput(OutputObject: TFIBBatchOutputStream):boolean;
{$IFDEF WINDOWS}
    procedure BatchInputRawFile(const FileName:string);
    procedure BatchOutputRawFile(const FileName:string;Version:integer=1);
{$ENDIF}
    procedure BatchToQuery(ToQuery:TFIBQuery;Mappings:TStrings);
  public
    function  Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
    procedure CheckClosed(const OpName:string);// raise error if query is not closed.
    procedure CheckOpen(const OpName:string); // raise error if query is not open.
    procedure CheckValidStatement;   // raise error if statement is invalid.
    procedure Close;               // close the query.
    function  Current: TFIBXSQLDA;
    procedure ExecQuery; virtual;               // ExecQuery the query.
    procedure ExecuteImmediate;
{$IFDEF SUPPORT_IB2007}
    procedure ExecuteAsBatch; overload;
    procedure ExecuteAsBatch(const SQLs:array of string); overload;
{$ENDIF}    
    procedure FreeHandle;
    function  Next: TFIBXSQLDA;
    procedure Prepare;                  // Prepare the query.

    function FieldByName(const FieldName: string): TFIBXSQLVAR;
    function FindField(const FieldName: string): TFIBXSQLVAR;
    function FN(const FieldName: string): TFIBXSQLVAR;

    function  FieldByOrigin(const TableName,FieldName:string):TFIBXSQLVAR; overload;
    function  SQLFieldName(const aFieldName:string):string;
{$IFDEF SUPPORT_ARRAY_FIELD}
    procedure PrepareArrayFields;
    procedure PrepareArraySqlVar(
      SqlVar:TFIBXSQLVAR;const RelName,aSQLName:string; IsField:boolean
    );
{$ENDIF}
    procedure SetParamValues(const ParamValues: array of Variant); overload;
    procedure SetParamValues(const ParamNames: string;ParamValues: array of Variant); overload;
    procedure ExecWP(const ParamValues: array of Variant); overload;
    procedure ExecWP(const ParamNames: string;ParamValues: array of Variant); overload;
                                           // Exec Query with ParamValues
    procedure ExecWPS(const ParamSources: array of ISQLObject); overload;
    procedure ExecWPS(ParamSource:ISQLObject; AllRecords:boolean=True); overload;

    procedure BeginModifySQLText;
    procedure EndModifySQLText;