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: 143
Committed: Fri Feb 23 12:11:21 2018 UTC (6 years, 9 months ago) by tony
Content type: text/x-pascal
File size: 12778 byte(s)
Log Message:
Fixes Merged

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 tony 143 function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
59     override;
60 tony 45 property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf;
61    
62     public
63     {IAttachment}
64     procedure Connect;
65     procedure Disconnect(Force: boolean=false); override;
66 tony 117 function IsConnected: boolean; override;
67 tony 45 procedure DropDatabase;
68     function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
69     function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
70 tony 56 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 tony 45 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 tony 56 function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
81 tony 45 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 tony 56 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 tony 45
86     {Array}
87 tony 56 function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
88     function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray; overload;
89 tony 45 function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
90 tony 56 function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString;
91     columnName: AnsiString; Scale: integer; size: cardinal; aCharSetID: cardinal;
92 tony 47 dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
93 tony 45
94 tony 47
95 tony 45 {Database Information}
96 tony 56 function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
97     function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
98 tony 45 end;
99    
100     implementation
101    
102     uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
103 tony 117 FBOutputBlock, FB30Events, IBUtils;
104 tony 45
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 tony 117 end
155     else
156     GetODSAndConnectionInfo;
157 tony 45 end;
158     end;
159    
160 tony 56 constructor TFB30Attachment.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
161 tony 47 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 tony 117 GetODSAndConnectionInfo;
175     ExtractConnectString(sql,FDatabaseName);
176     DPBFromCreateSQL(sql);
177 tony 47 end;
178    
179 tony 45 destructor TFB30Attachment.Destroy;
180     begin
181     inherited Destroy;
182     if assigned(FAttachmentIntf) then
183     FAttachmentIntf.release;
184     end;
185    
186 tony 143 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 tony 45 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 tony 117 GetODSAndConnectionInfo;
209 tony 45 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 tony 56 procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
260 tony 45 aSQLDialect: integer);
261     begin
262     CheckHandle;
263     with Firebird30ClientAPI do
264     begin
265     FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
266 tony 56 Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
267 tony 45 Check4DataBaseError;
268     end;
269     end;
270    
271 tony 56 function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
272 tony 45 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 tony 56 sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
280 tony 45 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 tony 56 ColumnName: AnsiString; BPB: IBPB): IBlob;
294 tony 45 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 tony 56 ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
316 tony 45 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 tony 56 ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
332 tony 45 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 tony 56 ColumnName: AnsiString): IArray;
340 tony 45 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 tony 56 function TFB30Attachment.CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
354 tony 47 Scale: integer; size: cardinal; aCharSetID: cardinal; dimensions: cardinal;
355     bounds: TArrayBounds): IArrayMetaData;
356     begin
357 tony 60 Result := TFB30ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,aCharSetID, dimensions,bounds);
358 tony 47 end;
359    
360 tony 45 function TFB30Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
361 tony 56 columnName: AnsiString): IBlobMetaData;
362 tony 45 begin
363     CheckHandle;
364     Result := TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
365     end;
366    
367     function TFB30Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
368 tony 56 columnName: AnsiString): IArrayMetaData;
369 tony 45 begin
370     CheckHandle;
371     Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
372     end;
373    
374     end.
375