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

# 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 tony 363 procedure DoJournaling;
86     function GetJournalIntf: IJournallingHook;
87     function GetStatementIntf: IStatement; virtual; abstract;
88 tony 45 procedure GetDsqlInfo(info_request: byte; buffer: ISQLInfoResults); overload; virtual; abstract;
89 tony 350 procedure InternalPrepare(CursorName: AnsiString=''); virtual; abstract;
90 tony 345 function InternalExecute(Transaction: ITransaction): IResults; virtual; abstract;
91 tony 350 function InternalOpenCursor(aTransaction: ITransaction; Scrollable: boolean): IResultSet; virtual; abstract;
92 tony 263 procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); virtual; abstract;
93 tony 45 procedure FreeHandle; virtual; abstract;
94     procedure InternalClose(Force: boolean); virtual; abstract;
95 tony 209 function TimeStampToMSecs(const TimeStamp: TTimeStamp): Int64;
96 tony 45 public
97     constructor Create(Attachment: IAttachment; Transaction: ITransaction;
98 tony 56 sql: AnsiString; SQLDialect: integer);
99 tony 45 constructor CreateWithParameterNames(Attachment: IAttachment; Transaction: ITransaction;
100 tony 270 sql: AnsiString; SQLDialect: integer; GenerateParamNames: boolean =false;
101     CaseSensitiveParams: boolean = false);
102 tony 45 destructor Destroy; override;
103     procedure Close;
104     procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
105     property SQLDialect: integer read FSQLDialect;
106 tony 263 property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
107 tony 45
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 tony 345 function GetSQLStatementTypeName: AnsiString;
115 tony 56 function GetSQLText: AnsiString;
116 tony 263 function GetProcessedSQLText: AnsiString;
117 tony 45 function GetSQLDialect: integer;
118 tony 359 function GetFlags: TStatementFlags; virtual;
119 tony 45
120     {GetDSQLInfo only supports isc_info_sql_stmt_type, isc_info_sql_get_plan, isc_info_sql_records}
121 tony 350 procedure Prepare(aTransaction: ITransaction=nil); overload;
122     procedure Prepare(CursorName: AnsiString; aTransaction: ITransaction=nil); overload; virtual;
123 tony 45 function Execute(aTransaction: ITransaction=nil): IResults;
124 tony 350 function OpenCursor(aTransaction: ITransaction=nil): IResultSet; overload;
125     function OpenCursor(Scrollable: boolean; aTransaction: ITransaction=nil): IResultSet; overload;
126 tony 56 function CreateBlob(paramName: AnsiString): IBlob; overload;
127 tony 45 function CreateBlob(index: integer): IBlob; overload;
128     function CreateBlob(column: TColumnMetaData): IBlob; overload; virtual; abstract;
129 tony 56 function CreateArray(paramName: AnsiString): IArray; overload;
130 tony 45 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 tony 47 procedure EnableStatistics(aValue: boolean);
137     function GetPerfStatistics(var stats: TPerfCounters): boolean;
138 tony 345 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 tony 347 {Stale Reference Check}
149     procedure SetStaleReferenceChecks(Enable:boolean); {default true}
150     function GetStaleReferenceChecks: boolean;
151 tony 345 public
152 tony 45 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 tony 345 procedure TFBStatement.CheckChangeBatchRowLimit;
164     begin
165     //Do Nothing
166     end;
167    
168 tony 45 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 tony 363 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 tony 209 function TFBStatement.TimeStampToMSecs(const TimeStamp: TTimeStamp): Int64;
201     begin
202     Result := TimeStamp.Time + Int64(timestamp.date)*msecsperday;
203     end;
204    
205 tony 45 constructor TFBStatement.Create(Attachment: IAttachment;
206 tony 56 Transaction: ITransaction; sql: AnsiString; SQLDialect: integer);
207 tony 45 begin
208     inherited Create(Transaction as TFBTransaction,2);
209     FAttachmentIntf := Attachment;
210     FTransactionIntf := Transaction;
211 tony 263 FFirebirdClientAPI := Attachment.getFirebirdAPI as TFBClientAPI;
212 tony 45 FSQLDialect := SQLDialect;
213     FSQL := sql;
214 tony 345 FBatchRowLimit := DefaultBatchRowLimit;
215 tony 347 FStaleReferenceChecks := true;
216 tony 45 end;
217    
218     constructor TFBStatement.CreateWithParameterNames(Attachment: IAttachment;
219 tony 56 Transaction: ITransaction; sql: AnsiString; SQLDialect: integer;
220 tony 270 GenerateParamNames: boolean; CaseSensitiveParams: boolean);
221 tony 45 begin
222     FHasParamNames := true;
223     FGenerateParamNames := GenerateParamNames;
224 tony 270 FCaseSensitiveParams := CaseSensitiveParams;
225 tony 45 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 tony 315 if FOpen and ((FExecTransactionIntf as TObject) = (aTransaction as TObject)) then
244 tony 45 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 tony 345 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 tony 56 function TFBStatement.GetSQLText: AnsiString;
313 tony 45 begin
314     Result := FSQL;
315     end;
316    
317 tony 263 function TFBStatement.GetProcessedSQLText: AnsiString;
318     begin
319 tony 359 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 tony 263 end;
328    
329 tony 45 function TFBStatement.GetSQLDialect: integer;
330     begin
331     Result := FSQLDialect;
332     end;
333    
334 tony 359 function TFBStatement.GetFlags: TStatementFlags;
335     begin
336     Result := [];
337     end;
338    
339 tony 45 procedure TFBStatement.Prepare(aTransaction: ITransaction);
340     begin
341 tony 350 Prepare('',aTransaction);
342     end;
343    
344     procedure TFBStatement.Prepare(CursorName: AnsiString;
345     aTransaction: ITransaction);
346     begin
347 tony 45 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 tony 350 InternalPrepare(CursorName);
355 tony 45 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 tony 363 DoJournaling;
364 tony 45 end;
365    
366 tony 345 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 tony 347 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 tony 45 function TFBStatement.OpenCursor(aTransaction: ITransaction): IResultSet;
409     begin
410 tony 350 Result := OpenCursor(false,aTransaction);
411     end;
412    
413     function TFBStatement.OpenCursor(Scrollable: boolean; aTransaction: ITransaction
414     ): IResultSet;
415     begin
416 tony 45 Close;
417     if aTransaction = nil then
418 tony 350 Result := InternalOpenCursor(FTransactionIntf,Scrollable)
419 tony 45 else
420 tony 350 Result := InternalOpenCursor(aTransaction,Scrollable);
421 tony 363 DoJournaling;
422 tony 45 end;
423    
424 tony 56 function TFBStatement.CreateBlob(paramName: AnsiString): IBlob;
425 tony 45 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 tony 56 function TFBStatement.CreateArray(paramName: AnsiString): IArray;
441 tony 45 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 tony 263 Result := TSQLInfoResultsBuffer.Create(FFirebirdClientAPI);
469 tony 45 GetDsqlInfo(Request,Result);
470     end;
471    
472     procedure TFBStatement.SetRetainInterfaces(aValue: boolean);
473     begin
474     RetainInterfaces := aValue;
475     end;
476    
477 tony 47 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 tony 345 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 tony 45 end.
514