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: 56
Committed: Mon Mar 6 10:20:02 2017 UTC (7 years ago) by tony
Content type: text/x-pascal
File size: 14085 byte(s)
Log Message:
Committing updates for Trunk

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     protected
50     procedure CheckHandle; override;
51     public
52 tony 56 constructor Create(DatabaseName: AnsiString; aDPB: IDPB;
53 tony 45 RaiseExceptionOnConnectError: boolean);
54 tony 56 constructor CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
55     constructor CreateDatabase(sql: AnsiString; aSQLDialect: integer;
56 tony 47 RaiseExceptionOnError: boolean); overload;
57 tony 45 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 tony 56 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 tony 45 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 tony 56 function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
79 tony 45 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 tony 56 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 tony 45
84     {Array}
85 tony 56 function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
86     function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray; overload;
87 tony 45 function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
88 tony 56 function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString;
89     columnName: AnsiString; Scale: integer; size: cardinal; aCharSetID: cardinal;
90 tony 47 dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
91 tony 45
92 tony 47
93 tony 45 {Database Information}
94 tony 56 function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
95     function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
96 tony 45 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 tony 56 constructor TFB30Attachment.Create(DatabaseName: AnsiString; aDPB: IDPB;
114 tony 45 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 tony 56 constructor TFB30Attachment.CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB;
127 tony 45 RaiseExceptionOnError: boolean);
128     var Param: IDPBItem;
129 tony 56 sql: AnsiString;
130 tony 45 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 tony 56 constructor TFB30Attachment.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
159 tony 47 RaiseExceptionOnError: boolean);
160     var IsCreateDB: boolean;
161     info: IDBInformation;
162     ConnectionType: integer;
163 tony 56 SiteName: AnsiString;
164 tony 47 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 tony 45 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 tony 56 procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
262 tony 45 aSQLDialect: integer);
263     begin
264     CheckHandle;
265     with Firebird30ClientAPI do
266     begin
267     FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
268 tony 56 Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
269 tony 45 Check4DataBaseError;
270     end;
271     end;
272    
273 tony 56 function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
274 tony 45 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 tony 56 sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
282 tony 45 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 tony 56 ColumnName: AnsiString; BPB: IBPB): IBlob;
296 tony 45 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 tony 56 ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
318 tony 45 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 tony 56 ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
334 tony 45 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 tony 56 ColumnName: AnsiString): IArray;
342 tony 45 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 tony 56 function TFB30Attachment.CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
356 tony 47 Scale: integer; size: cardinal; aCharSetID: cardinal; dimensions: cardinal;
357     bounds: TArrayBounds): IArrayMetaData;
358     begin
359     Result := TFB30ArrayMetaData.Create(SQLType,tableName,ColumnName,Scale,size,aCharSetID, dimensions,bounds);
360     end;
361    
362 tony 45 function TFB30Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
363 tony 56 columnName: AnsiString): IBlobMetaData;
364 tony 45 begin
365     CheckHandle;
366     Result := TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
367     end;
368    
369     function TFB30Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
370 tony 56 columnName: AnsiString): IArrayMetaData;
371 tony 45 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