ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/2.5/FB25Attachment.pas
Revision: 263
Committed: Thu Dec 6 15:55:01 2018 UTC (5 years, 11 months ago) by tony
Content type: text/x-pascal
File size: 12741 byte(s)
Log Message:
Release 2.3.2 committed

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 FB25Attachment;
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, IB, FBAttachment, FB25ClientAPI, IBHeader,
41 tony 56 FBParamBlock, FBOutputBlock, FBActivityMonitor;
42 tony 45
43     type
44     { TFB25Attachment }
45    
46     TFB25Attachment = class(TFBAttachment, IAttachment, IActivityMonitor)
47     private
48     FHandle: TISC_DB_HANDLE;
49 tony 263 FFirebird25ClientAPI: TFB25ClientAPI;
50 tony 45 protected
51     procedure CheckHandle; override;
52     public
53 tony 263 constructor Create(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
54 tony 45 RaiseExceptionOnConnectError: boolean);
55 tony 263 constructor CreateDatabase(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
56     constructor CreateDatabase(api: TFB25ClientAPI; sql: AnsiString; aSQLDialect: integer;
57 tony 47 RaiseExceptionOnError: boolean); overload;
58 tony 143 function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; override;
59 tony 45 property Handle: TISC_DB_HANDLE read FHandle;
60 tony 263 property Firebird25ClientAPI: TFB25ClientAPI read FFirebird25ClientAPI;
61 tony 45
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     function GetEventHandler(Events: TStrings): IEvents; override;
75 tony 56 function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
76 tony 45 function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
77     function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
78 tony 56 function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
79     function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; override;
80 tony 45
81 tony 56 function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString;
82 tony 45 ArrayID: TISC_QUAD): IArray;
83 tony 56 function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString
84 tony 45 ): IArray; overload;
85     function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
86 tony 56 function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
87 tony 47 Scale: integer; size: cardinal;
88     acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
89     ): IArrayMetaData;
90 tony 45
91     {Database Information}
92    
93 tony 56 function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
94     function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
95 tony 45 end;
96    
97     implementation
98    
99     uses FB25Events,FB25Transaction, FBMessages, FB25Blob,
100 tony 117 FB25Statement, FB25Array, IBUtils;
101 tony 45
102     { TFB25Attachment }
103    
104     procedure TFB25Attachment.CheckHandle;
105     begin
106     if FHandle = nil then
107     IBError(ibxeDatabaseClosed,[nil]);
108     end;
109    
110 tony 263 constructor TFB25Attachment.Create(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
111 tony 45 RaiseExceptionOnConnectError: boolean);
112     begin
113 tony 263 FFirebird25ClientAPI := api;
114 tony 45 if aDPB = nil then
115     begin
116     if RaiseExceptionOnConnectError then
117     IBError(ibxeNoDPB,[nil]);
118     Exit;
119     end;
120 tony 263 inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
121 tony 45 Connect;
122     end;
123    
124 tony 263 constructor TFB25Attachment.CreateDatabase(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
125 tony 45 RaiseExceptionOnError: boolean);
126 tony 56 var sql: AnsiString;
127 tony 45 tr_handle: TISC_TR_HANDLE;
128     begin
129 tony 263 inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
130     FFirebird25ClientAPI := api;
131 tony 45 sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
132     tr_handle := nil;
133 tony 263 with FFirebird25ClientAPI do
134 tony 56 if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PAnsiChar(sql),
135 tony 45 SQLDialect, nil) > 0) and RaiseExceptionOnError then
136     IBDataBaseError;
137     if DPB <> nil then
138     {Connect using known parameters}
139     begin
140     Disconnect;
141     Connect;
142 tony 117 end
143     else
144     GetODSAndConnectionInfo;
145 tony 45 end;
146    
147 tony 263 constructor TFB25Attachment.CreateDatabase(api: TFB25ClientAPI; sql: AnsiString; aSQLDialect: integer;
148 tony 47 RaiseExceptionOnError: boolean);
149     var tr_handle: TISC_TR_HANDLE;
150     begin
151 tony 263 inherited Create(api,'',nil,RaiseExceptionOnError);
152     FFirebird25ClientAPI := api;
153 tony 47 FSQLDialect := aSQLDialect;
154     tr_handle := nil;
155 tony 263 with FFirebird25ClientAPI do
156 tony 47 begin
157 tony 56 if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PAnsiChar(sql),
158 tony 47 aSQLDialect, nil) > 0) and RaiseExceptionOnError then
159     IBDataBaseError;
160    
161     end;
162 tony 117 GetODSAndConnectionInfo;
163     ExtractConnectString(sql,FDatabaseName);
164     DPBFromCreateSQL(sql);
165 tony 47 end;
166    
167 tony 143 function TFB25Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer
168     ): IDBInformation;
169     begin
170 tony 263 Result := TDBInformation.Create(FFirebird25ClientAPI);
171     with FFirebird25ClientAPI, Result as TDBInformation do
172 tony 143 if isc_database_info(StatusVector, @(FHandle), ReqBufLen, ReqBuffer,
173     getBufSize, Buffer) > 0 then
174     IBDataBaseError;
175     end;
176    
177 tony 45 procedure TFB25Attachment.Connect;
178     begin
179     FSQLDialect := 3;
180    
181 tony 263 with FFirebird25ClientAPI do
182 tony 45 if DPB = nil then
183     begin
184     if (isc_attach_database(StatusVector, Length(FDatabaseName),
185 tony 56 PAnsiChar(FDatabaseName), @FHandle, 0, nil) > 0) and FRaiseExceptionOnConnectError then
186 tony 45 IBDatabaseError;
187     end
188     else
189     begin
190     if (isc_attach_database(StatusVector, Length(FDatabaseName),
191 tony 56 PAnsiChar(FDatabaseName), @FHandle,
192 tony 45 (DPB as TDPB).getDataLength,
193     (DPB as TDPB).getBuffer) > 0 ) and FRaiseExceptionOnConnectError then
194     IBDatabaseError;
195    
196     end;
197 tony 117 GetODSAndConnectionInfo;
198 tony 45 end;
199    
200     procedure TFB25Attachment.Disconnect(Force: boolean);
201     begin
202     if FHandle = nil then
203     Exit;
204    
205     EndAllTransactions;
206     {Disconnect}
207 tony 263 with FFirebird25ClientAPI do
208 tony 45 if (isc_detach_database(StatusVector, @FHandle) > 0) and not Force then
209     IBDatabaseError;
210     FHandle := nil;
211     FHasDefaultCharSet := false;
212     FCodePage := CP_NONE;
213     FCharSetID := 0;
214     end;
215    
216     function TFB25Attachment.IsConnected: boolean;
217     begin
218     Result := FHandle <> nil;
219     end;
220    
221     procedure TFB25Attachment.DropDatabase;
222     begin
223     CheckHandle;
224     EndAllTransactions;
225 tony 263 with FFirebird25ClientAPI do
226 tony 45 if isc_drop_database(StatusVector, @FHandle) > 0 then
227     IBDatabaseError;
228     FHandle := nil;
229     end;
230    
231     function TFB25Attachment.StartTransaction(TPB: array of byte;
232     DefaultCompletion: TTransactionCompletion): ITransaction;
233     begin
234     CheckHandle;
235 tony 263 Result := TFB25Transaction.Create(FFirebird25ClientAPI,self,TPB,DefaultCompletion);
236 tony 45 end;
237    
238     function TFB25Attachment.StartTransaction(TPB: ITPB;
239     DefaultCompletion: TTransactionCompletion): ITransaction;
240     begin
241     CheckHandle;
242 tony 263 Result := TFB25Transaction.Create(FFirebird25ClientAPI,self,TPB,DefaultCompletion);
243 tony 45 end;
244    
245     function TFB25Attachment.CreateBlob(transaction: ITransaction; RelationName,
246 tony 56 ColumnName: AnsiString; BPB: IBPB): IBlob;
247 tony 45 begin
248     CheckHandle;
249     Result := TFB25Blob.Create(self,transaction as TFB25transaction,
250     TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,RelationName,ColumnName),BPB);
251     end;
252    
253     function TFB25Attachment.CreateBlob(transaction: ITransaction;
254     BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
255     begin
256     CheckHandle;
257     Result := TFB25Blob.Create(self,transaction as TFB25transaction,BlobMetaData,BPB);
258     end;
259    
260     function TFB25Attachment.CreateBlob(transaction: ITransaction;
261     SubType: integer; aCharSetID: cardinal; BPB: IBPB): IBlob;
262     begin
263     CheckHandle;
264     Result := TFB25Blob.Create(self,transaction as TFB25transaction,SubType,aCharSetID,BPB);
265     end;
266    
267     function TFB25Attachment.OpenBlob(transaction: ITransaction; RelationName,
268 tony 56 ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
269 tony 45 begin
270     CheckHandle;
271     Result := TFB25Blob.Create(self,transaction as TFB25transaction,
272     TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,RelationName,ColumnName),
273     BlobID,BPB);
274     end;
275    
276     function TFB25Attachment.OpenBlob(transaction: ITransaction;
277     BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
278     begin
279     CheckHandle;
280     Result := TFB25Blob.Create(self,transaction as TFB25transaction,BlobMetaData,BlobID,BPB);
281     end;
282    
283 tony 56 procedure TFB25Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
284 tony 45 aSQLDialect: integer);
285     var TRHandle: TISC_TR_HANDLE;
286     begin
287     CheckHandle;
288     TRHandle := (Transaction as TFB25Transaction).Handle;
289 tony 263 with FFirebird25ClientAPI do
290 tony 56 if isc_dsql_execute_immediate(StatusVector, @fHandle, @TRHandle, 0,PAnsiChar(sql), aSQLDialect, nil) > 0 then
291 tony 45 IBDatabaseError;
292     SignalActivity;
293     end;
294    
295 tony 56 function TFB25Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
296 tony 45 aSQLDialect: integer): IStatement;
297     begin
298     CheckHandle;
299     Result := TFB25Statement.Create(self,transaction,sql,aSQLDialect);
300     end;
301    
302     function TFB25Attachment.PrepareWithNamedParameters(transaction: ITransaction;
303 tony 56 sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
304 tony 45 begin
305     CheckHandle;
306     Result := TFB25Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
307     GenerateParamNames);
308     end;
309    
310     function TFB25Attachment.GetEventHandler(Events: TStrings): IEvents;
311     begin
312     CheckHandle;
313     Result := TFB25Events.Create(self,Events);
314     end;
315    
316 tony 56 function TFB25Attachment.OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString;
317 tony 45 ArrayID: TISC_QUAD): IArray;
318     begin
319     CheckHandle;
320     Result := TFB25Array.Create(self,transaction as TFB25Transaction,
321     GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
322     end;
323    
324 tony 56 function TFB25Attachment.CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray;
325 tony 45 begin
326     CheckHandle;
327     Result := TFB25Array.Create(self,transaction as TFB25Transaction,
328     GetArrayMetaData(transaction,RelationName,ColumnName));
329     end;
330    
331     function TFB25Attachment.CreateArray(transaction: ITransaction;
332     ArrayMetaData: IArrayMetaData): IArray;
333     begin
334     CheckHandle;
335     Result := TFB25Array.Create(self,transaction as TFB25Transaction,ArrayMetaData);
336     end;
337    
338 tony 47 function TFB25Attachment.CreateArrayMetaData(SQLType: cardinal;
339 tony 56 tableName: AnsiString; columnName: AnsiString; Scale: integer; size: cardinal;
340 tony 47 acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
341     ): IArrayMetaData;
342     begin
343 tony 60 Result := TFB25ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,acharSetID,dimensions,bounds);
344 tony 47 end;
345    
346 tony 45 function TFB25Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
347 tony 56 columnName: AnsiString): IBlobMetaData;
348 tony 45 begin
349     CheckHandle;
350     Result := TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
351     end;
352    
353     function TFB25Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
354 tony 56 columnName: AnsiString): IArrayMetaData;
355 tony 45 begin
356     CheckHandle;
357     Result := TFB25ArrayMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
358     end;
359    
360     end.
361