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: 60
Committed: Mon Mar 27 15:21:02 2017 UTC (7 years ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/3.0/FB30Attachment.pas
File size: 14090 byte(s)
Log Message:

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