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