ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBStatement.pas
Revision: 56
Committed: Mon Mar 6 10:20:02 2017 UTC (7 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 10356 byte(s)
Log Message:
Committing updates for Trunk

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