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