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 FPC}
{$mode objfpc}{$H+}
{$codepage UTF8}
{$interfaces COM}
{$ENDIF}

interface

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

type

  { TFBStatement }

  TFBStatement = class(TActivityReporter)
  private
    FAttachmentIntf: IAttachment;
  protected
    FTransactionIntf: ITransaction;
    FExecTransactionIntf: ITransaction;
    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: string;
    FProcessedSQL: string;
    FHasParamNames: boolean;
    FBOF: boolean;
    FEOF: boolean;
    FSingleResults: boolean;
    FGenerateParamNames: boolean;
    FChangeSeqNo: integer;
    procedure CheckHandle; virtual; abstract;
    procedure CheckTransaction(aTransaction: ITransaction);
    procedure GetDsqlInfo(info_request: byte; buffer: ISQLInfoResults); overload; virtual; abstract;
    procedure InternalPrepare;  virtual; abstract;
    function InternalExecute(aTransaction: ITransaction): IResults;  virtual; abstract;
    function InternalOpenCursor(aTransaction: ITransaction): IResultSet;   virtual; abstract;
    procedure FreeHandle;  virtual; abstract;
    procedure InternalClose(Force: boolean); virtual; abstract;
  public
    constructor Create(Attachment: IAttachment; Transaction: ITransaction;
      sql: string; SQLDialect: integer);
    constructor CreateWithParameterNames(Attachment: IAttachment; Transaction: ITransaction;
      sql: string;  SQLDialect: integer; GenerateParamNames: boolean =false);
    destructor Destroy; override;
    procedure Close;
    procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
    property SQLDialect: integer read FSQLDialect;

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

    {GetDSQLInfo only supports isc_info_sql_stmt_type, isc_info_sql_get_plan, isc_info_sql_records}
    procedure Prepare(aTransaction: ITransaction=nil); virtual;
    function Execute(aTransaction: ITransaction=nil): IResults;
    function OpenCursor(aTransaction: ITransaction=nil): IResultSet;
    function CreateBlob(paramName: string): IBlob; overload;
    function CreateBlob(index: integer): IBlob; overload;
    function CreateBlob(column: TColumnMetaData): IBlob; overload; virtual; abstract;
    function CreateArray(paramName: string): 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;
    property ChangeSeqNo: integer read FChangeSeqNo;
    property SQLParams: ISQLParams read GetSQLParams;
    property SQLStatementType: TIBSQLStatementTypes read GetSQLStatementType;
end;

implementation

uses FBMessages;

{ TFBStatement }

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

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

constructor TFBStatement.Create(Attachment: IAttachment;
  Transaction: ITransaction; sql: string; SQLDialect: integer);
begin
  inherited Create(Transaction as TFBTransaction,2);
  FAttachmentIntf := Attachment;
  FTransactionIntf := Transaction;
  FSQLDialect := SQLDialect;
  FSQL := sql;
end;

constructor TFBStatement.CreateWithParameterNames(Attachment: IAttachment;
  Transaction: ITransaction; sql: string; SQLDialect: integer;
  GenerateParamNames: boolean);
begin
  FHasParamNames := true;
  FGenerateParamNames := GenerateParamNames;
  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 = aTransaction) 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.GetSQLText: string;
begin
  Result := FSQL;
end;

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

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

function TFBStatement.Execute(aTransaction: ITransaction): IResults;
begin
  if aTransaction = nil then
    Result :=  InternalExecute(FTransactionIntf)
  else
    Result := InternalExecute(aTransaction);
end;

function TFBStatement.OpenCursor(aTransaction: ITransaction): IResultSet;
begin
  Close;
  if aTransaction = nil then
    Result := InternalOpenCursor(FTransactionIntf)
  else
    Result := InternalOpenCursor(aTransaction);
end;

function TFBStatement.CreateBlob(paramName: string): 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: string): 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;
  GetDsqlInfo(Request,Result);
end;

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

end.

Revision:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (7 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	8982 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	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
32			{$IFDEF FPC}
33			{$mode objfpc}{$H+}
34			{$codepage UTF8}
35			{$interfaces COM}
36			{$ENDIF}
37
38			interface
39
40			uses
41			Classes, SysUtils, IB, FBClientAPI, FBSQLData, FBOutputBlock, FBActivityMonitor,
42			FBTransaction;
43
44			type
45
46			{ TFBStatement }
47
48			TFBStatement = class(TActivityReporter)
49			private
50			FAttachmentIntf: IAttachment;
51			protected
52			FTransactionIntf: ITransaction;
53			FExecTransactionIntf: ITransaction;
54			FSQLStatementType: TIBSQLStatementTypes; { Select, update, delete, insert, create, alter, etc...}
55			FSQLDialect: integer;
56			FOpen: boolean;
57			FPrepared: boolean;
58			FPrepareSeqNo: integer; {used to check for out of date references from interfaces}
59			FSQL: string;
60			FProcessedSQL: string;
61			FHasParamNames: boolean;
62			FBOF: boolean;
63			FEOF: boolean;
64			FSingleResults: boolean;
65			FGenerateParamNames: boolean;
66			FChangeSeqNo: integer;
67			procedure CheckHandle; virtual; abstract;
68			procedure CheckTransaction(aTransaction: ITransaction);
69			procedure GetDsqlInfo(info_request: byte; buffer: ISQLInfoResults); overload; virtual; abstract;
70			procedure InternalPrepare; virtual; abstract;
71			function InternalExecute(aTransaction: ITransaction): IResults; virtual; abstract;
72			function InternalOpenCursor(aTransaction: ITransaction): IResultSet; virtual; abstract;
73			procedure FreeHandle; virtual; abstract;
74			procedure InternalClose(Force: boolean); virtual; abstract;
75			public
76			constructor Create(Attachment: IAttachment; Transaction: ITransaction;
77			sql: string; SQLDialect: integer);
78			constructor CreateWithParameterNames(Attachment: IAttachment; Transaction: ITransaction;
79			sql: string; SQLDialect: integer; GenerateParamNames: boolean =false);
80			destructor Destroy; override;
81			procedure Close;
82			procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
83			property SQLDialect: integer read FSQLDialect;
84
85			public
86			function GetSQLParams: ISQLParams; virtual; abstract;
87			function GetMetaData: IMetaData; virtual; abstract;
88			function GetRowsAffected(var SelectCount, InsertCount, UpdateCount,
89			DeleteCount: integer): boolean;
90			function GetSQLStatementType: TIBSQLStatementTypes;
91			function GetSQLText: string;
92			function GetSQLDialect: integer;
93
94			{GetDSQLInfo only supports isc_info_sql_stmt_type, isc_info_sql_get_plan, isc_info_sql_records}
95			procedure Prepare(aTransaction: ITransaction=nil); virtual;
96			function Execute(aTransaction: ITransaction=nil): IResults;
97			function OpenCursor(aTransaction: ITransaction=nil): IResultSet;
98			function CreateBlob(paramName: string): IBlob; overload;
99			function CreateBlob(index: integer): IBlob; overload;
100			function CreateBlob(column: TColumnMetaData): IBlob; overload; virtual; abstract;
101			function CreateArray(paramName: string): IArray; overload;
102			function CreateArray(index: integer): IArray; overload;
103			function CreateArray(column: TColumnMetaData): IArray; overload; virtual; abstract;
104			function GetAttachment: IAttachment;
105			function GetTransaction: ITransaction;
106			function GetDSQLInfo(Request: byte): ISQLInfoResults; overload;
107			procedure SetRetainInterfaces(aValue: boolean); virtual;
108			property ChangeSeqNo: integer read FChangeSeqNo;
109			property SQLParams: ISQLParams read GetSQLParams;
110			property SQLStatementType: TIBSQLStatementTypes read GetSQLStatementType;
111			end;
112
113			implementation
114
115			uses FBMessages;
116
117			{ TFBStatement }
118
119			procedure TFBStatement.CheckTransaction(aTransaction: ITransaction);
120			begin
121			if (aTransaction = nil) then
122			IBError(ibxeTransactionNotAssigned,[]);
123
124			if not aTransaction.InTransaction then
125			IBError(ibxeNotInTransaction,[]);
126			end;
127
128			constructor TFBStatement.Create(Attachment: IAttachment;
129			Transaction: ITransaction; sql: string; SQLDialect: integer);
130			begin
131			inherited Create(Transaction as TFBTransaction,2);
132			FAttachmentIntf := Attachment;
133			FTransactionIntf := Transaction;
134			FSQLDialect := SQLDialect;
135			FSQL := sql;
136			end;
137
138			constructor TFBStatement.CreateWithParameterNames(Attachment: IAttachment;
139			Transaction: ITransaction; sql: string; SQLDialect: integer;
140			GenerateParamNames: boolean);
141			begin
142			FHasParamNames := true;
143			FGenerateParamNames := GenerateParamNames;
144			Create(Attachment,Transaction,sql,SQLDialect);
145			end;
146
147			destructor TFBStatement.Destroy;
148			begin
149			Close;
150			FreeHandle;
151			inherited Destroy;
152			end;
153
154			procedure TFBStatement.Close;
155			begin
156			InternalClose(false);
157			end;
158
159			procedure TFBStatement.TransactionEnding(aTransaction: ITransaction;
160			Force: boolean);
161			begin
162			if FOpen and (FExecTransactionIntf = aTransaction) then
163			InternalClose(Force);
164
165			if FTransactionIntf = aTransaction then
166			begin
167			FreeHandle;
168			FPrepared := false;
169			end;
170			end;
171
172			function TFBStatement.GetRowsAffected(var SelectCount, InsertCount,
173			UpdateCount, DeleteCount: integer): boolean;
174			var
175			RB: ISQLInfoResults;
176			i, j: integer;
177			begin
178			InsertCount := 0;
179			UpdateCount := 0;
180			DeleteCount := 0;
181			Result := FPrepared;
182			if not Result then Exit;
183
184			RB := GetDsqlInfo(isc_info_sql_records);
185
186			for i := 0 to RB.Count - 1 do
187			with RB[i] do
188			case getItemType of
189			isc_info_sql_records:
190			for j := 0 to Count -1 do
191			with Items[j] do
192			case getItemType of
193			isc_info_req_select_count:
194			SelectCount := GetAsInteger;
195			isc_info_req_insert_count:
196			InsertCount := GetAsInteger;
197			isc_info_req_update_count:
198			UpdateCount := GetAsInteger;
199			isc_info_req_delete_count:
200			DeleteCount := GetAsInteger;
201			end;
202			end;
203			end;
204
205			function TFBStatement.GetSQLStatementType: TIBSQLStatementTypes;
206			begin
207			Result := FSQLStatementType;
208			end;
209
210			function TFBStatement.GetSQLText: string;
211			begin
212			Result := FSQL;
213			end;
214
215			function TFBStatement.GetSQLDialect: integer;
216			begin
217			Result := FSQLDialect;
218			end;
219
220			procedure TFBStatement.Prepare(aTransaction: ITransaction);
221			begin
222			if FPrepared then FreeHandle;
223			if aTransaction <> nil then
224			begin
225			RemoveMonitor(FTransactionIntf as TFBTransaction);
226			FTransactionIntf := aTransaction;
227			AddMonitor(FTransactionIntf as TFBTransaction);
228			end;
229			InternalPrepare;
230			end;
231
232			function TFBStatement.Execute(aTransaction: ITransaction): IResults;
233			begin
234			if aTransaction = nil then
235			Result := InternalExecute(FTransactionIntf)
236			else
237			Result := InternalExecute(aTransaction);
238			end;
239
240			function TFBStatement.OpenCursor(aTransaction: ITransaction): IResultSet;
241			begin
242			Close;
243			if aTransaction = nil then
244			Result := InternalOpenCursor(FTransactionIntf)
245			else
246			Result := InternalOpenCursor(aTransaction);
247			end;
248
249			function TFBStatement.CreateBlob(paramName: string): IBlob;
250			var column: TColumnMetaData;
251			begin
252			InternalPrepare;
253			column := SQLParams.ByName(paramName) as TSQLParam;
254			if column = nil then
255			IBError(ibxeFieldNotFound,[paramName]);
256			Result := CreateBlob(column);
257			end;
258
259			function TFBStatement.CreateBlob(index: integer): IBlob;
260			begin
261			InternalPrepare;
262			Result := CreateBlob(SQLParams[index] as TSQLParam);
263			end;
264
265			function TFBStatement.CreateArray(paramName: string): IArray;
266			var column: TColumnMetaData;
267			begin
268			InternalPrepare;
269			column := SQLParams.ByName(paramName) as TSQLParam;
270			if column = nil then
271			IBError(ibxeFieldNotFound,[paramName]);
272			Result := CreateArray(column);
273			end;
274
275			function TFBStatement.CreateArray(index: integer): IArray;
276			begin
277			InternalPrepare;
278			Result := CreateArray(SQLParams[index] as TSQLParam);
279			end;
280
281			function TFBStatement.GetAttachment: IAttachment;
282			begin
283			Result := FAttachmentIntf;
284			end;
285
286			function TFBStatement.GetTransaction: ITransaction;
287			begin
288			Result := FTransactionIntf
289			end;
290
291			function TFBStatement.GetDSQLInfo(Request: byte): ISQLInfoResults;
292			begin
293			Result := TSQLInfoResultsBuffer.Create;
294			GetDsqlInfo(Request,Result);
295			end;
296
297			procedure TFBStatement.SetRetainInterfaces(aValue: boolean);
298			begin
299			RetainInterfaces := aValue;
300			end;
301
302			end.
303