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: 143
Committed: Fri Feb 23 12:11:21 2018 UTC (6 years, 1 month ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/3.0/FB30Attachment.pas
File size: 12778 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 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 function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
59 override;
60 property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf;
61
62 public
63 {IAttachment}
64 procedure Connect;
65 procedure Disconnect(Force: boolean=false); override;
66 function IsConnected: boolean; override;
67 procedure DropDatabase;
68 function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
69 function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
70 procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); override;
71 function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; override;
72 function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
73 aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; override;
74
75 {Events}
76 function GetEventHandler(Events: TStrings): IEvents; override;
77
78 {Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}
79
80 function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
81 function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
82 function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
83 function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
84 function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; override;
85
86 {Array}
87 function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
88 function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray; overload;
89 function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
90 function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString;
91 columnName: AnsiString; Scale: integer; size: cardinal; aCharSetID: cardinal;
92 dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
93
94
95 {Database Information}
96 function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
97 function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
98 end;
99
100 implementation
101
102 uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
103 FBOutputBlock, FB30Events, IBUtils;
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 else
156 GetODSAndConnectionInfo;
157 end;
158 end;
159
160 constructor TFB30Attachment.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
161 RaiseExceptionOnError: boolean);
162 var IsCreateDB: boolean;
163 begin
164 inherited Create('',nil,RaiseExceptionOnError);
165 FSQLDialect := aSQLDialect;
166 with Firebird30ClientAPI do
167 begin
168 FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
169 PAnsiChar(sql),aSQLDialect,@IsCreateDB);
170 if FRaiseExceptionOnConnectError then Check4DataBaseError;
171 if InErrorState then
172 FAttachmentIntf := nil;
173 end;
174 GetODSAndConnectionInfo;
175 ExtractConnectString(sql,FDatabaseName);
176 DPBFromCreateSQL(sql);
177 end;
178
179 destructor TFB30Attachment.Destroy;
180 begin
181 inherited Destroy;
182 if assigned(FAttachmentIntf) then
183 FAttachmentIntf.release;
184 end;
185
186 function TFB30Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
187 begin
188 Result := TDBInformation.Create;
189 with Firebird30ClientAPI, Result as TDBInformation do
190 begin
191 FAttachmentIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
192 getBufSize, BytePtr(Buffer));
193 Check4DataBaseError;
194 end
195 end;
196
197 procedure TFB30Attachment.Connect;
198 begin
199 with Firebird30ClientAPI do
200 begin
201 FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
202 (DPB as TDPB).getDataLength,
203 BytePtr((DPB as TDPB).getBuffer));
204 if FRaiseExceptionOnConnectError then Check4DataBaseError;
205 if InErrorState then
206 FAttachmentIntf := nil
207 else
208 GetODSAndConnectionInfo;
209 end;
210 end;
211
212 procedure TFB30Attachment.Disconnect(Force: boolean);
213 begin
214 if IsConnected then
215 with Firebird30ClientAPI do
216 begin
217 EndAllTransactions;
218 FAttachmentIntf.Detach(StatusIntf);
219 if not Force and InErrorState then
220 IBDataBaseError;
221 FAttachmentIntf := nil;
222 FHasDefaultCharSet := false;
223 FCodePage := CP_NONE;
224 FCharSetID := 0;
225 end;
226 end;
227
228 function TFB30Attachment.IsConnected: boolean;
229 begin
230 Result := FAttachmentIntf <> nil;
231 end;
232
233 procedure TFB30Attachment.DropDatabase;
234 begin
235 if IsConnected then
236 with Firebird30ClientAPI do
237 begin
238 EndAllTransactions;
239 FAttachmentIntf.dropDatabase(StatusIntf);
240 Check4DataBaseError;
241 FAttachmentIntf := nil;
242 end;
243 end;
244
245 function TFB30Attachment.StartTransaction(TPB: array of byte;
246 DefaultCompletion: TTransactionCompletion): ITransaction;
247 begin
248 CheckHandle;
249 Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
250 end;
251
252 function TFB30Attachment.StartTransaction(TPB: ITPB;
253 DefaultCompletion: TTransactionCompletion): ITransaction;
254 begin
255 CheckHandle;
256 Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
257 end;
258
259 procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
260 aSQLDialect: integer);
261 begin
262 CheckHandle;
263 with Firebird30ClientAPI do
264 begin
265 FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
266 Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
267 Check4DataBaseError;
268 end;
269 end;
270
271 function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
272 aSQLDialect: integer): IStatement;
273 begin
274 CheckHandle;
275 Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect);
276 end;
277
278 function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
279 sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
280 begin
281 CheckHandle;
282 Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
283 GenerateParamNames);
284 end;
285
286 function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
287 begin
288 CheckHandle;
289 Result := TFB30Events.Create(self,Events);
290 end;
291
292 function TFB30Attachment.CreateBlob(transaction: ITransaction; RelationName,
293 ColumnName: AnsiString; BPB: IBPB): IBlob;
294 begin
295 CheckHandle;
296 Result := TFB30Blob.Create(self,transaction as TFB30Transaction,
297 TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),BPB);
298 end;
299
300 function TFB30Attachment.CreateBlob(transaction: ITransaction;
301 BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
302 begin
303 CheckHandle;
304 Result := TFB30Blob.Create(self,transaction as TFB30Transaction, BlobMetaData,BPB);
305 end;
306
307 function TFB30Attachment.CreateBlob(transaction: ITransaction;
308 SubType: integer; aCharSetID: cardinal; BPB: IBPB): IBlob;
309 begin
310 CheckHandle;
311 Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
312 end;
313
314 function TFB30Attachment.OpenBlob(transaction: ITransaction; RelationName,
315 ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
316 begin
317 CheckHandle;
318 Result := TFB30Blob.Create(self,transaction as TFB30transaction,
319 TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),
320 BlobID,BPB);
321 end;
322
323 function TFB30Attachment.OpenBlob(transaction: ITransaction;
324 BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
325 begin
326 CheckHandle;
327 Result := TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
328 end;
329
330 function TFB30Attachment.OpenArray(transaction: ITransaction; RelationName,
331 ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
332 begin
333 CheckHandle;
334 Result := TFB30Array.Create(self,transaction as TFB30Transaction,
335 GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
336 end;
337
338 function TFB30Attachment.CreateArray(transaction: ITransaction; RelationName,
339 ColumnName: AnsiString): IArray;
340 begin
341 CheckHandle;
342 Result := TFB30Array.Create(self,transaction as TFB30Transaction,
343 GetArrayMetaData(transaction,RelationName,ColumnName));
344 end;
345
346 function TFB30Attachment.CreateArray(transaction: ITransaction;
347 ArrayMetaData: IArrayMetaData): IArray;
348 begin
349 CheckHandle;
350 Result := TFB30Array.Create(self,transaction as TFB30Transaction,ArrayMetaData);
351 end;
352
353 function TFB30Attachment.CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
354 Scale: integer; size: cardinal; aCharSetID: cardinal; dimensions: cardinal;
355 bounds: TArrayBounds): IArrayMetaData;
356 begin
357 Result := TFB30ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,aCharSetID, dimensions,bounds);
358 end;
359
360 function TFB30Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
361 columnName: AnsiString): IBlobMetaData;
362 begin
363 CheckHandle;
364 Result := TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
365 end;
366
367 function TFB30Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
368 columnName: AnsiString): IArrayMetaData;
369 begin
370 CheckHandle;
371 Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
372 end;
373
374 end.
375