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: 353
Committed: Sat Oct 23 14:11:37 2021 UTC (2 years, 5 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/3.0/FB30Attachment.pas
File size: 15223 byte(s)
Log Message:
Fixes Merged

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