ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBAttachment.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 4 months ago) by tony
Content type: text/x-pascal
File size: 12691 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.
4 *
5 * The contents of this file are subject to the Initial Developer's
6 * Public License Version 1.0 (the "License"); you may not use this
7 * file except in compliance with the License. You may obtain a copy
8 * of the License here:
9 *
10 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
11 *
12 * Software distributed under the License is distributed on an "AS
13 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14 * implied. See the License for the specific language governing rights
15 * and limitations under the License.
16 *
17 * The Initial Developer of the Original Code is Tony Whyman.
18 *
19 * The Original Code is (C) 2016 Tony Whyman, MWA Software
20 * (http://www.mwasoftware.co.uk).
21 *
22 * All Rights Reserved.
23 *
24 * Contributor(s): ______________________________________.
25 *
26 *)
27 unit FBAttachment;
28
29 {$IFDEF FPC}
30 {$mode objfpc}{$H+}
31 {$interfaces COM}
32 {$ENDIF}
33
34 interface
35
36 uses
37 Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor;
38
39 type
40
41 { TFBAttachment }
42
43 TFBAttachment = class(TActivityHandler)
44 private
45 FDPB: IDPB;
46 FFirebirdAPI: IFirebirdAPI;
47 protected
48 FDatabaseName: string;
49 FRaiseExceptionOnConnectError: boolean;
50 FSQLDialect: integer;
51 FHasDefaultCharSet: boolean;
52 FCharSetID: integer;
53 FCodePage: TSystemCodePage;
54 constructor Create(DatabaseName: string; DPB: IDPB;
55 RaiseExceptionOnConnectError: boolean);
56 procedure CheckHandle; virtual; abstract;
57 function GenerateCreateDatabaseSQL(DatabaseName: string; aDPB: IDPB): string;
58 procedure EndAllTransactions;
59 procedure SetParameters(SQLParams: ISQLParams; params: array of const);
60 public
61 destructor Destroy; override;
62 function getDPB: IDPB;
63 function AllocateBPB: IBPB;
64 function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
65 function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
66 procedure Disconnect(Force: boolean=false); virtual; abstract;
67 procedure ExecImmediate(transaction: ITransaction; sql: string; aSQLDialect: integer); overload; virtual; abstract;
68 procedure ExecImmediate(TPB: array of byte; sql: string; aSQLDialect: integer); overload;
69 procedure ExecImmediate(transaction: ITransaction; sql: string); overload;
70 procedure ExecImmediate(TPB: array of byte; sql: string); overload;
71 function ExecuteSQL(TPB: array of byte; sql: string; SQLDialect: integer; params: array of const): IResults; overload;
72 function ExecuteSQL(transaction: ITransaction; sql: string; SQLDialect: integer; params: array of const): IResults; overload;
73 function ExecuteSQL(TPB: array of byte; sql: string; params: array of const): IResults; overload;
74 function ExecuteSQL(transaction: ITransaction; sql: string; params: array of const): IResults; overload;
75 function OpenCursor(transaction: ITransaction; sql: string; aSQLDialect: integer): IResultSet; overload;
76 function OpenCursor(transaction: ITransaction; sql: string; aSQLDialect: integer;
77 params: array of const): IResultSet; overload;
78 function OpenCursor(transaction: ITransaction; sql: string): IResultSet; overload;
79 function OpenCursor(transaction: ITransaction; sql: string;
80 params: array of const): IResultSet; overload;
81 function OpenCursorAtStart(transaction: ITransaction; sql: string; aSQLDialect: integer): IResultSet; overload;
82 function OpenCursorAtStart(transaction: ITransaction; sql: string; aSQLDialect: integer;
83 params: array of const): IResultSet; overload;
84 function OpenCursorAtStart(transaction: ITransaction; sql: string): IResultSet; overload;
85 function OpenCursorAtStart(transaction: ITransaction; sql: string;
86 params: array of const): IResultSet; overload;
87 function OpenCursorAtStart(sql: string): IResultSet; overload;
88 function OpenCursorAtStart(sql: string;
89 params: array of const): IResultSet; overload;
90 function Prepare(transaction: ITransaction; sql: string; aSQLDialect: integer): IStatement; overload; virtual; abstract;
91 function Prepare(transaction: ITransaction; sql: string): IStatement; overload;
92 function PrepareWithNamedParameters(transaction: ITransaction; sql: string;
93 aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; overload; virtual; abstract;
94 function PrepareWithNamedParameters(transaction: ITransaction; sql: string;
95 GenerateParamNames: boolean=false): IStatement; overload;
96 function GetEventHandler(Events: TStrings): IEvents; overload; virtual; abstract;
97 function GetEventHandler(Event: string): IEvents; overload;
98
99 function GetSQLDialect: integer;
100 function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; virtual; abstract; overload;
101 function OpenBlob(transaction: ITransaction; Field: ISQLData; BPB: IBPB=nil): IBlob; overload;
102 property SQLDialect: integer read FSQLDialect;
103 property HasDefaultCharSet: boolean read FHasDefaultCharSet;
104 property CharSetID: integer read FCharSetID;
105 property CodePage: TSystemCodePage read FCodePage;
106 property DPB: IDPB read FDPB;
107 end;
108
109 implementation
110
111 uses FBMessages, FBTransaction;
112
113 { TFBAttachment }
114
115 constructor TFBAttachment.Create(DatabaseName: string; DPB: IDPB;
116 RaiseExceptionOnConnectError: boolean);
117 begin
118 inherited Create;
119 FFirebirdAPI := FirebirdAPI; {Keep reference to interface}
120 FSQLDialect := 3;
121 FDatabaseName := DatabaseName;
122 FDPB := DPB;
123 FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
124 end;
125
126 function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: string; aDPB: IDPB): string;
127 var CreateParams: string;
128 DPBItem: IDPBItem;
129 begin
130 CreateParams := '';
131
132 if aDPB <> nil then
133 begin
134 DPBItem := aDPB.Find(isc_dpb_user_name);
135 if DPBItem <> nil then
136 CreateParams += ' USER ''' + DPBItem.AsString + '''';
137
138 DPBItem := aDPB.Find(isc_dpb_password);
139 if DPBItem <> nil then
140 CreateParams += ' Password ''' + DPBItem.AsString + '''';
141
142 DPBItem := aDPB.Find(isc_dpb_page_size);
143 if DPBItem <> nil then
144 CreateParams += ' PAGE_SIZE ' + DPBItem.AsString;
145
146 DPBItem := aDPB.Find(isc_dpb_lc_ctype);
147 if DPBItem <> nil then
148 CreateParams += ' DEFAULT CHARACTER SET ' + DPBItem.AsString;
149
150 DPBItem := aDPB.Find(isc_dpb_sql_dialect);
151 if DPBItem <> nil then
152 FSQLDialect := DPBItem.AsInteger;
153 end;
154
155 Result := 'CREATE DATABASE ''' + DatabaseName + ''' ' + CreateParams; {do not localize}
156 end;
157
158 procedure TFBAttachment.EndAllTransactions;
159 var i: integer;
160 intf: TInterfacedObject;
161 begin
162 for i := 0 to InterfaceCount - 1 do
163 begin
164 intf := GetInterface(i);
165 if (intf <> nil) and (intf is TFBTransaction) then
166 TFBTransaction(intf).DoDefaultTransactionEnd(true);
167 end;
168 end;
169
170 procedure TFBAttachment.SetParameters(SQLParams: ISQLParams;
171 params: array of const);
172 var i: integer;
173 begin
174 if SQLParams.Count <> Length(params) then
175 IBError(ibxeInvalidParamCount,[SQLParams.Count,Length(params)]);
176
177 for i := 0 to High(params) do
178 begin
179 case params[i].vtype of
180 vtinteger :
181 SQLParams[i].AsInteger := params[i].vinteger;
182 vtboolean :
183 SQLParams[i].AsBoolean := params[i].vboolean;
184 vtchar :
185 SQLParams[i].AsString := params[i].vchar;
186 vtextended :
187 SQLParams[i].AsDouble := params[i].VExtended^;
188 vtCurrency:
189 SQLParams[i].AsDouble := params[i].VCurrency^;
190 vtString :
191 SQLParams[i].AsString := params[i].VString^;
192 vtPChar :
193 SQLParams[i].AsString := strpas(params[i].VPChar);
194 vtAnsiString :
195 SQLParams[i].AsString := AnsiString(params[i].VAnsiString^);
196 vtVariant:
197 SQLParams[i].AsVariant := params[i].VVariant^;
198 else
199 IBError(ibxeInvalidVariantType,[nil]);
200 end;
201 end;
202 end;
203
204 destructor TFBAttachment.Destroy;
205 begin
206 Disconnect(true);
207 inherited Destroy;
208 end;
209
210 function TFBAttachment.getDPB: IDPB;
211 begin
212 Result := FDPB;
213 end;
214
215 function TFBAttachment.AllocateBPB: IBPB;
216 begin
217 Result := TBPB.Create;
218 end;
219
220 procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: string;
221 aSQLDialect: integer);
222 begin
223 ExecImmediate(StartTransaction(TPB,taCommit),sql,aSQLDialect);
224 end;
225
226 procedure TFBAttachment.ExecImmediate(transaction: ITransaction; sql: string);
227 begin
228 ExecImmediate(transaction,sql,FSQLDialect);
229 end;
230
231 procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: string);
232 begin
233 ExecImmediate(StartTransaction(TPB,taCommit),sql,FSQLDialect);
234 end;
235
236 function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: string;
237 SQLDialect: integer; params: array of const): IResults;
238 begin
239 Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,FSQLDialect,params);
240 end;
241
242 function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: string;
243 SQLDialect: integer; params: array of const): IResults;
244 begin
245 with Prepare(transaction,sql,SQLDialect) do
246 begin
247 SetParameters(SQLParams,params);
248 Result := Execute;
249 end;
250 end;
251
252 function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: string;
253 params: array of const): IResults;
254 begin
255 Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,params);
256 end;
257
258 function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: string;
259 params: array of const): IResults;
260 begin
261 with Prepare(transaction,sql,FSQLDialect) do
262 begin
263 SetParameters(SQLParams,params);
264 Result := Execute;
265 end;
266 end;
267
268 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: string;
269 aSQLDialect: integer): IResultSet;
270 begin
271 Result := OpenCursor(transaction,sql,aSQLDialect,[]);
272 end;
273
274 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: string;
275 aSQLDialect: integer; params: array of const): IResultSet;
276 var Statement: IStatement;
277 begin
278 CheckHandle;
279 Statement := Prepare(transaction,sql,aSQLDialect);
280 SetParameters(Statement.SQLParams,params);
281 Result := Statement.OpenCursor;
282 end;
283
284 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: string
285 ): IResultSet;
286 begin
287 Result := OpenCursor(transaction,sql,FSQLDialect,[]);
288 end;
289
290 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: string;
291 params: array of const): IResultSet;
292 begin
293 Result := OpenCursor(transaction,sql,FSQLDialect,params);
294 end;
295
296 function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
297 sql: string; aSQLDialect: integer): IResultSet;
298 begin
299 Result := OpenCursor(transaction,sql,aSQLDialect,[]);
300 Result.FetchNext;
301 end;
302
303 function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
304 sql: string; aSQLDialect: integer; params: array of const): IResultSet;
305 begin
306 Result := OpenCursor(transaction,sql,aSQLDialect,params);
307 Result.FetchNext;
308 end;
309
310 function TFBAttachment.OpenCursorAtStart(transaction: ITransaction; sql: string
311 ): IResultSet;
312 begin
313 Result := OpenCursorAtStart(transaction,sql,FSQLDialect,[]);
314 end;
315
316 function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
317 sql: string; params: array of const): IResultSet;
318 begin
319 Result := OpenCursorAtStart(transaction,sql,FSQLDialect,params);
320 end;
321
322 function TFBAttachment.OpenCursorAtStart(sql: string): IResultSet;
323 begin
324 Result := OpenCursorAtStart(sql,[]);
325 end;
326
327 function TFBAttachment.OpenCursorAtStart(sql: string;
328 params: array of const): IResultSet;
329 begin
330 Result := OpenCursorAtStart(StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit),sql,FSQLDialect,params);
331 end;
332
333 function TFBAttachment.Prepare(transaction: ITransaction; sql: string
334 ): IStatement;
335 begin
336 Result := Prepare(transaction,sql,FSQLDialect);
337 end;
338
339 function TFBAttachment.PrepareWithNamedParameters(transaction: ITransaction;
340 sql: string; GenerateParamNames: boolean): IStatement;
341 begin
342 Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames);
343 end;
344
345 function TFBAttachment.GetEventHandler(Event: string): IEvents;
346 var S: TStringList;
347 begin
348 S := TStringList.Create;
349 try
350 S.Add(Event);
351 Result := GetEventHandler(S);
352 finally
353 S.Free;
354 end;
355 end;
356
357 function TFBAttachment.GetSQLDialect: integer;
358 begin
359 Result := FSQLDialect;
360 end;
361
362 function TFBAttachment.OpenBlob(transaction: ITransaction; Field: ISQLData;
363 BPB: IBPB): IBlob;
364 begin
365 Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
366 end;
367
368 end.
369