ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/FBStatement.pas
Revision: 345
Committed: Mon Aug 23 14:22:29 2021 UTC (3 years, 3 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/FBStatement.pas
File size: 13573 byte(s)
Log Message:
Merged into public release

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