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 |
|
|
|