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: 363
Committed: Tue Dec 7 13:30:05 2021 UTC (2 years, 4 months ago) by tony
Content type: text/x-pascal
File size: 12501 byte(s)
Log Message:
add fbintf

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