fbintf/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;
    FConnectionCodePage: TSystemCodePage;
    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;
    property ConnectionCodePage: TSystemCodePage read FConnectionCodePage;

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