ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBStatement.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (17 months, 2 weeks ago) by tony
File size: 11315 byte(s)
Log Message:
Updated for IBX 4 release
Line File contents
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 type
48 TPerfStatistics = array[psCurrentMemory..psFetches] of Int64;
49
50 { TFBStatement }
51
52 TFBStatement = class(TActivityReporter,ITransactionUser)
53 private
54 FAttachmentIntf: IAttachment;
55 FFirebirdClientAPI: TFBClientAPI;
56 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 FSQL: AnsiString;
65 FProcessedSQL: AnsiString;
66 FHasParamNames: boolean;
67 FBOF: boolean;
68 FEOF: boolean;
69 FSingleResults: boolean;
70 FGenerateParamNames: boolean;
71 FChangeSeqNo: integer;
72 FCollectStatistics: boolean;
73 FStatisticsAvailable: boolean;
74 FBeforeStats: TPerfStatistics;
75 FAfterStats: TPerfStatistics;
76 FCaseSensitiveParams: boolean;
77 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 procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); virtual; abstract;
84 procedure FreeHandle; virtual; abstract;
85 procedure InternalClose(Force: boolean); virtual; abstract;
86 function TimeStampToMSecs(const TimeStamp: TTimeStamp): Int64;
87 public
88 constructor Create(Attachment: IAttachment; Transaction: ITransaction;
89 sql: AnsiString; SQLDialect: integer);
90 constructor CreateWithParameterNames(Attachment: IAttachment; Transaction: ITransaction;
91 sql: AnsiString; SQLDialect: integer; GenerateParamNames: boolean =false;
92 CaseSensitiveParams: boolean = false);
93 destructor Destroy; override;
94 procedure Close;
95 procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
96 property SQLDialect: integer read FSQLDialect;
97 property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
98
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 function GetSQLText: AnsiString;
106 function GetProcessedSQLText: AnsiString;
107 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 function CreateBlob(paramName: AnsiString): IBlob; overload;
114 function CreateBlob(index: integer): IBlob; overload;
115 function CreateBlob(column: TColumnMetaData): IBlob; overload; virtual; abstract;
116 function CreateArray(paramName: AnsiString): IArray; overload;
117 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 procedure EnableStatistics(aValue: boolean);
124 function GetPerfStatistics(var stats: TPerfCounters): boolean;
125 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 function TFBStatement.TimeStampToMSecs(const TimeStamp: TTimeStamp): Int64;
146 begin
147 Result := TimeStamp.Time + Int64(timestamp.date)*msecsperday;
148 end;
149
150 constructor TFBStatement.Create(Attachment: IAttachment;
151 Transaction: ITransaction; sql: AnsiString; SQLDialect: integer);
152 begin
153 inherited Create(Transaction as TFBTransaction,2);
154 FAttachmentIntf := Attachment;
155 FTransactionIntf := Transaction;
156 FFirebirdClientAPI := Attachment.getFirebirdAPI as TFBClientAPI;
157 FSQLDialect := SQLDialect;
158 FSQL := sql;
159 end;
160
161 constructor TFBStatement.CreateWithParameterNames(Attachment: IAttachment;
162 Transaction: ITransaction; sql: AnsiString; SQLDialect: integer;
163 GenerateParamNames: boolean; CaseSensitiveParams: boolean);
164 begin
165 FHasParamNames := true;
166 FGenerateParamNames := GenerateParamNames;
167 FCaseSensitiveParams := CaseSensitiveParams;
168 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 as TObject) = (aTransaction as TObject)) 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 function TFBStatement.GetSQLText: AnsiString;
235 begin
236 Result := FSQL;
237 end;
238
239 function TFBStatement.GetProcessedSQLText: AnsiString;
240 begin
241 if FProcessedSQL = '' then
242 ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
243 Result := FProcessedSQL
244 end;
245
246 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 function TFBStatement.CreateBlob(paramName: AnsiString): IBlob;
281 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 function TFBStatement.CreateArray(paramName: AnsiString): IArray;
297 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 Result := TSQLInfoResultsBuffer.Create(FFirebirdClientAPI);
325 GetDsqlInfo(Request,Result);
326 end;
327
328 procedure TFBStatement.SetRetainInterfaces(aValue: boolean);
329 begin
330 RetainInterfaces := aValue;
331 end;
332
333 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 end.
360