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

# 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 tony 117 function IsConnected: boolean; override;
65 tony 45 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 117 function GetDBInformation(Requests: array of byte): IDBInformation; overload; override;
97     function GetDBInformation(Request: byte): IDBInformation; overload; override;
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     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 tony 117 GetODSAndConnectionInfo;
198 tony 45 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 tony 56 procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
249 tony 45 aSQLDialect: integer);
250     begin
251     CheckHandle;
252     with Firebird30ClientAPI do
253     begin
254     FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
255 tony 56 Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
256 tony 45 Check4DataBaseError;
257     end;
258     end;
259    
260 tony 56 function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
261 tony 45 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 tony 56 sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
269 tony 45 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 tony 56 ColumnName: AnsiString; BPB: IBPB): IBlob;
283 tony 45 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 tony 56 ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
305 tony 45 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 tony 56 ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
321 tony 45 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 tony 56 ColumnName: AnsiString): IArray;
329 tony 45 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 tony 56 function TFB30Attachment.CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
343 tony 47 Scale: integer; size: cardinal; aCharSetID: cardinal; dimensions: cardinal;
344     bounds: TArrayBounds): IArrayMetaData;
345     begin
346 tony 60 Result := TFB30ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,aCharSetID, dimensions,bounds);
347 tony 47 end;
348    
349 tony 45 function TFB30Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
350 tony 56 columnName: AnsiString): IBlobMetaData;
351 tony 45 begin
352     CheckHandle;
353     Result := TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
354     end;
355    
356     function TFB30Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
357 tony 56 columnName: AnsiString): IArrayMetaData;
358 tony 45 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