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: 291
Committed: Fri Apr 17 10:26:08 2020 UTC (3 years, 11 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/3.0/FB30Attachment.pas
File size: 12883 byte(s)
Log Message:
Changed for 2.3.4 merged into public release

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