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: 263
Committed: Thu Dec 6 15:55:01 2018 UTC (5 years, 3 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/3.0/FB30Attachment.pas
File size: 13201 byte(s)
Log Message:
Release 2.3.2 committed

File Contents

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