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: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 4 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/3.0/FB30Attachment.pas
File size: 12430 byte(s)
Log Message:
Committing updates for Release R2-0-0

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