ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/3.0/FB30Attachment.pas
Revision: 363
Committed: Tue Dec 7 13:30:05 2021 UTC (8 months ago) by tony
File size: 15473 byte(s)
Log Message:
add fbintf
Line File contents
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 FB30Attachment;
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, FBAttachment, FBClientAPI, FB30ClientAPI, Firebird, IB,
41 FBActivityMonitor, FBParamBlock;
42
43 type
44
45 { TFB30Attachment }
46
47 TFB30Attachment = class(TFBAttachment,IAttachment, IActivityMonitor)
48 private
49 FAttachmentIntf: Firebird.IAttachment;
50 FFirebird30ClientAPI: TFB30ClientAPI;
51 FTimeZoneServices: ITimeZoneServices;
52 FUsingRemoteICU: boolean;
53 procedure SetUseRemoteICU(aValue: boolean);
54 protected
55 procedure CheckHandle; override;
56 function GetAttachment: IAttachment; override;
57 public
58 constructor Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
59 RaiseExceptionOnConnectError: boolean);
60 constructor CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
61 constructor CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
62 RaiseExceptionOnError: boolean); overload;
63 destructor Destroy; override;
64 function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
65 override;
66 property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf;
67 property Firebird30ClientAPI: TFB30ClientAPI read FFirebird30ClientAPI;
68
69 public
70 {IAttachment}
71 procedure Connect;
72 procedure Disconnect(Force: boolean=false); override;
73 function IsConnected: boolean; override;
74 procedure DropDatabase;
75 function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion; aName: AnsiString=''): ITransaction; override;
76 function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion; aName: AnsiString=''): ITransaction; override;
77 procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); override;
78 function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''): IStatement; override;
79 function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
80 aSQLDialect: integer; GenerateParamNames: boolean=false;
81 CaseSensitiveParams: boolean=false; CursorName: AnsiString=''): IStatement; override;
82
83 {Events}
84 function GetEventHandler(Events: TStrings): IEvents; override;
85
86 {Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}
87
88 function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; override;
89 function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
90 function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; override;
91
92 {Array}
93 function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; override;
94 function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; override;
95 function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString;
96 columnName: AnsiString; Scale: integer; size: cardinal; aCharSetID: cardinal;
97 dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
98
99
100 {Database Information}
101 function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; override;
102 function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; override;
103 procedure getFBVersion(version: TStrings);
104 function HasDecFloatSupport: boolean; override;
105 function HasBatchMode: boolean; override;
106 function HasScollableCursors: boolean;
107
108 {Time Zone Support}
109 function GetTimeZoneServices: ITimeZoneServices; override;
110 function HasTimeZoneSupport: boolean; override;
111 end;
112
113 implementation
114
115 uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
116 FBOutputBlock, FB30Events, IBUtils, FB30TimeZoneServices;
117
118 type
119 { TVersionCallback }
120
121 TVersionCallback = class(Firebird.IVersionCallbackImpl)
122 private
123 FOutput: TStrings;
124 FFirebirdClientAPI: TFBClientAPI;
125 public
126 constructor Create(FirebirdClientAPI: TFBClientAPI; output: TStrings);
127 procedure callback(status: Firebird.IStatus; text: PAnsiChar); override;
128 end;
129
130 { TVersionCallback }
131
132 constructor TVersionCallback.Create(FirebirdClientAPI: TFBClientAPI;
133 output: TStrings);
134 begin
135 inherited Create;
136 FFirebirdClientAPI := FirebirdClientAPI;
137 FOutput := output;
138 end;
139
140 procedure TVersionCallback.callback(status: Firebird.IStatus; text: PAnsiChar);
141 var StatusObj: TFB30StatusObject;
142 begin
143 if ((status.getState and status.STATE_ERRORS) <> 0) then
144 begin
145 StatusObj := TFB30StatusObject.Create(FFirebirdClientAPI,status);
146 try
147 raise EIBInterBaseError.Create(StatusObj);
148 finally
149 StatusObj.Free;
150 end;
151 end;
152 FOutput.Add(text);
153 end;
154
155
156 { TFB30Attachment }
157
158 procedure TFB30Attachment.SetUseRemoteICU(aValue: boolean);
159 begin
160 if (FUsingRemoteICU <> aValue) and (GetODSMajorVersion >= 13) then
161 begin
162 if aValue then
163 ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO EXTENDED')
164 else
165 ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_concurrency],'SET BIND OF TIME ZONE TO NATIVE');
166 FUsingRemoteICU := aValue;
167 end;
168 end;
169
170 procedure TFB30Attachment.CheckHandle;
171 begin
172 if FAttachmentIntf = nil then
173 IBError(ibxeDatabaseClosed,[nil]);
174 end;
175
176 function TFB30Attachment.GetAttachment: IAttachment;
177 begin
178 Result := self;
179 end;
180
181 constructor TFB30Attachment.Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
182 RaiseExceptionOnConnectError: boolean);
183 begin
184 FFirebird30ClientAPI := api;
185 if aDPB = nil then
186 begin
187 if RaiseExceptionOnConnectError then
188 IBError(ibxeNoDPB,[nil]);
189 Exit;
190 end;
191 inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
192 Connect;
193 end;
194
195 constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
196 RaiseExceptionOnError: boolean);
197 var Param: IDPBItem;
198 sql: AnsiString;
199 IsCreateDB: boolean;
200 begin
201 inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
202 FFirebird30ClientAPI := api;
203 IsCreateDB := true;
204 if aDPB <> nil then
205 begin
206 Param := aDPB.Find(isc_dpb_set_db_SQL_dialect);
207 if Param <> nil then
208 FSQLDialect := Param.AsByte;
209 end;
210 sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
211 with FFirebird30ClientAPI do
212 begin
213 FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
214 PAnsiChar(sql),FSQLDialect,@IsCreateDB);
215 if FRaiseExceptionOnConnectError then Check4DataBaseError;
216 if InErrorState then
217 FAttachmentIntf := nil
218 else
219 if aDPB <> nil then
220 {Connect using known parameters}
221 begin
222 Disconnect;
223 Connect;
224 end
225 else
226 GetODSAndConnectionInfo;
227 end;
228 end;
229
230 constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
231 RaiseExceptionOnError: boolean);
232 var IsCreateDB: boolean;
233 begin
234 inherited Create(api,'',nil,RaiseExceptionOnError);
235 FFirebird30ClientAPI := api;
236 FSQLDialect := aSQLDialect;
237 with FFirebird30ClientAPI do
238 begin
239 FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
240 PAnsiChar(sql),aSQLDialect,@IsCreateDB);
241 if FRaiseExceptionOnConnectError then Check4DataBaseError;
242 if InErrorState then
243 FAttachmentIntf := nil;
244 end;
245 GetODSAndConnectionInfo;
246 ExtractConnectString(sql,FDatabaseName);
247 DPBFromCreateSQL(sql);
248 end;
249
250 destructor TFB30Attachment.Destroy;
251 begin
252 inherited Destroy;
253 if assigned(FAttachmentIntf) then
254 FAttachmentIntf.release;
255 end;
256
257 function TFB30Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
258 begin
259 Result := TDBInformation.Create(Firebird30ClientAPI);
260 with FFirebird30ClientAPI, Result as TDBInformation do
261 begin
262 FAttachmentIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
263 getBufSize, BytePtr(Buffer));
264 Check4DataBaseError;
265 end
266 end;
267
268 procedure TFB30Attachment.Connect;
269 begin
270 with FFirebird30ClientAPI do
271 begin
272 FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
273 (DPB as TDPB).getDataLength,
274 BytePtr((DPB as TDPB).getBuffer));
275 if FRaiseExceptionOnConnectError then Check4DataBaseError;
276 if InErrorState then
277 FAttachmentIntf := nil
278 else
279 GetODSAndConnectionInfo;
280
281 end;
282 end;
283
284 procedure TFB30Attachment.Disconnect(Force: boolean);
285 begin
286 inherited Disconnect(Force);
287 if IsConnected then
288 with FFirebird30ClientAPI do
289 begin
290 EndAllTransactions;
291 FAttachmentIntf.Detach(StatusIntf);
292 if not Force and InErrorState then
293 IBDataBaseError;
294 FAttachmentIntf := nil;
295 FHasDefaultCharSet := false;
296 FCodePage := CP_NONE;
297 FCharSetID := 0;
298 FTimeZoneServices := nil;
299 end;
300 end;
301
302 function TFB30Attachment.IsConnected: boolean;
303 begin
304 Result := FAttachmentIntf <> nil;
305 end;
306
307 procedure TFB30Attachment.DropDatabase;
308 begin
309 if IsConnected then
310 with FFirebird30ClientAPI do
311 begin
312 EndAllTransactions;
313 EndSession(false);
314 FAttachmentIntf.dropDatabase(StatusIntf);
315 Check4DataBaseError;
316 FAttachmentIntf := nil;
317 end;
318 end;
319
320 function TFB30Attachment.StartTransaction(TPB: array of byte;
321 DefaultCompletion: TTransactionCompletion; aName: AnsiString): ITransaction;
322 begin
323 CheckHandle;
324 Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion, aName);
325 end;
326
327 function TFB30Attachment.StartTransaction(TPB: ITPB;
328 DefaultCompletion: TTransactionCompletion; aName: AnsiString): ITransaction;
329 begin
330 CheckHandle;
331 Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion,aName);
332 end;
333
334 procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
335 aSQLDialect: integer);
336 begin
337 CheckHandle;
338 with FFirebird30ClientAPI do
339 begin
340 FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
341 Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
342 Check4DataBaseError;
343 end;
344 end;
345
346 function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
347 aSQLDialect: integer; CursorName: AnsiString): IStatement;
348 begin
349 CheckHandle;
350 Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect,CursorName);
351 end;
352
353 function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
354 sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
355 CaseSensitiveParams: boolean; CursorName: AnsiString): IStatement;
356 begin
357 CheckHandle;
358 Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
359 GenerateParamNames,CaseSensitiveParams,CursorName);
360 end;
361
362 function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
363 begin
364 CheckHandle;
365 Result := TFB30Events.Create(self,Events);
366 end;
367
368 function TFB30Attachment.CreateBlob(transaction: ITransaction;
369 BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
370 begin
371 CheckHandle;
372 Result := TFB30Blob.Create(self,transaction as TFB30Transaction, BlobMetaData,BPB);
373 end;
374
375 function TFB30Attachment.CreateBlob(transaction: ITransaction;
376 SubType: integer; aCharSetID: cardinal; BPB: IBPB): IBlob;
377 begin
378 CheckHandle;
379 Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
380 end;
381
382 function TFB30Attachment.OpenBlob(transaction: ITransaction;
383 BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
384 begin
385 CheckHandle;
386 Result := TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
387 end;
388
389 function TFB30Attachment.OpenArray(transaction: ITransaction;
390 ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray;
391 begin
392 CheckHandle;
393 Result := TFB30Array.Create(self,transaction as TFB30Transaction,
394 ArrayMetaData,ArrayID);
395 end;
396
397 function TFB30Attachment.CreateArray(transaction: ITransaction;
398 ArrayMetaData: IArrayMetaData): IArray;
399 begin
400 CheckHandle;
401 Result := TFB30Array.Create(self,transaction as TFB30Transaction,ArrayMetaData);
402 end;
403
404 function TFB30Attachment.CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
405 Scale: integer; size: cardinal; aCharSetID: cardinal; dimensions: cardinal;
406 bounds: TArrayBounds): IArrayMetaData;
407 begin
408 Result := TFB30ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,aCharSetID, dimensions,bounds);
409 end;
410
411 function TFB30Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
412 columnName: AnsiString): IBlobMetaData;
413 begin
414 CheckHandle;
415 Result := TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
416 end;
417
418 function TFB30Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
419 columnName: AnsiString): IArrayMetaData;
420 begin
421 CheckHandle;
422 Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
423 end;
424
425 procedure TFB30Attachment.getFBVersion(version: TStrings);
426 var bufferObj: TVersionCallback;
427 begin
428 version.Clear;
429 bufferObj := TVersionCallback.Create(Firebird30ClientAPI,version);
430 try
431 with FFirebird30ClientAPI do
432 begin
433 UtilIntf.getFbVersion(StatusIntf,FAttachmentIntf,bufferObj);
434 Check4DataBaseError;
435 end;
436 finally
437 bufferObj.Free;
438 end;
439 end;
440
441 function TFB30Attachment.HasDecFloatSupport: boolean;
442 begin
443 Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
444 (GetODSMajorVersion >= 13);
445 end;
446
447 function TFB30Attachment.HasBatchMode: boolean;
448 begin
449 Result := FFirebird30ClientAPI.Firebird4orLater and
450 (GetODSMajorVersion >= 13);
451 end;
452
453 function TFB30Attachment.HasScollableCursors: boolean;
454 begin
455 Result := (GetODSMajorVersion >= 12);
456 end;
457
458 function TFB30Attachment.GetTimeZoneServices: ITimeZoneServices;
459 begin
460 if not HasTimeZoneSupport then
461 IBError(ibxeNotSupported,[]);
462
463 if FTimeZoneServices = nil then
464 FTimeZoneServices := TFB30TimeZoneServices.Create(self);
465 Result := FTimeZoneServices;
466 end;
467
468 function TFB30Attachment.HasTimeZoneSupport: boolean;
469 begin
470 Result := (FFirebird30ClientAPI.GetClientMajor >= 4) and
471 (GetODSMajorVersion >= 13);
472 end;
473
474 end.
475