fibquery.pas

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

    function  CountModifySQLText:integer;
    function  GetMainWhereIndex:integer;
    function  GetMainWhereClause :string;
    procedure SetMainWhereClause (const Value:string);
    function  IsProc :boolean;
    function  ParamByName(const ParamName:string): TFIBXSQLVAR;
    function  FindParam  (const aParamName: string): TFIBXSQLVAR;
    procedure ApplyMacro;
    procedure RestoreMacroDefaultValues;
    function FieldCount:integer;
    function SQLDescribeInfo(InfoRequest:array of char):PXSQLDA;
    property Bof: Boolean read FBOF;
    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
    property Eof: Boolean read GetEOF;
    property FldByName[const FieldName: string]: TFIBXSQLVAR read FieldByName;  default;
    property Fields[const Idx: Integer]: TFIBXSQLVAR read GetFields;
    property FieldIndex[const FieldName: string]: Integer read GetFieldIndex;
    property Open: Boolean read FOpen;
    property Params: TFIBXSQLDA read GetSQLParams;
    property Plan: string read GetPlan;
    property Prepared: Boolean read FPrepared;
    property RecordCount: Integer read GetRecordCount;
    property RowsAffected: Integer read GetRowsAffected;
    property AllRowsAffected: TAllRowsAffected read GetAllRowsAffected;
    property SQLType: TFIBSQLTypes read FSQLType;
    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
    property ProcExecuted:boolean read FProcExecuted write FProcExecuted;
    property OnSQLFetch:TOnSQLFetch read FOnSQLFetch write FOnSQLFetch; // for internal use
    property OnlySrvParams:TStringList read FOnlySrvParams;
  protected
    FConditions:TConditions;
    procedure SetConditions(Value:TConditions);
  published
    property  Conditions: TConditions read FConditions write SetConditions;
  public
{ISQLObject}
    function  ParamCount:integer;
    function  ParamName(ParamIndex:integer):string;
    function  FieldName(FieldIndex:integer):string;
    function  FieldsCount:integer;
    function  FieldExist(const FieldName:string; var FieldIndex:integer):boolean;
    function  ParamExist(const ParamName:string; var ParamIndex:integer):boolean;
    function  FieldValue(const FieldName:string;Old:boolean):variant;   overload;
    function  FieldValue(const FieldIndex:integer;Old:boolean):variant; overload;
    function  ParamValue(const ParamName:string):variant;   overload;
    function  ParamValue(const ParamIndex:integer):variant; overload;
    procedure SetParamValue(const ParamIndex:integer; aValue:Variant);
    function  IEof:boolean;
    procedure INext;

{End ISQLObject}



    function  ReadySQLText(ForChangeExecSQL:boolean=True):string;
    property  SQLTextChangeCount:integer read FSQLTextChangeCount;
  private
    procedure SetPlanClause(const Value:string);
    function  GetPlanClause:string;
  public

    procedure AssignProperties(Source: TFIBQuery);
    function  WhereClausesCount:integer;
    property  WhereClause[Index:integer]:string read GetWhereClause write SetWhereClause;
    property  MainWhereClause:string read GetMainWhereClause write SetMainWhereClause;
    property  IndexMainWhere:integer read GetMainWhereIndex;
    property  CursorName   :string read FCursorName write FCursorName;
    property  OrderClause:string read GetOrderString write SetOrderString;
    property  GroupByClause:string read GetGroupByString  write SetGroupByString;
    property  FieldsClause:string read GetFieldsClause  write SetFieldsClause;
    property  PlanClause:string read GetPlanClause write SetPlanClause;
    property  ModifyTable:string read GetModifyTable;
    property  CallTime :Cardinal read FCallTime;
    property  MacroChanged:boolean read  FMacroChanged;
    property  SQLKind:TSQLKind read GetSQLKind;
    property BeforeExecute:TNotifyEvent read FBeforeExecute write FBeforeExecute;
    property AfterExecute :TNotifyEvent read FAfterExecute  write FAfterExecute;

  published
    property Transaction: TFIBTransaction read GetTransaction write SetTransaction;
    property Database: TFIBDatabase read GetDatabase write SetDatabase    ;

    property GoToFirstRecordOnExecute: Boolean read FGoToFirstRecordOnExecute
                                               write FGoToFirstRecordOnExecute
                                               default True;
    property ParamCheck: Boolean read FParamCheck write SetParamCheck default True;
    property SQL: TStrings read FSQL write SetSQL;


    property OnSQLChanging: TNotifyEvent      read FOnSQLChanging write FOnSQLChanging;
    property Options      : TpFIBQueryOptions read FOptions write FOptions stored False;
    property OnBatching   : TOnBatching       read FOnBatching write FOnBatching ;
    property OnBatchError :TOnBatchError      read FOnBatchError write FOnBatchError;
    property TransactionEnding:TNotifyEvent   read FTransactionEnding write FTransactionEnding;
    property TransactionEnded :TNotifyEvent   read FTransactionEnded  write FTransactionEnded;
{$IFDEF CSMonitor}
    property CSMonitorSupport: TCSMonitorSupport read FCSMonitorSupport write SetMonitorSupport;
{$ENDIF}    

  end;


procedure BlobToStream (ModelVar:TFIBXSQLVAR; BlobID:TISC_QUAD;Stream: TStream);

const
   ExecProcPrefix ='EXECUTE ';
  //Statistic consts
   scPrepareCount   ='PrepareCount'  ;  
   scExecuteCount   ='ExecuteCount'  ;
   scSumTimeExecute ='SumTimeExecute';
   scAvgTimeExecute ='AvgTimeExecute';
   scMaxTimeExecute ='MaxTimeExecute';
   scLastTimeExecute='LastTimeExecute';
   scLastQuery      ='LastQueryName';


   fibGUID_NULL: TGUID = '{00000000-0000-0000-0000-000000000000}';
   chUnicodeFSS=3;

{$IFDEF SUPPORT_KOI8_CHARSET}
   chFBKOI8R=63;
   chFBKOI8U=64;
   CodePageKOI8R=20866;
   CodePageKOI8RU=21866;
{$ENDIF}


implementation

uses
  FIBMiscellaneous,  StrUtil,
  IBBlobFilter, FIBConsts,FIBCloneComponents 
  //Added uses
{$IFNDEF NO_MONITOR}
  ,FIBSQLMonitor
{$ENDIF}
{$IFDEF CSMonitor}
 ,FIBDataSet,pFIBDataSet
{$ENDIF}
  ;

const
 cPlanMaxLength=16384;


(* TFIBXSQLVAR *)
constructor TFIBXSQLVAR.Create(AParent: TFIBXSQLDA);
begin
  FParent := AParent;
  FVariantFalse := 0;
  FVariantTrue  := 1;
  FModified:=False;
  FIsMacro      :=False;
  FQuoted       :=False;
  FOldValue     :=Unassigned;
  FInWhereClause:=False;
  FInitialized  :=False;
  FCanForceIsNull:=False;
 {$IFDEF SUPPORT_ARRAY_FIELD}
  vFIBArray   :=nil;
 {$ENDIF}
end;

destructor TFIBXSQLVAR.Destroy; //override;
begin
 {$IFDEF SUPPORT_ARRAY_FIELD}
 if Assigned(vFIBArray) then vFIBArray.Free;
 {$ENDIF}
 inherited Destroy;
 FreeAndNil(FStreamValue);
end;

{$WARNINGS OFF}
function TFIBXSQLVAR.AdjustScale(Value: Int64; Scale: Integer): Double;
begin
 Result := Value*E10[Scale];
end;


function TFIBXSQLVAR.AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
begin
 try
  Result := Value * E10[Scale];
 except
  Result := 0;
 end;
end;


function TFIBXSQLVAR.AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
begin
  if Scale = 0 then
   Result := Value
  else
   Result := Value div Trunc(E10[-Scale])
end;
{$WARNINGS ON}

procedure TFIBXSQLVAR.Assign(Source: TFIBXSQLVAR);
var
  szBuff: PChar;
  s_bhandle, d_bhandle: TISC_BLOB_HANDLE;
  bSourceBlob, bDestBlob: Boolean;
  iSegs, iMaxSeg, iSize: Long;
  iBlobType: Short;
  SP:TFIBXSQLVAR;
  DestSQLType,SrcSQLType:integer;
begin
  szBuff := nil;
  SrcSQLType :=Source.FXSQLVAR^.sqltype and (not 1);
  DestSQLType:=FXSQLVAR^.sqltype and (not 1) ;
  bSourceBlob:=SrcSQLType=SQL_BLOB;
  bDestBlob  :=True;
  s_bhandle  :=nil;
  d_bhandle  :=nil;
  try
    if (Source.IsNull) then
    begin
      IsNull := True;
      Exit;
    end
    else
    if (DestSQLType = SQL_ARRAY) or   (SrcSQLType = SQL_ARRAY) then  Exit;
     // arrays not supported.

    if (DestSQLType <> SQL_BLOB) and not bSourceBlob then
    begin
      AsXSQLVAR := Source.AsXSQLVAR;
      Exit;
    end
    else
    if (SrcSQLType <> SQL_BLOB) then
    begin
      szBuff := nil;
      FIBAlloc(szBuff, 0, Source.FXSQLVAR^.sqllen);
      Move(Source.FXSQLVAR^.sqldata[0], szBuff[0], Source.FXSQLVAR^.sqllen);
      iSize := Source.FXSQLVAR^.sqllen;
    end
    else
    if (DestSQLType <> SQL_BLOB) then
    begin
     if FParent=FQuery.FUserSQLParams then
     begin
      if not FQuery.Prepared then FQuery.Prepare;
      SP:=FQuery.FSQLParams.FindParam(Name);
      bDestBlob := not (
       (SP=nil) or (SP.FXSQLVAR^.sqltype and (not 1) <> SQL_BLOB)
      );
      if bDestBlob then AsQuad:=SP.AsQuad;
     end
     else
      bDestBlob := False;
    end;
    if bSourceBlob then
    begin
      // read the blob
      Source.FQuery.Call(
        Source.FQuery.Database.ClientLibrary.isc_open_blob2(StatusVector, Source.FQuery.DBHandle,
        Source.FQuery.TRHandle, @s_bhandle, PISC_QUAD(Source.FXSQLVAR.sqldata),
        0, nil), True
      );
      with Source.FQuery,Source.FQuery.Database do
      try
        GetBlobInfo(ClientLibrary,@s_bhandle,iSegs, iMaxSeg, iSize,iBlobType);
        szBuff := nil;
        FIBAlloc(szBuff, 0, iSize);
        ReadBlob(ClientLibrary,@s_bhandle, szBuff, iSize);
        if (not bDestBlob)  // 桤徨汔屐 腓