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