ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/FBStatement.pas
Revision: 363
Committed: Tue Dec 7 13:30:05 2021 UTC (2 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 15571 byte(s)
Log Message:
add fbintf

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 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 FFirebirdClientAPI: TFBClientAPI;
59 protected
60 FTransactionIntf: ITransaction;
61 FExecTransactionIntf: ITransaction;
62 FStaleReferenceChecks: boolean;
63 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 FSQL: AnsiString;
69 FProcessedSQL: AnsiString;
70 FHasParamNames: boolean;
71 FBOF: boolean;
72 FEOF: boolean;
73 FSingleResults: boolean;
74 FGenerateParamNames: boolean;
75 FChangeSeqNo: integer;
76 FCollectStatistics: boolean;
77 FStatisticsAvailable: boolean;
78 FBeforeStats: TPerfStatistics;
79 FAfterStats: TPerfStatistics;
80 FCaseSensitiveParams: boolean;
81 FBatchRowLimit: integer;
82 procedure CheckChangeBatchRowLimit; virtual;
83 procedure CheckHandle; virtual; abstract;
84 procedure CheckTransaction(aTransaction: ITransaction);
85 procedure DoJournaling;
86 function GetJournalIntf: IJournallingHook;
87 function GetStatementIntf: IStatement; virtual; abstract;
88 procedure GetDsqlInfo(info_request: byte; buffer: ISQLInfoResults); overload; virtual; abstract;
89 procedure InternalPrepare(CursorName: AnsiString=''); virtual; abstract;
90 function InternalExecute(Transaction: ITransaction): IResults; virtual; abstract;
91 function InternalOpenCursor(aTransaction: ITransaction; Scrollable: boolean): IResultSet; virtual; abstract;
92 procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); virtual; abstract;
93 procedure FreeHandle; virtual; abstract;
94 procedure InternalClose(Force: boolean); virtual; abstract;
95 function TimeStampToMSecs(const TimeStamp: TTimeStamp): Int64;
96 public
97 constructor Create(Attachment: IAttachment; Transaction: ITransaction;
98 sql: AnsiString; SQLDialect: integer);
99 constructor CreateWithParameterNames(Attachment: IAttachment; Transaction: ITransaction;
100 sql: AnsiString; SQLDialect: integer; GenerateParamNames: boolean =false;
101 CaseSensitiveParams: boolean = false);
102 destructor Destroy; override;
103 procedure Close;
104 procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
105 property SQLDialect: integer read FSQLDialect;
106 property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
107
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 function GetSQLStatementTypeName: AnsiString;
115 function GetSQLText: AnsiString;
116 function GetProcessedSQLText: AnsiString;
117 function GetSQLDialect: integer;
118 function GetFlags: TStatementFlags; virtual;
119
120 {GetDSQLInfo only supports isc_info_sql_stmt_type, isc_info_sql_get_plan, isc_info_sql_records}
121 procedure Prepare(aTransaction: ITransaction=nil); overload;
122 procedure Prepare(CursorName: AnsiString; aTransaction: ITransaction=nil); overload; virtual;
123 function Execute(aTransaction: ITransaction=nil): IResults;
124 function OpenCursor(aTransaction: ITransaction=nil): IResultSet; overload;
125 function OpenCursor(Scrollable: boolean; aTransaction: ITransaction=nil): IResultSet; overload;
126 function CreateBlob(paramName: AnsiString): IBlob; overload;
127 function CreateBlob(index: integer): IBlob; overload;
128 function CreateBlob(column: TColumnMetaData): IBlob; overload; virtual; abstract;
129 function CreateArray(paramName: AnsiString): IArray; overload;
130 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 procedure EnableStatistics(aValue: boolean);
137 function GetPerfStatistics(var stats: TPerfCounters): boolean;
138 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 {Stale Reference Check}
149 procedure SetStaleReferenceChecks(Enable:boolean); {default true}
150 function GetStaleReferenceChecks: boolean;
151 public
152 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 procedure TFBStatement.CheckChangeBatchRowLimit;
164 begin
165 //Do Nothing
166 end;
167
168 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 procedure TFBStatement.DoJournaling;
178 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 if JournalingActive and
190 (((joReadOnlyQueries in GetJournalOptions) and (RowsAffected = 0)) or
191 ((joModifyQueries in GetJournalOptions) and (RowsAffected > 0))) then
192 GetJournalIntf.ExecQuery(GetStatementIntf);
193 end;
194
195 function TFBStatement.GetJournalIntf: IJournallingHook;
196 begin
197 GetAttachment.QueryInterface(IJournallingHook,Result)
198 end;
199
200 function TFBStatement.TimeStampToMSecs(const TimeStamp: TTimeStamp): Int64;
201 begin
202 Result := TimeStamp.Time + Int64(timestamp.date)*msecsperday;
203 end;
204
205 constructor TFBStatement.Create(Attachment: IAttachment;
206 Transaction: ITransaction; sql: AnsiString; SQLDialect: integer);
207 begin
208 inherited Create(Transaction as TFBTransaction,2);
209 FAttachmentIntf := Attachment;
210 FTransactionIntf := Transaction;
211 FFirebirdClientAPI := Attachment.getFirebirdAPI as TFBClientAPI;
212 FSQLDialect := SQLDialect;
213 FSQL := sql;
214 FBatchRowLimit := DefaultBatchRowLimit;
215 FStaleReferenceChecks := true;
216 end;
217
218 constructor TFBStatement.CreateWithParameterNames(Attachment: IAttachment;
219 Transaction: ITransaction; sql: AnsiString; SQLDialect: integer;
220 GenerateParamNames: boolean; CaseSensitiveParams: boolean);
221 begin
222 FHasParamNames := true;
223 FGenerateParamNames := GenerateParamNames;
224 FCaseSensitiveParams := CaseSensitiveParams;
225 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 if FOpen and ((FExecTransactionIntf as TObject) = (aTransaction as TObject)) then
244 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 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 function TFBStatement.GetSQLText: AnsiString;
313 begin
314 Result := FSQL;
315 end;
316
317 function TFBStatement.GetProcessedSQLText: AnsiString;
318 begin
319 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 end;
328
329 function TFBStatement.GetSQLDialect: integer;
330 begin
331 Result := FSQLDialect;
332 end;
333
334 function TFBStatement.GetFlags: TStatementFlags;
335 begin
336 Result := [];
337 end;
338
339 procedure TFBStatement.Prepare(aTransaction: ITransaction);
340 begin
341 Prepare('',aTransaction);
342 end;
343
344 procedure TFBStatement.Prepare(CursorName: AnsiString;
345 aTransaction: ITransaction);
346 begin
347 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 InternalPrepare(CursorName);
355 end;
356
357 function TFBStatement.Execute(aTransaction: ITransaction): IResults;
358 begin
359 if aTransaction = nil then
360 Result := InternalExecute(FTransactionIntf)
361 else
362 Result := InternalExecute(aTransaction);
363 DoJournaling;
364 end;
365
366 procedure TFBStatement.AddToBatch;
367 begin
368 IBError(ibxeBatchModeNotSupported,[]);
369 end;
370
371 function TFBStatement.ExecuteBatch(aTransaction: ITransaction
372 ): IBatchCompletion;
373 begin
374 IBError(ibxeBatchModeNotSupported,[]);
375 end;
376
377 procedure TFBStatement.CancelBatch;
378 begin
379 IBError(ibxeBatchModeNotSupported,[]);
380 end;
381
382 function TFBStatement.GetBatchCompletion: IBatchCompletion;
383 begin
384 IBError(ibxeBatchModeNotSupported,[]);
385 end;
386
387 function TFBStatement.GetBatchRowLimit: integer;
388 begin
389 Result := FBatchRowLimit;
390 end;
391
392 procedure TFBStatement.SetBatchRowLimit(aLimit: integer);
393 begin
394 CheckChangeBatchRowLimit;
395 FBatchRowLimit := aLimit;
396 end;
397
398 procedure TFBStatement.SetStaleReferenceChecks(Enable: boolean);
399 begin
400 FStaleReferenceChecks := Enable;
401 end;
402
403 function TFBStatement.GetStaleReferenceChecks: boolean;
404 begin
405 Result := FStaleReferenceChecks;
406 end;
407
408 function TFBStatement.OpenCursor(aTransaction: ITransaction): IResultSet;
409 begin
410 Result := OpenCursor(false,aTransaction);
411 end;
412
413 function TFBStatement.OpenCursor(Scrollable: boolean; aTransaction: ITransaction
414 ): IResultSet;
415 begin
416 Close;
417 if aTransaction = nil then
418 Result := InternalOpenCursor(FTransactionIntf,Scrollable)
419 else
420 Result := InternalOpenCursor(aTransaction,Scrollable);
421 DoJournaling;
422 end;
423
424 function TFBStatement.CreateBlob(paramName: AnsiString): IBlob;
425 var column: TColumnMetaData;
426 begin
427 InternalPrepare;
428 column := SQLParams.ByName(paramName) as TSQLParam;
429 if column = nil then
430 IBError(ibxeFieldNotFound,[paramName]);
431 Result := CreateBlob(column);
432 end;
433
434 function TFBStatement.CreateBlob(index: integer): IBlob;
435 begin
436 InternalPrepare;
437 Result := CreateBlob(SQLParams[index] as TSQLParam);
438 end;
439
440 function TFBStatement.CreateArray(paramName: AnsiString): IArray;
441 var column: TColumnMetaData;
442 begin
443 InternalPrepare;
444 column := SQLParams.ByName(paramName) as TSQLParam;
445 if column = nil then
446 IBError(ibxeFieldNotFound,[paramName]);
447 Result := CreateArray(column);
448 end;
449
450 function TFBStatement.CreateArray(index: integer): IArray;
451 begin
452 InternalPrepare;
453 Result := CreateArray(SQLParams[index] as TSQLParam);
454 end;
455
456 function TFBStatement.GetAttachment: IAttachment;
457 begin
458 Result := FAttachmentIntf;
459 end;
460
461 function TFBStatement.GetTransaction: ITransaction;
462 begin
463 Result := FTransactionIntf
464 end;
465
466 function TFBStatement.GetDSQLInfo(Request: byte): ISQLInfoResults;
467 begin
468 Result := TSQLInfoResultsBuffer.Create(FFirebirdClientAPI);
469 GetDsqlInfo(Request,Result);
470 end;
471
472 procedure TFBStatement.SetRetainInterfaces(aValue: boolean);
473 begin
474 RetainInterfaces := aValue;
475 end;
476
477 procedure TFBStatement.EnableStatistics(aValue: boolean);
478 begin
479 if FCollectStatistics <> aValue then
480 begin
481 FCollectStatistics := aValue;
482 FStatisticsAvailable := false;
483 end;
484 end;
485
486 function TFBStatement.GetPerfStatistics(var stats: TPerfCounters): boolean;
487 begin
488 Result := FStatisticsAvailable;
489 if Result then
490 begin
491 stats[psCurrentMemory] := FAfterStats[psCurrentMemory];
492 stats[psDeltaMemory] := FAfterStats[psCurrentMemory] - FBeforeStats[psCurrentMemory];
493 stats[psMaxMemory] := FAfterStats[psMaxMemory];
494 stats[psRealTime] := FAfterStats[psRealTime] - FBeforeStats[psRealTime];
495 stats[psUserTime] := FAfterStats[psUserTime] - FBeforeStats[psUserTime];
496 stats[psReads] := FAfterStats[psReads] - FBeforeStats[psReads];
497 stats[psWrites] := FAfterStats[psWrites] - FBeforeStats[psWrites];
498 stats[psFetches] := FAfterStats[psFetches] - FBeforeStats[psFetches];
499 stats[psBuffers] := FAfterStats[psBuffers];
500 end;
501 end;
502
503 function TFBStatement.IsInBatchMode: boolean;
504 begin
505 Result := false;
506 end;
507
508 function TFBStatement.HasBatchMode: boolean;
509 begin
510 Result := false;
511 end;
512
513 end.
514