ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/3.0/FB30Attachment.pas
Revision: 117
Committed: Mon Jan 22 13:58:11 2018 UTC (6 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 13567 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 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; override;
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; override;
97 function GetDBInformation(Request: byte): IDBInformation; overload; override;
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 procedure TFB30Attachment.Connect;
187 begin
188 with Firebird30ClientAPI do
189 begin
190 FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
191 (DPB as TDPB).getDataLength,
192 BytePtr((DPB as TDPB).getBuffer));
193 if FRaiseExceptionOnConnectError then Check4DataBaseError;
194 if InErrorState then
195 FAttachmentIntf := nil
196 else
197 GetODSAndConnectionInfo;
198 end;
199 end;
200
201 procedure TFB30Attachment.Disconnect(Force: boolean);
202 begin
203 if IsConnected then
204 with Firebird30ClientAPI do
205 begin
206 EndAllTransactions;
207 FAttachmentIntf.Detach(StatusIntf);
208 if not Force and InErrorState then
209 IBDataBaseError;
210 FAttachmentIntf := nil;
211 FHasDefaultCharSet := false;
212 FCodePage := CP_NONE;
213 FCharSetID := 0;
214 end;
215 end;
216
217 function TFB30Attachment.IsConnected: boolean;
218 begin
219 Result := FAttachmentIntf <> nil;
220 end;
221
222 procedure TFB30Attachment.DropDatabase;
223 begin
224 if IsConnected then
225 with Firebird30ClientAPI do
226 begin
227 EndAllTransactions;
228 FAttachmentIntf.dropDatabase(StatusIntf);
229 Check4DataBaseError;
230 FAttachmentIntf := nil;
231 end;
232 end;
233
234 function TFB30Attachment.StartTransaction(TPB: array of byte;
235 DefaultCompletion: TTransactionCompletion): ITransaction;
236 begin
237 CheckHandle;
238 Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
239 end;
240
241 function TFB30Attachment.StartTransaction(TPB: ITPB;
242 DefaultCompletion: TTransactionCompletion): ITransaction;
243 begin
244 CheckHandle;
245 Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
246 end;
247
248 procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
249 aSQLDialect: integer);
250 begin
251 CheckHandle;
252 with Firebird30ClientAPI do
253 begin
254 FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
255 Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
256 Check4DataBaseError;
257 end;
258 end;
259
260 function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
261 aSQLDialect: integer): IStatement;
262 begin
263 CheckHandle;
264 Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect);
265 end;
266
267 function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
268 sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
269 begin
270 CheckHandle;
271 Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
272 GenerateParamNames);
273 end;
274
275 function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
276 begin
277 CheckHandle;
278 Result := TFB30Events.Create(self,Events);
279 end;
280
281 function TFB30Attachment.CreateBlob(transaction: ITransaction; RelationName,
282 ColumnName: AnsiString; BPB: IBPB): IBlob;
283 begin
284 CheckHandle;
285 Result := TFB30Blob.Create(self,transaction as TFB30Transaction,
286 TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),BPB);
287 end;
288
289 function TFB30Attachment.CreateBlob(transaction: ITransaction;
290 BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
291 begin
292 CheckHandle;
293 Result := TFB30Blob.Create(self,transaction as TFB30Transaction, BlobMetaData,BPB);
294 end;
295
296 function TFB30Attachment.CreateBlob(transaction: ITransaction;
297 SubType: integer; aCharSetID: cardinal; BPB: IBPB): IBlob;
298 begin
299 CheckHandle;
300 Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
301 end;
302
303 function TFB30Attachment.OpenBlob(transaction: ITransaction; RelationName,
304 ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
305 begin
306 CheckHandle;
307 Result := TFB30Blob.Create(self,transaction as TFB30transaction,
308 TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),
309 BlobID,BPB);
310 end;
311
312 function TFB30Attachment.OpenBlob(transaction: ITransaction;
313 BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
314 begin
315 CheckHandle;
316 Result := TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
317 end;
318
319 function TFB30Attachment.OpenArray(transaction: ITransaction; RelationName,
320 ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
321 begin
322 CheckHandle;
323 Result := TFB30Array.Create(self,transaction as TFB30Transaction,
324 GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
325 end;
326
327 function TFB30Attachment.CreateArray(transaction: ITransaction; RelationName,
328 ColumnName: AnsiString): IArray;
329 begin
330 CheckHandle;
331 Result := TFB30Array.Create(self,transaction as TFB30Transaction,
332 GetArrayMetaData(transaction,RelationName,ColumnName));
333 end;
334
335 function TFB30Attachment.CreateArray(transaction: ITransaction;
336 ArrayMetaData: IArrayMetaData): IArray;
337 begin
338 CheckHandle;
339 Result := TFB30Array.Create(self,transaction as TFB30Transaction,ArrayMetaData);
340 end;
341
342 function TFB30Attachment.CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
343 Scale: integer; size: cardinal; aCharSetID: cardinal; dimensions: cardinal;
344 bounds: TArrayBounds): IArrayMetaData;
345 begin
346 Result := TFB30ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,aCharSetID, dimensions,bounds);
347 end;
348
349 function TFB30Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
350 columnName: AnsiString): IBlobMetaData;
351 begin
352 CheckHandle;
353 Result := TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
354 end;
355
356 function TFB30Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
357 columnName: AnsiString): IArrayMetaData;
358 begin
359 CheckHandle;
360 Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
361 end;
362
363 function TFB30Attachment.GetDBInformation(Requests: array of byte
364 ): IDBInformation;
365 var ReqBuffer: PByte;
366 i: integer;
367 begin
368 CheckHandle;
369 if Length(Requests) = 1 then
370 Result := GetDBInformation(Requests[0])
371 else
372 begin
373 Result := TDBInformation.Create;
374 GetMem(ReqBuffer,Length(Requests));
375 try
376 for i := 0 to Length(Requests) - 1 do
377 ReqBuffer[i] := Requests[i];
378
379 with Firebird30ClientAPI, Result as TDBInformation do
380 begin
381 FAttachmentIntf.getInfo(StatusIntf, Length(Requests), BytePtr(ReqBuffer),
382 getBufSize, BytePtr(Buffer));
383 Check4DataBaseError;
384 end
385
386 finally
387 FreeMem(ReqBuffer);
388 end;
389 end;
390 end;
391
392 function TFB30Attachment.GetDBInformation(Request: byte): IDBInformation;
393 begin
394 CheckHandle;
395 Result := TDBInformation.Create;
396 with Firebird30ClientAPI, Result as TDBInformation do
397 begin
398 FAttachmentIntf.getInfo(StatusIntf, 1, BytePtr(@Request),
399 getBufSize, BytePtr(Buffer));
400 Check4DataBaseError;
401 end;
402 end;
403
404 end.
405