ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBStatement.pas
Revision: 263
Committed: Thu Dec 6 15:55:01 2018 UTC (5 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 11116 byte(s)
Log Message:
Release 2.3.2 committed

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