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