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

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 {$IFDEF MSWINDOWS}
29 {$DEFINE WINDOWS}
30 {$ENDIF}
31
32 {$IFDEF FPC}
33 {$mode delphi}
34 {$interfaces COM}
35 {$ENDIF}
36
37 interface
38
39 uses
40 Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor;
41
42 type
43
44 { TFBAttachment }
45
46 TFBAttachment = class(TActivityHandler)
47 private
48 FDPB: IDPB;
49 FFirebirdAPI: IFirebirdAPI;
50 protected
51 FDatabaseName: AnsiString;
52 FRaiseExceptionOnConnectError: boolean;
53 FSQLDialect: integer;
54 FHasDefaultCharSet: boolean;
55 FCharSetID: integer;
56 FCodePage: TSystemCodePage;
57 constructor Create(DatabaseName: AnsiString; DPB: IDPB;
58 RaiseExceptionOnConnectError: boolean);
59 procedure CheckHandle; virtual; abstract;
60 function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
61 procedure EndAllTransactions;
62 procedure SetParameters(SQLParams: ISQLParams; params: array of const);
63 public
64 destructor Destroy; override;
65 function getDPB: IDPB;
66 function AllocateBPB: IBPB;
67 function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
68 function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
69 procedure Disconnect(Force: boolean=false); virtual; abstract;
70 procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); overload; virtual; abstract;
71 procedure ExecImmediate(TPB: array of byte; sql: AnsiString; aSQLDialect: integer); overload;
72 procedure ExecImmediate(transaction: ITransaction; sql: AnsiString); overload;
73 procedure ExecImmediate(TPB: array of byte; sql: AnsiString); overload;
74 function ExecuteSQL(TPB: array of byte; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
75 function ExecuteSQL(transaction: ITransaction; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
76 function ExecuteSQL(TPB: array of byte; sql: AnsiString; params: array of const): IResults; overload;
77 function ExecuteSQL(transaction: ITransaction; sql: AnsiString; params: array of const): IResults; overload;
78 function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
79 function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
80 params: array of const): IResultSet; overload;
81 function OpenCursor(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
82 function OpenCursor(transaction: ITransaction; sql: AnsiString;
83 params: array of const): IResultSet; overload;
84 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
85 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
86 params: array of const): IResultSet; overload;
87 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
88 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString;
89 params: array of const): IResultSet; overload;
90 function OpenCursorAtStart(sql: AnsiString): IResultSet; overload;
91 function OpenCursorAtStart(sql: AnsiString;
92 params: array of const): IResultSet; overload;
93 function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; overload; virtual; abstract;
94 function Prepare(transaction: ITransaction; sql: AnsiString): IStatement; overload;
95 function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
96 aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; overload; virtual; abstract;
97 function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
98 GenerateParamNames: boolean=false): IStatement; overload;
99 function GetEventHandler(Events: TStrings): IEvents; overload; virtual; abstract;
100 function GetEventHandler(Event: AnsiString): IEvents; overload;
101
102 function GetSQLDialect: integer;
103 function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
104 function OpenBlob(transaction: ITransaction; Field: ISQLData; BPB: IBPB=nil): IBlob; overload;
105 property SQLDialect: integer read FSQLDialect;
106 property HasDefaultCharSet: boolean read FHasDefaultCharSet;
107 property CharSetID: integer read FCharSetID;
108 property CodePage: TSystemCodePage read FCodePage;
109 property DPB: IDPB read FDPB;
110 end;
111
112 implementation
113
114 uses FBMessages, FBTransaction;
115
116 { TFBAttachment }
117
118 constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB;
119 RaiseExceptionOnConnectError: boolean);
120 begin
121 inherited Create;
122 FFirebirdAPI := FirebirdAPI; {Keep reference to interface}
123 FSQLDialect := 3;
124 FDatabaseName := DatabaseName;
125 FDPB := DPB;
126 FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
127 end;
128
129 function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
130 var CreateParams: AnsiString;
131 DPBItem: IDPBItem;
132 begin
133 CreateParams := '';
134
135 if aDPB <> nil then
136 begin
137 DPBItem := aDPB.Find(isc_dpb_user_name);
138 if DPBItem <> nil then
139 CreateParams := CreateParams + ' USER ''' + DPBItem.AsString + '''';
140
141 DPBItem := aDPB.Find(isc_dpb_password);
142 if DPBItem <> nil then
143 CreateParams := CreateParams + ' Password ''' + DPBItem.AsString + '''';
144
145 DPBItem := aDPB.Find(isc_dpb_page_size);
146 if DPBItem <> nil then
147 CreateParams := CreateParams + ' PAGE_SIZE ' + DPBItem.AsString;
148
149 DPBItem := aDPB.Find(isc_dpb_lc_ctype);
150 if DPBItem <> nil then
151 CreateParams := CreateParams + ' DEFAULT CHARACTER SET ' + DPBItem.AsString;
152
153 DPBItem := aDPB.Find(isc_dpb_sql_dialect);
154 if DPBItem <> nil then
155 FSQLDialect := DPBItem.AsInteger;
156 end;
157
158 Result := 'CREATE DATABASE ''' + DatabaseName + ''' ' + CreateParams; {do not localize}
159 end;
160
161 procedure TFBAttachment.EndAllTransactions;
162 var i: integer;
163 intf: TInterfacedObject;
164 begin
165 for i := 0 to InterfaceCount - 1 do
166 begin
167 intf := GetInterface(i);
168 if (intf <> nil) and (intf is TFBTransaction) then
169 TFBTransaction(intf).DoDefaultTransactionEnd(true);
170 end;
171 end;
172
173 procedure TFBAttachment.SetParameters(SQLParams: ISQLParams;
174 params: array of const);
175 var i: integer;
176 begin
177 if SQLParams.Count <> Length(params) then
178 IBError(ibxeInvalidParamCount,[SQLParams.Count,Length(params)]);
179
180 for i := 0 to High(params) do
181 begin
182 case params[i].vtype of
183 vtinteger :
184 SQLParams[i].AsInteger := params[i].vinteger;
185 vtboolean :
186 SQLParams[i].AsBoolean := params[i].vboolean;
187 vtchar :
188 SQLParams[i].AsString := params[i].vchar;
189 vtextended :
190 SQLParams[i].AsDouble := params[i].VExtended^;
191 vtCurrency:
192 SQLParams[i].AsDouble := params[i].VCurrency^;
193 vtString :
194 SQLParams[i].AsString := params[i].VString^;
195 vtPChar :
196 SQLParams[i].AsString := strpas(params[i].VPChar);
197 vtAnsiString :
198 SQLParams[i].AsString := AnsiString(params[i].VAnsiString^);
199 vtVariant:
200 SQLParams[i].AsVariant := params[i].VVariant^;
201 else
202 IBError(ibxeInvalidVariantType,[nil]);
203 end;
204 end;
205 end;
206
207 destructor TFBAttachment.Destroy;
208 begin
209 Disconnect(true);
210 inherited Destroy;
211 end;
212
213 function TFBAttachment.getDPB: IDPB;
214 begin
215 Result := FDPB;
216 end;
217
218 function TFBAttachment.AllocateBPB: IBPB;
219 begin
220 Result := TBPB.Create;
221 end;
222
223 procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString;
224 aSQLDialect: integer);
225 begin
226 ExecImmediate(StartTransaction(TPB,taCommit),sql,aSQLDialect);
227 end;
228
229 procedure TFBAttachment.ExecImmediate(transaction: ITransaction; sql: AnsiString);
230 begin
231 ExecImmediate(transaction,sql,FSQLDialect);
232 end;
233
234 procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString);
235 begin
236 ExecImmediate(StartTransaction(TPB,taCommit),sql,FSQLDialect);
237 end;
238
239 function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
240 SQLDialect: integer; params: array of const): IResults;
241 begin
242 Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,FSQLDialect,params);
243 end;
244
245 function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
246 SQLDialect: integer; params: array of const): IResults;
247 begin
248 with Prepare(transaction,sql,SQLDialect) do
249 begin
250 SetParameters(SQLParams,params);
251 Result := Execute;
252 end;
253 end;
254
255 function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
256 params: array of const): IResults;
257 begin
258 Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,params);
259 end;
260
261 function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
262 params: array of const): IResults;
263 begin
264 with Prepare(transaction,sql,FSQLDialect) do
265 begin
266 SetParameters(SQLParams,params);
267 Result := Execute;
268 end;
269 end;
270
271 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
272 aSQLDialect: integer): IResultSet;
273 begin
274 Result := OpenCursor(transaction,sql,aSQLDialect,[]);
275 end;
276
277 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
278 aSQLDialect: integer; params: array of const): IResultSet;
279 var Statement: IStatement;
280 begin
281 CheckHandle;
282 Statement := Prepare(transaction,sql,aSQLDialect);
283 SetParameters(Statement.SQLParams,params);
284 Result := Statement.OpenCursor;
285 end;
286
287 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString
288 ): IResultSet;
289 begin
290 Result := OpenCursor(transaction,sql,FSQLDialect,[]);
291 end;
292
293 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
294 params: array of const): IResultSet;
295 begin
296 Result := OpenCursor(transaction,sql,FSQLDialect,params);
297 end;
298
299 function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
300 sql: AnsiString; aSQLDialect: integer): IResultSet;
301 begin
302 Result := OpenCursor(transaction,sql,aSQLDialect,[]);
303 Result.FetchNext;
304 end;
305
306 function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
307 sql: AnsiString; aSQLDialect: integer; params: array of const): IResultSet;
308 begin
309 Result := OpenCursor(transaction,sql,aSQLDialect,params);
310 Result.FetchNext;
311 end;
312
313 function TFBAttachment.OpenCursorAtStart(transaction: ITransaction; sql: AnsiString
314 ): IResultSet;
315 begin
316 Result := OpenCursorAtStart(transaction,sql,FSQLDialect,[]);
317 end;
318
319 function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
320 sql: AnsiString; params: array of const): IResultSet;
321 begin
322 Result := OpenCursorAtStart(transaction,sql,FSQLDialect,params);
323 end;
324
325 function TFBAttachment.OpenCursorAtStart(sql: AnsiString): IResultSet;
326 begin
327 Result := OpenCursorAtStart(sql,[]);
328 end;
329
330 function TFBAttachment.OpenCursorAtStart(sql: AnsiString;
331 params: array of const): IResultSet;
332 begin
333 Result := OpenCursorAtStart(StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit),sql,FSQLDialect,params);
334 end;
335
336 function TFBAttachment.Prepare(transaction: ITransaction; sql: AnsiString
337 ): IStatement;
338 begin
339 Result := Prepare(transaction,sql,FSQLDialect);
340 end;
341
342 function TFBAttachment.PrepareWithNamedParameters(transaction: ITransaction;
343 sql: AnsiString; GenerateParamNames: boolean): IStatement;
344 begin
345 Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames);
346 end;
347
348 function TFBAttachment.GetEventHandler(Event: AnsiString): IEvents;
349 var S: TStringList;
350 begin
351 S := TStringList.Create;
352 try
353 S.Add(Event);
354 Result := GetEventHandler(S);
355 finally
356 S.Free;
357 end;
358 end;
359
360 function TFBAttachment.GetSQLDialect: integer;
361 begin
362 Result := FSQLDialect;
363 end;
364
365 function TFBAttachment.OpenBlob(transaction: ITransaction; Field: ISQLData;
366 BPB: IBPB): IBlob;
367 begin
368 Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
369 end;
370
371 end.
372