udr/client/FBStatement.pas

(*
 *  Firebird Interface (fbintf). The fbintf components provide a set of
 *  Pascal language bindings for the Firebird API. Although predominantly
 *  a new development they include source code taken from IBX and may be
 *  considered a derived product. This software thus also includes the copyright
 *  notice and license conditions from IBX.
 *
 *  Except for those parts dervied from IBX, contents of this file are subject
 *  to the Initial Developer's Public License Version 1.0 (the "License"); you
 *  may not use this file except in compliance with the License. You may obtain a
 *  copy of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)
unit FBStatement;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$codepage UTF8}
{$interfaces COM}
{$ENDIF}

interface

uses
  Classes, SysUtils,  IB,  FBClientAPI, FBSQLData, FBOutputBlock, FBActivityMonitor,
  FBTransaction;

const
  DefaultBatchRowLimit = 1000;

type
  TPerfStatistics = array[psCurrentMemory..psFetches] of Int64;

  { TFBStatement }

  TFBStatement = class(TActivityReporter,ITransactionUser)
  private
    FAttachmentIntf: IAttachment;
    FFirebirdClientAPI: TFBClientAPI;
  protected
    FTransactionIntf: ITransaction;
    FExecTransactionIntf: ITransaction;
    FStaleReferenceChecks: boolean;
    FSQLStatementType: TIBSQLStatementTypes;         { Select, update, delete, insert, create, alter, etc...}
    FSQLDialect: integer;
    FOpen: boolean;
    FPrepared: boolean;
    FPrepareSeqNo: integer; {used to check for out of date references from interfaces}
    FSQL: AnsiString;
    FProcessedSQL: AnsiString;
    FHasParamNames: boolean;
    FBOF: boolean;
    FEOF: boolean;
    FSingleResults: boolean;
    FGenerateParamNames: boolean;
    FChangeSeqNo: integer;
    FCollectStatistics: boolean;
    FStatisticsAvailable: boolean;
    FBeforeStats: TPerfStatistics;
    FAfterStats: TPerfStatistics;
    FCaseSensitiveParams: boolean;
    FBatchRowLimit: integer;
    procedure CheckChangeBatchRowLimit; virtual;
    procedure CheckHandle; virtual; abstract;
    procedure CheckTransaction(aTransaction: ITransaction);
    procedure DoJournaling(force: boolean);
    function GetJournalIntf: IJournallingHook;
    function GetStatementIntf: IStatement; virtual; abstract;
    procedure GetDsqlInfo(info_request: byte; buffer: ISQLInfoResults); overload; virtual; abstract;
    procedure InternalPrepare(CursorName: AnsiString='');  virtual; abstract;
    function InternalExecute(Transaction: ITransaction): IResults;  virtual; abstract;
    function InternalOpenCursor(aTransaction: ITransaction; Scrollable: boolean): IResultSet;   virtual; abstract;
    procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); virtual; abstract;
    procedure FreeHandle;  virtual; abstract;
    procedure InternalClose(Force: boolean); virtual; abstract;
    function TimeStampToMSecs(const TimeStamp: TTimeStamp): Int64;
  public
    constructor Create(Attachment: IAttachment; Transaction: ITransaction;
      sql: AnsiString; SQLDialect: integer);
    constructor CreateWithParameterNames(Attachment: IAttachment; Transaction: ITransaction;
      sql: AnsiString;  SQLDialect: integer; GenerateParamNames: boolean =false;
      CaseSensitiveParams: boolean = false);
    destructor Destroy; override;
    procedure Close;
    procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
    property SQLDialect: integer read FSQLDialect;
    property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;

  public
    function GetSQLParams: ISQLParams; virtual; abstract;
    function GetMetaData: IMetaData;  virtual; abstract;
    function GetRowsAffected(var SelectCount, InsertCount, UpdateCount,
      DeleteCount: integer): boolean;
    function GetSQLStatementType: TIBSQLStatementTypes;
    function GetSQLStatementTypeName: AnsiString;
    function GetSQLText: AnsiString;
    function GetProcessedSQLText: AnsiString;
    function GetSQLDialect: integer;
    function GetFlags: TStatementFlags; virtual;

    {GetDSQLInfo only supports isc_info_sql_stmt_type, isc_info_sql_get_plan, isc_info_sql_records}
    procedure Prepare(aTransaction: ITransaction=nil);  overload;
    procedure Prepare(CursorName: AnsiString; aTransaction: ITransaction=nil); overload; virtual;
    function Execute(aTransaction: ITransaction=nil): IResults;
    function OpenCursor(aTransaction: ITransaction=nil): IResultSet; overload;
    function OpenCursor(Scrollable: boolean; aTransaction: ITransaction=nil): IResultSet; overload;
    function CreateBlob(paramName: AnsiString): IBlob; overload;
    function CreateBlob(index: integer): IBlob; overload;
    function CreateBlob(column: TColumnMetaData): IBlob; overload; virtual; abstract;
    function CreateArray(paramName: AnsiString): IArray; overload;
    function CreateArray(index: integer): IArray;  overload;
    function CreateArray(column: TColumnMetaData): IArray; overload; virtual; abstract;
    function GetAttachment: IAttachment;
    function GetTransaction: ITransaction;
    function GetDSQLInfo(Request: byte): ISQLInfoResults; overload;
    procedure SetRetainInterfaces(aValue: boolean); virtual;
    procedure EnableStatistics(aValue: boolean);
    function GetPerfStatistics(var stats: TPerfCounters): boolean;
    function IsInBatchMode: boolean; virtual;
    function HasBatchMode: boolean; virtual;
  public
    {IBatch support}
    procedure AddToBatch; virtual;
    function ExecuteBatch(aTransaction: ITransaction): IBatchCompletion; virtual;
    procedure CancelBatch; virtual;
    function GetBatchCompletion: IBatchCompletion; virtual;
    function GetBatchRowLimit: integer;
    procedure SetBatchRowLimit(aLimit: integer);
    {Stale Reference Check}
    procedure SetStaleReferenceChecks(Enable:boolean); {default true}
    function GetStaleReferenceChecks: boolean;
  public
    property ChangeSeqNo: integer read FChangeSeqNo;
    property SQLParams: ISQLParams read GetSQLParams;
    property SQLStatementType: TIBSQLStatementTypes read GetSQLStatementType;
end;

implementation

uses FBMessages;

{ TFBStatement }

procedure TFBStatement.CheckChangeBatchRowLimit;
begin
  //Do Nothing
end;

procedure TFBStatement.CheckTransaction(aTransaction: ITransaction);
begin
  if (aTransaction = nil) then
    IBError(ibxeTransactionNotAssigned,[]);

  if not aTransaction.InTransaction then
    IBError(ibxeNotInTransaction,[]);
end;

procedure TFBStatement.DoJournaling(force: boolean);
  function doGetRowsAffected: integer;
  var a,i,u,d: integer;
  begin
    GetRowsAffected(a,i,u,d);
    Result := i + u + d;
  end;

var RowsAffected: integer;
begin
  RowsAffected := doGetRowsAffected;
  with GetAttachment do
    if JournalingActive and (force or
      (((joReadOnlyQueries in GetJournalOptions) and (RowsAffected = 0)) or
      ((joModifyQueries in GetJournalOptions) and (RowsAffected > 0)))) then
      GetJournalIntf.ExecQuery(GetStatementIntf);
end;

function TFBStatement.GetJournalIntf: IJournallingHook;
begin
  GetAttachment.QueryInterface(IJournallingHook,Result)
end;

function TFBStatement.TimeStampToMSecs(const TimeStamp: TTimeStamp): Int64;
begin
  Result := TimeStamp.Time + Int64(timestamp.date)*msecsperday;
end;

constructor TFBStatement.Create(Attachment: IAttachment;
  Transaction: ITransaction; sql: AnsiString; SQLDialect: integer);
begin
  inherited Create(Transaction as TFBTransaction,2);
  FAttachmentIntf := Attachment;
  FTransactionIntf := Transaction;
  FFirebirdClientAPI := Attachment.getFirebirdAPI as TFBClientAPI;
  FSQLDialect := SQLDialect;
  FSQL := sql;
  FBatchRowLimit := DefaultBatchRowLimit;
  FStaleReferenceChecks := true;
end;

constructor TFBStatement.CreateWithParameterNames(Attachment: IAttachment;
  Transaction: ITransaction; sql: AnsiString; SQLDialect: integer;
  GenerateParamNames: boolean; CaseSensitiveParams: boolean);
begin
  FHasParamNames := true;
  FGenerateParamNames := GenerateParamNames;
  FCaseSensitiveParams := CaseSensitiveParams;
  Create(Attachment,Transaction,sql,SQLDialect);
end;

destructor TFBStatement.Destroy;
begin
  Close;
  FreeHandle;
  inherited Destroy;
end;

procedure TFBStatement.Close;
begin
  InternalClose(false);
end;

procedure TFBStatement.TransactionEnding(aTransaction: ITransaction;
  Force: boolean);
begin
  if FOpen and ((FExecTransactionIntf as TObject) = (aTransaction as TObject)) then
    InternalClose(Force);

  if FTransactionIntf = aTransaction then
  begin
    FreeHandle;
    FPrepared := false;
  end;
end;

function TFBStatement.GetRowsAffected(var SelectCount, InsertCount,
  UpdateCount, DeleteCount: integer): boolean;
var
  RB: ISQLInfoResults;
  i, j: integer;
begin
  InsertCount := 0;
  UpdateCount := 0;
  DeleteCount := 0;
  Result := FPrepared;
  if not Result then Exit;

  RB := GetDsqlInfo(isc_info_sql_records);

  for i := 0 to RB.Count - 1 do
  with RB[i] do
  case getItemType of
  isc_info_sql_records:
    for j := 0 to Count -1 do
    with Items[j] do
    case getItemType of
    isc_info_req_select_count:
      SelectCount := GetAsInteger;
    isc_info_req_insert_count:
      InsertCount := GetAsInteger;
    isc_info_req_update_count:
      UpdateCount := GetAsInteger;
    isc_info_req_delete_count:
      DeleteCount := GetAsInteger;
    end;
  end;
end;

function TFBStatement.GetSQLStatementType: TIBSQLStatementTypes;
begin
  Result := FSQLStatementType;
end;

function TFBStatement.GetSQLStatementTypeName: AnsiString;
begin
  case FSQLStatementType of
  SQLUnknown: Result := 'SQL_Unknown';
  SQLSelect: Result := 'SQL_Select';
  SQLInsert: Result := 'SQL_Insert';
  SQLUpdate: Result := 'SQL_Update';
  SQLDelete: Result := 'SQL_Delete';
  SQLDDL: Result := 'SQL_DDL';
  SQLGetSegment: Result := 'SQL_GetSegment';
  SQLPutSegment: Result := 'SQL_PutSegment';
  SQLExecProcedure: Result := 'SQL_ExecProcedure';
  SQLStartTransaction: Result := 'SQL_StartTransaction';
  SQLCommit: Result := 'SQL_Commit';
  SQLRollback: Result := 'SQL_Rollback';
  SQLSelectForUpdate: Result := 'SQL_SelectForUpdate';
  SQLSetGenerator: Result := 'SQL_SetGenerator';
  SQLSavePoint: Result := 'SQL_SavePoint';
  end;
end;

function TFBStatement.GetSQLText: AnsiString;
begin
  Result := FSQL;
end;

function TFBStatement.GetProcessedSQLText: AnsiString;
begin
  if not FHasParamNames then
    Result := FSQL
  else
  begin
    if FProcessedSQL = '' then
      ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
    Result := FProcessedSQL;
  end;
end;

function TFBStatement.GetSQLDialect: integer;
begin
  Result := FSQLDialect;
end;

function TFBStatement.GetFlags: TStatementFlags;
begin
  Result := [];
end;

procedure TFBStatement.Prepare(aTransaction: ITransaction);
begin
  Prepare('',aTransaction);
end;

procedure TFBStatement.Prepare(CursorName: AnsiString;
  aTransaction: ITransaction);
begin
  if FPrepared then FreeHandle;
  if aTransaction <> nil then
  begin
    RemoveMonitor(FTransactionIntf as TFBTransaction);
    FTransactionIntf := aTransaction;
    AddMonitor(FTransactionIntf as TFBTransaction);
  end;
  InternalPrepare(CursorName);
end;

function TFBStatement.Execute(aTransaction: ITransaction): IResults;
begin
  try
    if aTransaction = nil then
      Result :=  InternalExecute(FTransactionIntf)
    else
      Result := InternalExecute(aTransaction);
  finally
    DoJournaling(ExceptObject <> nil);
  end;
end;

procedure TFBStatement.AddToBatch;
begin
  IBError(ibxeBatchModeNotSupported,[]);
end;

function TFBStatement.ExecuteBatch(aTransaction: ITransaction
  ): IBatchCompletion;
begin
  IBError(ibxeBatchModeNotSupported,[]);
end;

procedure TFBStatement.CancelBatch;
begin
  IBError(ibxeBatchModeNotSupported,[]);
end;

function TFBStatement.GetBatchCompletion: IBatchCompletion;
begin
  IBError(ibxeBatchModeNotSupported,[]);
end;

function TFBStatement.GetBatchRowLimit: integer;
begin
  Result := FBatchRowLimit;
end;

procedure TFBStatement.SetBatchRowLimit(aLimit: integer);
begin
  CheckChangeBatchRowLimit;
  FBatchRowLimit := aLimit;
end;

procedure TFBStatement.SetStaleReferenceChecks(Enable: boolean);
begin
  FStaleReferenceChecks := Enable;
end;

function TFBStatement.GetStaleReferenceChecks: boolean;
begin
  Result := FStaleReferenceChecks;
end;

function TFBStatement.OpenCursor(aTransaction: ITransaction): IResultSet;
begin
  Result := OpenCursor(false,aTransaction);
end;

function TFBStatement.OpenCursor(Scrollable: boolean; aTransaction: ITransaction
  ): IResultSet;
begin
  Close;
  try
    if aTransaction = nil then
      Result := InternalOpenCursor(FTransactionIntf,Scrollable)
    else
      Result := InternalOpenCursor(aTransaction,Scrollable);
  finally
    DoJournaling(ExceptObject <> nil);
  end;
end;

function TFBStatement.CreateBlob(paramName: AnsiString): IBlob;
var column: TColumnMetaData;
begin
  InternalPrepare;
  column := SQLParams.ByName(paramName) as TSQLParam;
  if column = nil then
    IBError(ibxeFieldNotFound,[paramName]);
  Result := CreateBlob(column);
end;

function TFBStatement.CreateBlob(index: integer): IBlob;
begin
  InternalPrepare;
  Result := CreateBlob(SQLParams[index] as TSQLParam);
end;

function TFBStatement.CreateArray(paramName: AnsiString): IArray;
var column: TColumnMetaData;
begin
  InternalPrepare;
  column := SQLParams.ByName(paramName) as TSQLParam;
  if column = nil then
    IBError(ibxeFieldNotFound,[paramName]);
  Result := CreateArray(column);
end;

function TFBStatement.CreateArray(index: integer): IArray;
begin
  InternalPrepare;
  Result := CreateArray(SQLParams[index] as TSQLParam);
end;

function TFBStatement.GetAttachment: IAttachment;
begin
  Result := FAttachmentIntf;
end;

function TFBStatement.GetTransaction: ITransaction;
begin
  Result := FTransactionIntf
end;

function TFBStatement.GetDSQLInfo(Request: byte): ISQLInfoResults;
begin
  Result := TSQLInfoResultsBuffer.Create(FFirebirdClientAPI);
  GetDsqlInfo(Request,Result);
end;

procedure TFBStatement.SetRetainInterfaces(aValue: boolean);
begin
  RetainInterfaces := aValue;
end;

procedure TFBStatement.EnableStatistics(aValue: boolean);
begin
  if FCollectStatistics <> aValue then
  begin
    FCollectStatistics := aValue;
    FStatisticsAvailable := false;
  end;
end;

function TFBStatement.GetPerfStatistics(var stats: TPerfCounters): boolean;
begin
  Result := FStatisticsAvailable;
  if Result then
  begin
    stats[psCurrentMemory] := FAfterStats[psCurrentMemory];
    stats[psDeltaMemory] := FAfterStats[psCurrentMemory] - FBeforeStats[psCurrentMemory];
    stats[psMaxMemory] := FAfterStats[psMaxMemory];
    stats[psRealTime] :=  FAfterStats[psRealTime] - FBeforeStats[psRealTime];
    stats[psUserTime] :=  FAfterStats[psUserTime] - FBeforeStats[psUserTime];
    stats[psReads] := FAfterStats[psReads] - FBeforeStats[psReads];
    stats[psWrites] := FAfterStats[psWrites] - FBeforeStats[psWrites];
    stats[psFetches] := FAfterStats[psFetches] - FBeforeStats[psFetches];
    stats[psBuffers] :=  FAfterStats[psBuffers];
  end;
end;

function TFBStatement.IsInBatchMode: boolean;
begin
  Result := false;
end;

function TFBStatement.HasBatchMode: boolean;
begin
  Result := false;
end;

end.

Revision:	392
Committed:	Wed Feb 9 16:17:50 2022 UTC (2 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	15722 byte(s)
Log Message:	cloneAttachment and GetServiceManager added
#	User	Rev	Content
1	tony	45	(*
2			* Firebird Interface (fbintf). The fbintf components provide a set of
3			* Pascal language bindings for the Firebird API. Although predominantly
4			* a new development they include source code taken from IBX and may be
5			* considered a derived product. This software thus also includes the copyright
6			* notice and license conditions from IBX.
7			*
8			* Except for those parts dervied from IBX, contents of this file are subject
9			* to the Initial Developer's Public License Version 1.0 (the "License"); you
10			* may not use this file except in compliance with the License. You may obtain a
11			* copy of the License here:
12			*
13			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
14			*
15			* Software distributed under the License is distributed on an "AS
16			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
17			* implied. See the License for the specific language governing rights
18			* and limitations under the License.
19			*
20			* The Initial Developer of the Original Code is Tony Whyman.
21			*
22			* The Original Code is (C) 2016 Tony Whyman, MWA Software
23			* (http://www.mwasoftware.co.uk).
24			*
25			* All Rights Reserved.
26			*
27			* Contributor(s): ______________________________________.
28			*
29			*)
30			unit FBStatement;
31	tony	56	{$IFDEF MSWINDOWS}
32			{$DEFINE WINDOWS}
33			{$ENDIF}
34	tony	45
35			{$IFDEF FPC}
36	tony	56	{$mode delphi}
37	tony	45	{$codepage UTF8}
38			{$interfaces COM}
39			{$ENDIF}
40
41			interface
42
43			uses
44			Classes, SysUtils, IB, FBClientAPI, FBSQLData, FBOutputBlock, FBActivityMonitor,
45			FBTransaction;
46
47	tony	345	const
48			DefaultBatchRowLimit = 1000;
49
50	tony	45	type
51	tony	209	TPerfStatistics = array[psCurrentMemory..psFetches] of Int64;
52	tony	45
53			{ TFBStatement }
54
55	tony	315	TFBStatement = class(TActivityReporter,ITransactionUser)
56	tony	45	private
57			FAttachmentIntf: IAttachment;
58	tony	263	FFirebirdClientAPI: TFBClientAPI;
59	tony	45	protected
60			FTransactionIntf: ITransaction;
61			FExecTransactionIntf: ITransaction;
62	tony	347	FStaleReferenceChecks: boolean;
63	tony	45	FSQLStatementType: TIBSQLStatementTypes; { Select, update, delete, insert, create, alter, etc...}
64			FSQLDialect: integer;
65			FOpen: boolean;
66			FPrepared: boolean;
67			FPrepareSeqNo: integer; {used to check for out of date references from interfaces}
68	tony	56	FSQL: AnsiString;
69			FProcessedSQL: AnsiString;
70	tony	45	FHasParamNames: boolean;
71			FBOF: boolean;
72			FEOF: boolean;
73			FSingleResults: boolean;
74			FGenerateParamNames: boolean;
75			FChangeSeqNo: integer;
76	tony	47	FCollectStatistics: boolean;
77			FStatisticsAvailable: boolean;
78			FBeforeStats: TPerfStatistics;
79			FAfterStats: TPerfStatistics;
80	tony	270	FCaseSensitiveParams: boolean;
81	tony	345	FBatchRowLimit: integer;
82			procedure CheckChangeBatchRowLimit; virtual;
83	tony	45	procedure CheckHandle; virtual; abstract;
84			procedure CheckTransaction(aTransaction: ITransaction);
85	tony	392	procedure DoJournaling(force: boolean);
86	tony	363	function GetJournalIntf: IJournallingHook;
87			function GetStatementIntf: IStatement; virtual; abstract;
88	tony	45	procedure GetDsqlInfo(info_request: byte; buffer: ISQLInfoResults); overload; virtual; abstract;
89	tony	350	procedure InternalPrepare(CursorName: AnsiString=''); virtual; abstract;
90	tony	345	function InternalExecute(Transaction: ITransaction): IResults; virtual; abstract;
91	tony	350	function InternalOpenCursor(aTransaction: ITransaction; Scrollable: boolean): IResultSet; virtual; abstract;
92	tony	263	procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); virtual; abstract;
93	tony	45	procedure FreeHandle; virtual; abstract;
94			procedure InternalClose(Force: boolean); virtual; abstract;
95	tony	209	function TimeStampToMSecs(const TimeStamp: TTimeStamp): Int64;
96	tony	45	public
97			constructor Create(Attachment: IAttachment; Transaction: ITransaction;
98	tony	56	sql: AnsiString; SQLDialect: integer);
99	tony	45	constructor CreateWithParameterNames(Attachment: IAttachment; Transaction: ITransaction;
100	tony	270	sql: AnsiString; SQLDialect: integer; GenerateParamNames: boolean =false;
101			CaseSensitiveParams: boolean = false);
102	tony	45	destructor Destroy; override;
103			procedure Close;
104			procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
105			property SQLDialect: integer read FSQLDialect;
106	tony	263	property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
107	tony	45
108			public
109			function GetSQLParams: ISQLParams; virtual; abstract;
110			function GetMetaData: IMetaData; virtual; abstract;
111			function GetRowsAffected(var SelectCount, InsertCount, UpdateCount,
112			DeleteCount: integer): boolean;
113			function GetSQLStatementType: TIBSQLStatementTypes;
114	tony	345	function GetSQLStatementTypeName: AnsiString;
115	tony	56	function GetSQLText: AnsiString;
116	tony	263	function GetProcessedSQLText: AnsiString;
117	tony	45	function GetSQLDialect: integer;
118	tony	359	function GetFlags: TStatementFlags; virtual;
119	tony	45
120			{GetDSQLInfo only supports isc_info_sql_stmt_type, isc_info_sql_get_plan, isc_info_sql_records}
121	tony	350	procedure Prepare(aTransaction: ITransaction=nil); overload;
122			procedure Prepare(CursorName: AnsiString; aTransaction: ITransaction=nil); overload; virtual;
123	tony	45	function Execute(aTransaction: ITransaction=nil): IResults;
124	tony	350	function OpenCursor(aTransaction: ITransaction=nil): IResultSet; overload;
125			function OpenCursor(Scrollable: boolean; aTransaction: ITransaction=nil): IResultSet; overload;
126	tony	56	function CreateBlob(paramName: AnsiString): IBlob; overload;
127	tony	45	function CreateBlob(index: integer): IBlob; overload;
128			function CreateBlob(column: TColumnMetaData): IBlob; overload; virtual; abstract;
129	tony	56	function CreateArray(paramName: AnsiString): IArray; overload;
130	tony	45	function CreateArray(index: integer): IArray; overload;
131			function CreateArray(column: TColumnMetaData): IArray; overload; virtual; abstract;
132			function GetAttachment: IAttachment;
133			function GetTransaction: ITransaction;
134			function GetDSQLInfo(Request: byte): ISQLInfoResults; overload;
135			procedure SetRetainInterfaces(aValue: boolean); virtual;
136	tony	47	procedure EnableStatistics(aValue: boolean);
137			function GetPerfStatistics(var stats: TPerfCounters): boolean;
138	tony	345	function IsInBatchMode: boolean; virtual;
139			function HasBatchMode: boolean; virtual;
140			public
141			{IBatch support}
142			procedure AddToBatch; virtual;
143			function ExecuteBatch(aTransaction: ITransaction): IBatchCompletion; virtual;
144			procedure CancelBatch; virtual;
145			function GetBatchCompletion: IBatchCompletion; virtual;
146			function GetBatchRowLimit: integer;
147			procedure SetBatchRowLimit(aLimit: integer);
148	tony	347	{Stale Reference Check}
149			procedure SetStaleReferenceChecks(Enable:boolean); {default true}
150			function GetStaleReferenceChecks: boolean;
151	tony	345	public
152	tony	45	property ChangeSeqNo: integer read FChangeSeqNo;
153			property SQLParams: ISQLParams read GetSQLParams;
154			property SQLStatementType: TIBSQLStatementTypes read GetSQLStatementType;
155			end;
156
157			implementation
158
159			uses FBMessages;
160
161			{ TFBStatement }
162
163	tony	345	procedure TFBStatement.CheckChangeBatchRowLimit;
164			begin
165			//Do Nothing
166			end;
167
168	tony	45	procedure TFBStatement.CheckTransaction(aTransaction: ITransaction);
169			begin
170			if (aTransaction = nil) then
171			IBError(ibxeTransactionNotAssigned,[]);
172
173			if not aTransaction.InTransaction then
174			IBError(ibxeNotInTransaction,[]);
175			end;
176
177	tony	392	procedure TFBStatement.DoJournaling(force: boolean);
178	tony	363	function doGetRowsAffected: integer;
179			var a,i,u,d: integer;
180			begin
181			GetRowsAffected(a,i,u,d);
182			Result := i + u + d;
183			end;
184
185			var RowsAffected: integer;
186			begin
187			RowsAffected := doGetRowsAffected;
188			with GetAttachment do
189	tony	392	if JournalingActive and (force or
190	tony	363	(((joReadOnlyQueries in GetJournalOptions) and (RowsAffected = 0)) or
191	tony	392	((joModifyQueries in GetJournalOptions) and (RowsAffected > 0)))) then
192	tony	363	GetJournalIntf.ExecQuery(GetStatementIntf);
193			end;
194
195			function TFBStatement.GetJournalIntf: IJournallingHook;
196			begin
197			GetAttachment.QueryInterface(IJournallingHook,Result)
198			end;
199
200	tony	209	function TFBStatement.TimeStampToMSecs(const TimeStamp: TTimeStamp): Int64;
201			begin
202			Result := TimeStamp.Time + Int64(timestamp.date)*msecsperday;
203			end;
204
205	tony	45	constructor TFBStatement.Create(Attachment: IAttachment;
206	tony	56	Transaction: ITransaction; sql: AnsiString; SQLDialect: integer);
207	tony	45	begin
208			inherited Create(Transaction as TFBTransaction,2);
209			FAttachmentIntf := Attachment;
210			FTransactionIntf := Transaction;
211	tony	263	FFirebirdClientAPI := Attachment.getFirebirdAPI as TFBClientAPI;
212	tony	45	FSQLDialect := SQLDialect;
213			FSQL := sql;
214	tony	345	FBatchRowLimit := DefaultBatchRowLimit;
215	tony	347	FStaleReferenceChecks := true;
216	tony	45	end;
217
218			constructor TFBStatement.CreateWithParameterNames(Attachment: IAttachment;
219	tony	56	Transaction: ITransaction; sql: AnsiString; SQLDialect: integer;
220	tony	270	GenerateParamNames: boolean; CaseSensitiveParams: boolean);
221	tony	45	begin
222			FHasParamNames := true;
223			FGenerateParamNames := GenerateParamNames;
224	tony	270	FCaseSensitiveParams := CaseSensitiveParams;
225	tony	45	Create(Attachment,Transaction,sql,SQLDialect);
226			end;
227
228			destructor TFBStatement.Destroy;
229			begin
230			Close;
231			FreeHandle;
232			inherited Destroy;
233			end;
234
235			procedure TFBStatement.Close;
236			begin
237			InternalClose(false);
238			end;
239
240			procedure TFBStatement.TransactionEnding(aTransaction: ITransaction;
241			Force: boolean);
242			begin
243	tony	315	if FOpen and ((FExecTransactionIntf as TObject) = (aTransaction as TObject)) then
244	tony	45	InternalClose(Force);
245
246			if FTransactionIntf = aTransaction then
247			begin
248			FreeHandle;
249			FPrepared := false;
250			end;
251			end;
252
253			function TFBStatement.GetRowsAffected(var SelectCount, InsertCount,
254			UpdateCount, DeleteCount: integer): boolean;
255			var
256			RB: ISQLInfoResults;
257			i, j: integer;
258			begin
259			InsertCount := 0;
260			UpdateCount := 0;
261			DeleteCount := 0;
262			Result := FPrepared;
263			if not Result then Exit;
264
265			RB := GetDsqlInfo(isc_info_sql_records);
266
267			for i := 0 to RB.Count - 1 do
268			with RB[i] do
269			case getItemType of
270			isc_info_sql_records:
271			for j := 0 to Count -1 do
272			with Items[j] do
273			case getItemType of
274			isc_info_req_select_count:
275			SelectCount := GetAsInteger;
276			isc_info_req_insert_count:
277			InsertCount := GetAsInteger;
278			isc_info_req_update_count:
279			UpdateCount := GetAsInteger;
280			isc_info_req_delete_count:
281			DeleteCount := GetAsInteger;
282			end;
283			end;
284			end;
285
286			function TFBStatement.GetSQLStatementType: TIBSQLStatementTypes;
287			begin
288			Result := FSQLStatementType;
289			end;
290
291	tony	345	function TFBStatement.GetSQLStatementTypeName: AnsiString;
292			begin
293			case FSQLStatementType of
294			SQLUnknown: Result := 'SQL_Unknown';
295			SQLSelect: Result := 'SQL_Select';
296			SQLInsert: Result := 'SQL_Insert';
297			SQLUpdate: Result := 'SQL_Update';
298			SQLDelete: Result := 'SQL_Delete';
299			SQLDDL: Result := 'SQL_DDL';
300			SQLGetSegment: Result := 'SQL_GetSegment';
301			SQLPutSegment: Result := 'SQL_PutSegment';
302			SQLExecProcedure: Result := 'SQL_ExecProcedure';
303			SQLStartTransaction: Result := 'SQL_StartTransaction';
304			SQLCommit: Result := 'SQL_Commit';
305			SQLRollback: Result := 'SQL_Rollback';
306			SQLSelectForUpdate: Result := 'SQL_SelectForUpdate';
307			SQLSetGenerator: Result := 'SQL_SetGenerator';
308			SQLSavePoint: Result := 'SQL_SavePoint';
309			end;
310			end;
311
312	tony	56	function TFBStatement.GetSQLText: AnsiString;
313	tony	45	begin
314			Result := FSQL;
315			end;
316
317	tony	263	function TFBStatement.GetProcessedSQLText: AnsiString;
318			begin
319	tony	359	if not FHasParamNames then
320			Result := FSQL
321			else
322			begin
323			if FProcessedSQL = '' then
324			ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
325			Result := FProcessedSQL;
326			end;
327	tony	263	end;
328
329	tony	45	function TFBStatement.GetSQLDialect: integer;
330			begin
331			Result := FSQLDialect;
332			end;
333
334	tony	359	function TFBStatement.GetFlags: TStatementFlags;
335			begin
336			Result := [];
337			end;
338
339	tony	45	procedure TFBStatement.Prepare(aTransaction: ITransaction);
340			begin
341	tony	350	Prepare('',aTransaction);
342			end;
343
344			procedure TFBStatement.Prepare(CursorName: AnsiString;
345			aTransaction: ITransaction);
346			begin
347	tony	45	if FPrepared then FreeHandle;
348			if aTransaction <> nil then
349			begin
350			RemoveMonitor(FTransactionIntf as TFBTransaction);
351			FTransactionIntf := aTransaction;
352			AddMonitor(FTransactionIntf as TFBTransaction);
353			end;
354	tony	350	InternalPrepare(CursorName);
355	tony	45	end;
356
357			function TFBStatement.Execute(aTransaction: ITransaction): IResults;
358			begin
359	tony	392	try
360			if aTransaction = nil then
361			Result := InternalExecute(FTransactionIntf)
362			else
363			Result := InternalExecute(aTransaction);
364			finally
365			DoJournaling(ExceptObject <> nil);
366			end;
367	tony	45	end;
368
369	tony	345	procedure TFBStatement.AddToBatch;
370			begin
371			IBError(ibxeBatchModeNotSupported,[]);
372			end;
373
374			function TFBStatement.ExecuteBatch(aTransaction: ITransaction
375			): IBatchCompletion;
376			begin
377			IBError(ibxeBatchModeNotSupported,[]);
378			end;
379
380			procedure TFBStatement.CancelBatch;
381			begin
382			IBError(ibxeBatchModeNotSupported,[]);
383			end;
384
385			function TFBStatement.GetBatchCompletion: IBatchCompletion;
386			begin
387			IBError(ibxeBatchModeNotSupported,[]);
388			end;
389
390			function TFBStatement.GetBatchRowLimit: integer;
391			begin
392			Result := FBatchRowLimit;
393			end;
394
395			procedure TFBStatement.SetBatchRowLimit(aLimit: integer);
396			begin
397			CheckChangeBatchRowLimit;
398			FBatchRowLimit := aLimit;
399			end;
400
401	tony	347	procedure TFBStatement.SetStaleReferenceChecks(Enable: boolean);
402			begin
403			FStaleReferenceChecks := Enable;
404			end;
405
406			function TFBStatement.GetStaleReferenceChecks: boolean;
407			begin
408			Result := FStaleReferenceChecks;
409			end;
410
411	tony	45	function TFBStatement.OpenCursor(aTransaction: ITransaction): IResultSet;
412			begin
413	tony	350	Result := OpenCursor(false,aTransaction);
414			end;
415
416			function TFBStatement.OpenCursor(Scrollable: boolean; aTransaction: ITransaction
417			): IResultSet;
418			begin
419	tony	45	Close;
420	tony	392	try
421			if aTransaction = nil then
422			Result := InternalOpenCursor(FTransactionIntf,Scrollable)
423			else
424			Result := InternalOpenCursor(aTransaction,Scrollable);
425			finally
426			DoJournaling(ExceptObject <> nil);
427			end;
428	tony	45	end;
429
430	tony	56	function TFBStatement.CreateBlob(paramName: AnsiString): IBlob;
431	tony	45	var column: TColumnMetaData;
432			begin
433			InternalPrepare;
434			column := SQLParams.ByName(paramName) as TSQLParam;
435			if column = nil then
436			IBError(ibxeFieldNotFound,[paramName]);
437			Result := CreateBlob(column);
438			end;
439
440			function TFBStatement.CreateBlob(index: integer): IBlob;
441			begin
442			InternalPrepare;
443			Result := CreateBlob(SQLParams[index] as TSQLParam);
444			end;
445
446	tony	56	function TFBStatement.CreateArray(paramName: AnsiString): IArray;
447	tony	45	var column: TColumnMetaData;
448			begin
449			InternalPrepare;
450			column := SQLParams.ByName(paramName) as TSQLParam;
451			if column = nil then
452			IBError(ibxeFieldNotFound,[paramName]);
453			Result := CreateArray(column);
454			end;
455
456			function TFBStatement.CreateArray(index: integer): IArray;
457			begin
458			InternalPrepare;
459			Result := CreateArray(SQLParams[index] as TSQLParam);
460			end;
461
462			function TFBStatement.GetAttachment: IAttachment;
463			begin
464			Result := FAttachmentIntf;
465			end;
466
467			function TFBStatement.GetTransaction: ITransaction;
468			begin
469			Result := FTransactionIntf
470			end;
471
472			function TFBStatement.GetDSQLInfo(Request: byte): ISQLInfoResults;
473			begin
474	tony	263	Result := TSQLInfoResultsBuffer.Create(FFirebirdClientAPI);
475	tony	45	GetDsqlInfo(Request,Result);
476			end;
477
478			procedure TFBStatement.SetRetainInterfaces(aValue: boolean);
479			begin
480			RetainInterfaces := aValue;
481			end;
482
483	tony	47	procedure TFBStatement.EnableStatistics(aValue: boolean);
484			begin
485			if FCollectStatistics <> aValue then
486			begin
487			FCollectStatistics := aValue;
488			FStatisticsAvailable := false;
489			end;
490			end;
491
492			function TFBStatement.GetPerfStatistics(var stats: TPerfCounters): boolean;
493			begin
494			Result := FStatisticsAvailable;
495			if Result then
496			begin
497			stats[psCurrentMemory] := FAfterStats[psCurrentMemory];
498			stats[psDeltaMemory] := FAfterStats[psCurrentMemory] - FBeforeStats[psCurrentMemory];
499			stats[psMaxMemory] := FAfterStats[psMaxMemory];
500			stats[psRealTime] := FAfterStats[psRealTime] - FBeforeStats[psRealTime];
501			stats[psUserTime] := FAfterStats[psUserTime] - FBeforeStats[psUserTime];
502			stats[psReads] := FAfterStats[psReads] - FBeforeStats[psReads];
503			stats[psWrites] := FAfterStats[psWrites] - FBeforeStats[psWrites];
504			stats[psFetches] := FAfterStats[psFetches] - FBeforeStats[psFetches];
505			stats[psBuffers] := FAfterStats[psBuffers];
506			end;
507			end;
508
509	tony	345	function TFBStatement.IsInBatchMode: boolean;
510			begin
511			Result := false;
512			end;
513
514			function TFBStatement.HasBatchMode: boolean;
515			begin
516			Result := false;
517			end;
518
519	tony	45	end.
520