ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/FBStatement.pas
Revision: 347
Committed: Mon Sep 20 22:08:20 2021 UTC (2 years, 6 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/FBStatement.pas
File size: 14002 byte(s)
Log Message:
Updated Merged

File Contents

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