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