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

# Content
1 (*
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 {$IFDEF MSWINDOWS}
29 {$DEFINE WINDOWS}
30 {$ENDIF}
31
32 {$IFDEF FPC}
33 {$mode delphi}
34 {$interfaces COM}
35 {$ENDIF}
36
37 interface
38
39 uses
40 Classes, SysUtils, IB, FBAttachment, FB25ClientAPI, IBHeader,
41 FBParamBlock, FBOutputBlock, FBActivityMonitor;
42
43 type
44 { TFB25Attachment }
45
46 TFB25Attachment = class(TFBAttachment, IAttachment, IActivityMonitor)
47 private
48 FHandle: TISC_DB_HANDLE;
49 FFirebird25ClientAPI: TFB25ClientAPI;
50 protected
51 procedure CheckHandle; override;
52 public
53 constructor Create(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
54 RaiseExceptionOnConnectError: boolean);
55 constructor CreateDatabase(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
56 constructor CreateDatabase(api: TFB25ClientAPI; sql: AnsiString; aSQLDialect: integer;
57 RaiseExceptionOnError: boolean); overload;
58 function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; override;
59 property Handle: TISC_DB_HANDLE read FHandle;
60 property Firebird25ClientAPI: TFB25ClientAPI read FFirebird25ClientAPI;
61
62 public
63 {IAttachment}
64 procedure Connect;
65 procedure Disconnect(Force: boolean=false); override;
66 function IsConnected: boolean; override;
67 procedure DropDatabase;
68 function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
69 function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
70 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 aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; override;
74 function GetEventHandler(Events: TStrings): IEvents; override;
75 function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
76 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 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
81 function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString;
82 ArrayID: TISC_QUAD): IArray;
83 function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString
84 ): IArray; overload;
85 function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
86 function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
87 Scale: integer; size: cardinal;
88 acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
89 ): IArrayMetaData;
90
91 {Database Information}
92
93 function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
94 function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
95 end;
96
97 implementation
98
99 uses FB25Events,FB25Transaction, FBMessages, FB25Blob,
100 FB25Statement, FB25Array, IBUtils;
101
102 { TFB25Attachment }
103
104 procedure TFB25Attachment.CheckHandle;
105 begin
106 if FHandle = nil then
107 IBError(ibxeDatabaseClosed,[nil]);
108 end;
109
110 constructor TFB25Attachment.Create(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
111 RaiseExceptionOnConnectError: boolean);
112 begin
113 FFirebird25ClientAPI := api;
114 if aDPB = nil then
115 begin
116 if RaiseExceptionOnConnectError then
117 IBError(ibxeNoDPB,[nil]);
118 Exit;
119 end;
120 inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
121 Connect;
122 end;
123
124 constructor TFB25Attachment.CreateDatabase(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
125 RaiseExceptionOnError: boolean);
126 var sql: AnsiString;
127 tr_handle: TISC_TR_HANDLE;
128 begin
129 inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
130 FFirebird25ClientAPI := api;
131 sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
132 tr_handle := nil;
133 with FFirebird25ClientAPI do
134 if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PAnsiChar(sql),
135 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 end
143 else
144 GetODSAndConnectionInfo;
145 end;
146
147 constructor TFB25Attachment.CreateDatabase(api: TFB25ClientAPI; sql: AnsiString; aSQLDialect: integer;
148 RaiseExceptionOnError: boolean);
149 var tr_handle: TISC_TR_HANDLE;
150 begin
151 inherited Create(api,'',nil,RaiseExceptionOnError);
152 FFirebird25ClientAPI := api;
153 FSQLDialect := aSQLDialect;
154 tr_handle := nil;
155 with FFirebird25ClientAPI do
156 begin
157 if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PAnsiChar(sql),
158 aSQLDialect, nil) > 0) and RaiseExceptionOnError then
159 IBDataBaseError;
160
161 end;
162 GetODSAndConnectionInfo;
163 ExtractConnectString(sql,FDatabaseName);
164 DPBFromCreateSQL(sql);
165 end;
166
167 function TFB25Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer
168 ): IDBInformation;
169 begin
170 Result := TDBInformation.Create(FFirebird25ClientAPI);
171 with FFirebird25ClientAPI, Result as TDBInformation do
172 if isc_database_info(StatusVector, @(FHandle), ReqBufLen, ReqBuffer,
173 getBufSize, Buffer) > 0 then
174 IBDataBaseError;
175 end;
176
177 procedure TFB25Attachment.Connect;
178 begin
179 FSQLDialect := 3;
180
181 with FFirebird25ClientAPI do
182 if DPB = nil then
183 begin
184 if (isc_attach_database(StatusVector, Length(FDatabaseName),
185 PAnsiChar(FDatabaseName), @FHandle, 0, nil) > 0) and FRaiseExceptionOnConnectError then
186 IBDatabaseError;
187 end
188 else
189 begin
190 if (isc_attach_database(StatusVector, Length(FDatabaseName),
191 PAnsiChar(FDatabaseName), @FHandle,
192 (DPB as TDPB).getDataLength,
193 (DPB as TDPB).getBuffer) > 0 ) and FRaiseExceptionOnConnectError then
194 IBDatabaseError;
195
196 end;
197 GetODSAndConnectionInfo;
198 end;
199
200 procedure TFB25Attachment.Disconnect(Force: boolean);
201 begin
202 if FHandle = nil then
203 Exit;
204
205 EndAllTransactions;
206 {Disconnect}
207 with FFirebird25ClientAPI do
208 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 with FFirebird25ClientAPI do
226 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 Result := TFB25Transaction.Create(FFirebird25ClientAPI,self,TPB,DefaultCompletion);
236 end;
237
238 function TFB25Attachment.StartTransaction(TPB: ITPB;
239 DefaultCompletion: TTransactionCompletion): ITransaction;
240 begin
241 CheckHandle;
242 Result := TFB25Transaction.Create(FFirebird25ClientAPI,self,TPB,DefaultCompletion);
243 end;
244
245 function TFB25Attachment.CreateBlob(transaction: ITransaction; RelationName,
246 ColumnName: AnsiString; BPB: IBPB): IBlob;
247 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 ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
269 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 procedure TFB25Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
284 aSQLDialect: integer);
285 var TRHandle: TISC_TR_HANDLE;
286 begin
287 CheckHandle;
288 TRHandle := (Transaction as TFB25Transaction).Handle;
289 with FFirebird25ClientAPI do
290 if isc_dsql_execute_immediate(StatusVector, @fHandle, @TRHandle, 0,PAnsiChar(sql), aSQLDialect, nil) > 0 then
291 IBDatabaseError;
292 SignalActivity;
293 end;
294
295 function TFB25Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
296 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 sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
304 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 function TFB25Attachment.OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString;
317 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 function TFB25Attachment.CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray;
325 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 function TFB25Attachment.CreateArrayMetaData(SQLType: cardinal;
339 tableName: AnsiString; columnName: AnsiString; Scale: integer; size: cardinal;
340 acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
341 ): IArrayMetaData;
342 begin
343 Result := TFB25ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,acharSetID,dimensions,bounds);
344 end;
345
346 function TFB25Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
347 columnName: AnsiString): IBlobMetaData;
348 begin
349 CheckHandle;
350 Result := TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
351 end;
352
353 function TFB25Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
354 columnName: AnsiString): IArrayMetaData;
355 begin
356 CheckHandle;
357 Result := TFB25ArrayMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
358 end;
359
360 end.
361