ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBStatement.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 8982 byte(s)
Log Message:
Committing updates for Release R2-0-0

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
32 {$IFDEF FPC}
33 {$mode objfpc}{$H+}
34 {$codepage UTF8}
35 {$interfaces COM}
36 {$ENDIF}
37
38 interface
39
40 uses
41 Classes, SysUtils, IB, FBClientAPI, FBSQLData, FBOutputBlock, FBActivityMonitor,
42 FBTransaction;
43
44 type
45
46 { TFBStatement }
47
48 TFBStatement = class(TActivityReporter)
49 private
50 FAttachmentIntf: IAttachment;
51 protected
52 FTransactionIntf: ITransaction;
53 FExecTransactionIntf: ITransaction;
54 FSQLStatementType: TIBSQLStatementTypes; { Select, update, delete, insert, create, alter, etc...}
55 FSQLDialect: integer;
56 FOpen: boolean;
57 FPrepared: boolean;
58 FPrepareSeqNo: integer; {used to check for out of date references from interfaces}
59 FSQL: string;
60 FProcessedSQL: string;
61 FHasParamNames: boolean;
62 FBOF: boolean;
63 FEOF: boolean;
64 FSingleResults: boolean;
65 FGenerateParamNames: boolean;
66 FChangeSeqNo: integer;
67 procedure CheckHandle; virtual; abstract;
68 procedure CheckTransaction(aTransaction: ITransaction);
69 procedure GetDsqlInfo(info_request: byte; buffer: ISQLInfoResults); overload; virtual; abstract;
70 procedure InternalPrepare; virtual; abstract;
71 function InternalExecute(aTransaction: ITransaction): IResults; virtual; abstract;
72 function InternalOpenCursor(aTransaction: ITransaction): IResultSet; virtual; abstract;
73 procedure FreeHandle; virtual; abstract;
74 procedure InternalClose(Force: boolean); virtual; abstract;
75 public
76 constructor Create(Attachment: IAttachment; Transaction: ITransaction;
77 sql: string; SQLDialect: integer);
78 constructor CreateWithParameterNames(Attachment: IAttachment; Transaction: ITransaction;
79 sql: string; SQLDialect: integer; GenerateParamNames: boolean =false);
80 destructor Destroy; override;
81 procedure Close;
82 procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
83 property SQLDialect: integer read FSQLDialect;
84
85 public
86 function GetSQLParams: ISQLParams; virtual; abstract;
87 function GetMetaData: IMetaData; virtual; abstract;
88 function GetRowsAffected(var SelectCount, InsertCount, UpdateCount,
89 DeleteCount: integer): boolean;
90 function GetSQLStatementType: TIBSQLStatementTypes;
91 function GetSQLText: string;
92 function GetSQLDialect: integer;
93
94 {GetDSQLInfo only supports isc_info_sql_stmt_type, isc_info_sql_get_plan, isc_info_sql_records}
95 procedure Prepare(aTransaction: ITransaction=nil); virtual;
96 function Execute(aTransaction: ITransaction=nil): IResults;
97 function OpenCursor(aTransaction: ITransaction=nil): IResultSet;
98 function CreateBlob(paramName: string): IBlob; overload;
99 function CreateBlob(index: integer): IBlob; overload;
100 function CreateBlob(column: TColumnMetaData): IBlob; overload; virtual; abstract;
101 function CreateArray(paramName: string): IArray; overload;
102 function CreateArray(index: integer): IArray; overload;
103 function CreateArray(column: TColumnMetaData): IArray; overload; virtual; abstract;
104 function GetAttachment: IAttachment;
105 function GetTransaction: ITransaction;
106 function GetDSQLInfo(Request: byte): ISQLInfoResults; overload;
107 procedure SetRetainInterfaces(aValue: boolean); virtual;
108 property ChangeSeqNo: integer read FChangeSeqNo;
109 property SQLParams: ISQLParams read GetSQLParams;
110 property SQLStatementType: TIBSQLStatementTypes read GetSQLStatementType;
111 end;
112
113 implementation
114
115 uses FBMessages;
116
117 { TFBStatement }
118
119 procedure TFBStatement.CheckTransaction(aTransaction: ITransaction);
120 begin
121 if (aTransaction = nil) then
122 IBError(ibxeTransactionNotAssigned,[]);
123
124 if not aTransaction.InTransaction then
125 IBError(ibxeNotInTransaction,[]);
126 end;
127
128 constructor TFBStatement.Create(Attachment: IAttachment;
129 Transaction: ITransaction; sql: string; SQLDialect: integer);
130 begin
131 inherited Create(Transaction as TFBTransaction,2);
132 FAttachmentIntf := Attachment;
133 FTransactionIntf := Transaction;
134 FSQLDialect := SQLDialect;
135 FSQL := sql;
136 end;
137
138 constructor TFBStatement.CreateWithParameterNames(Attachment: IAttachment;
139 Transaction: ITransaction; sql: string; SQLDialect: integer;
140 GenerateParamNames: boolean);
141 begin
142 FHasParamNames := true;
143 FGenerateParamNames := GenerateParamNames;
144 Create(Attachment,Transaction,sql,SQLDialect);
145 end;
146
147 destructor TFBStatement.Destroy;
148 begin
149 Close;
150 FreeHandle;
151 inherited Destroy;
152 end;
153
154 procedure TFBStatement.Close;
155 begin
156 InternalClose(false);
157 end;
158
159 procedure TFBStatement.TransactionEnding(aTransaction: ITransaction;
160 Force: boolean);
161 begin
162 if FOpen and (FExecTransactionIntf = aTransaction) then
163 InternalClose(Force);
164
165 if FTransactionIntf = aTransaction then
166 begin
167 FreeHandle;
168 FPrepared := false;
169 end;
170 end;
171
172 function TFBStatement.GetRowsAffected(var SelectCount, InsertCount,
173 UpdateCount, DeleteCount: integer): boolean;
174 var
175 RB: ISQLInfoResults;
176 i, j: integer;
177 begin
178 InsertCount := 0;
179 UpdateCount := 0;
180 DeleteCount := 0;
181 Result := FPrepared;
182 if not Result then Exit;
183
184 RB := GetDsqlInfo(isc_info_sql_records);
185
186 for i := 0 to RB.Count - 1 do
187 with RB[i] do
188 case getItemType of
189 isc_info_sql_records:
190 for j := 0 to Count -1 do
191 with Items[j] do
192 case getItemType of
193 isc_info_req_select_count:
194 SelectCount := GetAsInteger;
195 isc_info_req_insert_count:
196 InsertCount := GetAsInteger;
197 isc_info_req_update_count:
198 UpdateCount := GetAsInteger;
199 isc_info_req_delete_count:
200 DeleteCount := GetAsInteger;
201 end;
202 end;
203 end;
204
205 function TFBStatement.GetSQLStatementType: TIBSQLStatementTypes;
206 begin
207 Result := FSQLStatementType;
208 end;
209
210 function TFBStatement.GetSQLText: string;
211 begin
212 Result := FSQL;
213 end;
214
215 function TFBStatement.GetSQLDialect: integer;
216 begin
217 Result := FSQLDialect;
218 end;
219
220 procedure TFBStatement.Prepare(aTransaction: ITransaction);
221 begin
222 if FPrepared then FreeHandle;
223 if aTransaction <> nil then
224 begin
225 RemoveMonitor(FTransactionIntf as TFBTransaction);
226 FTransactionIntf := aTransaction;
227 AddMonitor(FTransactionIntf as TFBTransaction);
228 end;
229 InternalPrepare;
230 end;
231
232 function TFBStatement.Execute(aTransaction: ITransaction): IResults;
233 begin
234 if aTransaction = nil then
235 Result := InternalExecute(FTransactionIntf)
236 else
237 Result := InternalExecute(aTransaction);
238 end;
239
240 function TFBStatement.OpenCursor(aTransaction: ITransaction): IResultSet;
241 begin
242 Close;
243 if aTransaction = nil then
244 Result := InternalOpenCursor(FTransactionIntf)
245 else
246 Result := InternalOpenCursor(aTransaction);
247 end;
248
249 function TFBStatement.CreateBlob(paramName: string): IBlob;
250 var column: TColumnMetaData;
251 begin
252 InternalPrepare;
253 column := SQLParams.ByName(paramName) as TSQLParam;
254 if column = nil then
255 IBError(ibxeFieldNotFound,[paramName]);
256 Result := CreateBlob(column);
257 end;
258
259 function TFBStatement.CreateBlob(index: integer): IBlob;
260 begin
261 InternalPrepare;
262 Result := CreateBlob(SQLParams[index] as TSQLParam);
263 end;
264
265 function TFBStatement.CreateArray(paramName: string): IArray;
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 := CreateArray(column);
273 end;
274
275 function TFBStatement.CreateArray(index: integer): IArray;
276 begin
277 InternalPrepare;
278 Result := CreateArray(SQLParams[index] as TSQLParam);
279 end;
280
281 function TFBStatement.GetAttachment: IAttachment;
282 begin
283 Result := FAttachmentIntf;
284 end;
285
286 function TFBStatement.GetTransaction: ITransaction;
287 begin
288 Result := FTransactionIntf
289 end;
290
291 function TFBStatement.GetDSQLInfo(Request: byte): ISQLInfoResults;
292 begin
293 Result := TSQLInfoResultsBuffer.Create;
294 GetDsqlInfo(Request,Result);
295 end;
296
297 procedure TFBStatement.SetRetainInterfaces(aValue: boolean);
298 begin
299 RetainInterfaces := aValue;
300 end;
301
302 end.
303