ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/FBStatement.pas
Revision: 209
Committed: Wed Mar 14 12:48:51 2018 UTC (6 years, 9 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/FBStatement.pas
File size: 10576 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     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 tony 56 FSQL: AnsiString;
64     FProcessedSQL: AnsiString;
65 tony 45 FHasParamNames: boolean;
66     FBOF: boolean;
67     FEOF: boolean;
68     FSingleResults: boolean;
69     FGenerateParamNames: boolean;
70     FChangeSeqNo: integer;
71 tony 47 FCollectStatistics: boolean;
72     FStatisticsAvailable: boolean;
73     FBeforeStats: TPerfStatistics;
74     FAfterStats: TPerfStatistics;
75 tony 45 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 tony 209 function TimeStampToMSecs(const TimeStamp: TTimeStamp): Int64;
84 tony 45 public
85     constructor Create(Attachment: IAttachment; Transaction: ITransaction;
86 tony 56 sql: AnsiString; SQLDialect: integer);
87 tony 45 constructor CreateWithParameterNames(Attachment: IAttachment; Transaction: ITransaction;
88 tony 56 sql: AnsiString; SQLDialect: integer; GenerateParamNames: boolean =false);
89 tony 45 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 tony 56 function GetSQLText: AnsiString;
101 tony 45 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 tony 56 function CreateBlob(paramName: AnsiString): IBlob; overload;
108 tony 45 function CreateBlob(index: integer): IBlob; overload;
109     function CreateBlob(column: TColumnMetaData): IBlob; overload; virtual; abstract;
110 tony 56 function CreateArray(paramName: AnsiString): IArray; overload;
111 tony 45 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 tony 47 procedure EnableStatistics(aValue: boolean);
118     function GetPerfStatistics(var stats: TPerfCounters): boolean;
119 tony 45 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 tony 209 function TFBStatement.TimeStampToMSecs(const TimeStamp: TTimeStamp): Int64;
140     begin
141     Result := TimeStamp.Time + Int64(timestamp.date)*msecsperday;
142     end;
143    
144 tony 45 constructor TFBStatement.Create(Attachment: IAttachment;
145 tony 56 Transaction: ITransaction; sql: AnsiString; SQLDialect: integer);
146 tony 45 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 tony 56 Transaction: ITransaction; sql: AnsiString; SQLDialect: integer;
156 tony 45 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 tony 56 function TFBStatement.GetSQLText: AnsiString;
227 tony 45 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 tony 56 function TFBStatement.CreateBlob(paramName: AnsiString): IBlob;
266 tony 45 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 tony 56 function TFBStatement.CreateArray(paramName: AnsiString): IArray;
282 tony 45 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 tony 47 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 tony 45 end.
345