ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBStatement.pas
Revision: 209
Committed: Wed Mar 14 12:48:51 2018 UTC (6 years, 1 month ago) by tony
Content type: text/x-pascal
File size: 10576 byte(s)
Log Message:
Fixes Merged

File Contents

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