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

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