ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/FBStatement.pas
Revision: 47
Committed: Mon Jan 9 15:31:51 2017 UTC (7 years, 2 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/FBStatement.pas
File size: 10266 byte(s)
Log Message:
Committing updates for Release R2-0-1

File Contents

# 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
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 TPerfStatistics = array[psCurrentMemory..psFetches] of Int64;
46
47 { TFBStatement }
48
49 TFBStatement = class(TActivityReporter)
50 private
51 FAttachmentIntf: IAttachment;
52 protected
53 FTransactionIntf: ITransaction;
54 FExecTransactionIntf: ITransaction;
55 FSQLStatementType: TIBSQLStatementTypes; { Select, update, delete, insert, create, alter, etc...}
56 FSQLDialect: integer;
57 FOpen: boolean;
58 FPrepared: boolean;
59 FPrepareSeqNo: integer; {used to check for out of date references from interfaces}
60 FSQL: string;
61 FProcessedSQL: string;
62 FHasParamNames: boolean;
63 FBOF: boolean;
64 FEOF: boolean;
65 FSingleResults: boolean;
66 FGenerateParamNames: boolean;
67 FChangeSeqNo: integer;
68 FCollectStatistics: boolean;
69 FStatisticsAvailable: boolean;
70 FBeforeStats: TPerfStatistics;
71 FAfterStats: TPerfStatistics;
72 procedure CheckHandle; virtual; abstract;
73 procedure CheckTransaction(aTransaction: ITransaction);
74 procedure GetDsqlInfo(info_request: byte; buffer: ISQLInfoResults); overload; virtual; abstract;
75 procedure InternalPrepare; virtual; abstract;
76 function InternalExecute(aTransaction: ITransaction): IResults; virtual; abstract;
77 function InternalOpenCursor(aTransaction: ITransaction): IResultSet; virtual; abstract;
78 procedure FreeHandle; virtual; abstract;
79 procedure InternalClose(Force: boolean); virtual; abstract;
80 public
81 constructor Create(Attachment: IAttachment; Transaction: ITransaction;
82 sql: string; SQLDialect: integer);
83 constructor CreateWithParameterNames(Attachment: IAttachment; Transaction: ITransaction;
84 sql: string; SQLDialect: integer; GenerateParamNames: boolean =false);
85 destructor Destroy; override;
86 procedure Close;
87 procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
88 property SQLDialect: integer read FSQLDialect;
89
90 public
91 function GetSQLParams: ISQLParams; virtual; abstract;
92 function GetMetaData: IMetaData; virtual; abstract;
93 function GetRowsAffected(var SelectCount, InsertCount, UpdateCount,
94 DeleteCount: integer): boolean;
95 function GetSQLStatementType: TIBSQLStatementTypes;
96 function GetSQLText: string;
97 function GetSQLDialect: integer;
98
99 {GetDSQLInfo only supports isc_info_sql_stmt_type, isc_info_sql_get_plan, isc_info_sql_records}
100 procedure Prepare(aTransaction: ITransaction=nil); virtual;
101 function Execute(aTransaction: ITransaction=nil): IResults;
102 function OpenCursor(aTransaction: ITransaction=nil): IResultSet;
103 function CreateBlob(paramName: string): IBlob; overload;
104 function CreateBlob(index: integer): IBlob; overload;
105 function CreateBlob(column: TColumnMetaData): IBlob; overload; virtual; abstract;
106 function CreateArray(paramName: string): IArray; overload;
107 function CreateArray(index: integer): IArray; overload;
108 function CreateArray(column: TColumnMetaData): IArray; overload; virtual; abstract;
109 function GetAttachment: IAttachment;
110 function GetTransaction: ITransaction;
111 function GetDSQLInfo(Request: byte): ISQLInfoResults; overload;
112 procedure SetRetainInterfaces(aValue: boolean); virtual;
113 procedure EnableStatistics(aValue: boolean);
114 function GetPerfStatistics(var stats: TPerfCounters): boolean;
115 property ChangeSeqNo: integer read FChangeSeqNo;
116 property SQLParams: ISQLParams read GetSQLParams;
117 property SQLStatementType: TIBSQLStatementTypes read GetSQLStatementType;
118 end;
119
120 implementation
121
122 uses FBMessages;
123
124 { TFBStatement }
125
126 procedure TFBStatement.CheckTransaction(aTransaction: ITransaction);
127 begin
128 if (aTransaction = nil) then
129 IBError(ibxeTransactionNotAssigned,[]);
130
131 if not aTransaction.InTransaction then
132 IBError(ibxeNotInTransaction,[]);
133 end;
134
135 constructor TFBStatement.Create(Attachment: IAttachment;
136 Transaction: ITransaction; sql: string; SQLDialect: integer);
137 begin
138 inherited Create(Transaction as TFBTransaction,2);
139 FAttachmentIntf := Attachment;
140 FTransactionIntf := Transaction;
141 FSQLDialect := SQLDialect;
142 FSQL := sql;
143 end;
144
145 constructor TFBStatement.CreateWithParameterNames(Attachment: IAttachment;
146 Transaction: ITransaction; sql: string; SQLDialect: integer;
147 GenerateParamNames: boolean);
148 begin
149 FHasParamNames := true;
150 FGenerateParamNames := GenerateParamNames;
151 Create(Attachment,Transaction,sql,SQLDialect);
152 end;
153
154 destructor TFBStatement.Destroy;
155 begin
156 Close;
157 FreeHandle;
158 inherited Destroy;
159 end;
160
161 procedure TFBStatement.Close;
162 begin
163 InternalClose(false);
164 end;
165
166 procedure TFBStatement.TransactionEnding(aTransaction: ITransaction;
167 Force: boolean);
168 begin
169 if FOpen and (FExecTransactionIntf = aTransaction) then
170 InternalClose(Force);
171
172 if FTransactionIntf = aTransaction then
173 begin
174 FreeHandle;
175 FPrepared := false;
176 end;
177 end;
178
179 function TFBStatement.GetRowsAffected(var SelectCount, InsertCount,
180 UpdateCount, DeleteCount: integer): boolean;
181 var
182 RB: ISQLInfoResults;
183 i, j: integer;
184 begin
185 InsertCount := 0;
186 UpdateCount := 0;
187 DeleteCount := 0;
188 Result := FPrepared;
189 if not Result then Exit;
190
191 RB := GetDsqlInfo(isc_info_sql_records);
192
193 for i := 0 to RB.Count - 1 do
194 with RB[i] do
195 case getItemType of
196 isc_info_sql_records:
197 for j := 0 to Count -1 do
198 with Items[j] do
199 case getItemType of
200 isc_info_req_select_count:
201 SelectCount := GetAsInteger;
202 isc_info_req_insert_count:
203 InsertCount := GetAsInteger;
204 isc_info_req_update_count:
205 UpdateCount := GetAsInteger;
206 isc_info_req_delete_count:
207 DeleteCount := GetAsInteger;
208 end;
209 end;
210 end;
211
212 function TFBStatement.GetSQLStatementType: TIBSQLStatementTypes;
213 begin
214 Result := FSQLStatementType;
215 end;
216
217 function TFBStatement.GetSQLText: string;
218 begin
219 Result := FSQL;
220 end;
221
222 function TFBStatement.GetSQLDialect: integer;
223 begin
224 Result := FSQLDialect;
225 end;
226
227 procedure TFBStatement.Prepare(aTransaction: ITransaction);
228 begin
229 if FPrepared then FreeHandle;
230 if aTransaction <> nil then
231 begin
232 RemoveMonitor(FTransactionIntf as TFBTransaction);
233 FTransactionIntf := aTransaction;
234 AddMonitor(FTransactionIntf as TFBTransaction);
235 end;
236 InternalPrepare;
237 end;
238
239 function TFBStatement.Execute(aTransaction: ITransaction): IResults;
240 begin
241 if aTransaction = nil then
242 Result := InternalExecute(FTransactionIntf)
243 else
244 Result := InternalExecute(aTransaction);
245 end;
246
247 function TFBStatement.OpenCursor(aTransaction: ITransaction): IResultSet;
248 begin
249 Close;
250 if aTransaction = nil then
251 Result := InternalOpenCursor(FTransactionIntf)
252 else
253 Result := InternalOpenCursor(aTransaction);
254 end;
255
256 function TFBStatement.CreateBlob(paramName: string): IBlob;
257 var column: TColumnMetaData;
258 begin
259 InternalPrepare;
260 column := SQLParams.ByName(paramName) as TSQLParam;
261 if column = nil then
262 IBError(ibxeFieldNotFound,[paramName]);
263 Result := CreateBlob(column);
264 end;
265
266 function TFBStatement.CreateBlob(index: integer): IBlob;
267 begin
268 InternalPrepare;
269 Result := CreateBlob(SQLParams[index] as TSQLParam);
270 end;
271
272 function TFBStatement.CreateArray(paramName: string): IArray;
273 var column: TColumnMetaData;
274 begin
275 InternalPrepare;
276 column := SQLParams.ByName(paramName) as TSQLParam;
277 if column = nil then
278 IBError(ibxeFieldNotFound,[paramName]);
279 Result := CreateArray(column);
280 end;
281
282 function TFBStatement.CreateArray(index: integer): IArray;
283 begin
284 InternalPrepare;
285 Result := CreateArray(SQLParams[index] as TSQLParam);
286 end;
287
288 function TFBStatement.GetAttachment: IAttachment;
289 begin
290 Result := FAttachmentIntf;
291 end;
292
293 function TFBStatement.GetTransaction: ITransaction;
294 begin
295 Result := FTransactionIntf
296 end;
297
298 function TFBStatement.GetDSQLInfo(Request: byte): ISQLInfoResults;
299 begin
300 Result := TSQLInfoResultsBuffer.Create;
301 GetDsqlInfo(Request,Result);
302 end;
303
304 procedure TFBStatement.SetRetainInterfaces(aValue: boolean);
305 begin
306 RetainInterfaces := aValue;
307 end;
308
309 procedure TFBStatement.EnableStatistics(aValue: boolean);
310 begin
311 if FCollectStatistics <> aValue then
312 begin
313 FCollectStatistics := aValue;
314 FStatisticsAvailable := false;
315 end;
316 end;
317
318 function TFBStatement.GetPerfStatistics(var stats: TPerfCounters): boolean;
319 begin
320 Result := FStatisticsAvailable;
321 if Result then
322 begin
323 stats[psCurrentMemory] := FAfterStats[psCurrentMemory];
324 stats[psDeltaMemory] := FAfterStats[psCurrentMemory] - FBeforeStats[psCurrentMemory];
325 stats[psMaxMemory] := FAfterStats[psMaxMemory];
326 stats[psRealTime] := FAfterStats[psRealTime] - FBeforeStats[psRealTime];
327 stats[psUserTime] := FAfterStats[psUserTime] - FBeforeStats[psUserTime];
328 stats[psReads] := FAfterStats[psReads] - FBeforeStats[psReads];
329 stats[psWrites] := FAfterStats[psWrites] - FBeforeStats[psWrites];
330 stats[psFetches] := FAfterStats[psFetches] - FBeforeStats[psFetches];
331 stats[psBuffers] := FAfterStats[psBuffers];
332 end;
333 end;
334
335 end.
336