ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/2.5/FB25Attachment.pas
Revision: 375
Committed: Sun Jan 9 23:42:58 2022 UTC (2 years, 10 months ago) by tony
Content type: text/x-pascal
File size: 12337 byte(s)
Log Message:
Fixes

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 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 SetSQLDialect(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 ExtractConnectString(sql,FDatabaseName);
165 DPBFromCreateSQL(sql);
166 end;
167
168 function TFB25Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer
169 ): IDBInformation;
170 begin
171 Result := TDBInformation.Create(FFirebird25ClientAPI);
172 with FFirebird25ClientAPI, Result as TDBInformation do
173 if isc_database_info(StatusVector, @(FHandle), ReqBufLen, ReqBuffer,
174 getBufSize, Buffer) > 0 then
175 IBDataBaseError;
176 end;
177
178 procedure TFB25Attachment.Connect;
179 begin
180 SetSQLDialect(3);
181
182 with FFirebird25ClientAPI do
183 if DPB = nil then
184 begin
185 if (isc_attach_database(StatusVector, Length(FDatabaseName),
186 PAnsiChar(FDatabaseName), @FHandle, 0, nil) > 0) and FRaiseExceptionOnConnectError then
187 IBDatabaseError;
188 end
189 else
190 begin
191 if (isc_attach_database(StatusVector, Length(FDatabaseName),
192 PAnsiChar(FDatabaseName), @FHandle,
193 (DPB as TDPB).getDataLength,
194 (DPB as TDPB).getBuffer) > 0 ) and FRaiseExceptionOnConnectError then
195 IBDatabaseError;
196
197 end;
198 end;
199
200 procedure TFB25Attachment.Disconnect(Force: boolean);
201 begin
202 inherited Disconnect(Force);
203 if FHandle = nil then
204 Exit;
205
206 EndAllTransactions;
207 {Disconnect}
208 with FFirebird25ClientAPI do
209 if (isc_detach_database(StatusVector, @FHandle) > 0) and not Force then
210 IBDatabaseError;
211 FHandle := nil;
212 end;
213
214 function TFB25Attachment.IsConnected: boolean;
215 begin
216 Result := FHandle <> nil;
217 end;
218
219 procedure TFB25Attachment.DropDatabase;
220 begin
221 if IsConnected then
222 begin
223 EndAllTransactions;
224 EndSession(false);
225 with FFirebird25ClientAPI do
226 if isc_drop_database(StatusVector, @FHandle) > 0 then
227 IBDatabaseError;
228 FHandle := nil;
229 end;
230 end;
231
232 function TFB25Attachment.StartTransaction(TPB: array of byte;
233 DefaultCompletion: TTransactionCompletion; aName: AnsiString): ITransaction;
234 begin
235 CheckHandle;
236 Result := TFB25Transaction.Create(FFirebird25ClientAPI,self,TPB,DefaultCompletion,aName);
237 end;
238
239 function TFB25Attachment.StartTransaction(TPB: ITPB;
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.CreateBlob(transaction: ITransaction;
247 BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
248 begin
249 CheckHandle;
250 Result := TFB25Blob.Create(self,transaction as TFB25transaction,BlobMetaData,BPB);
251 end;
252
253 function TFB25Attachment.CreateBlob(transaction: ITransaction;
254 SubType: integer; aCharSetID: cardinal; BPB: IBPB): IBlob;
255 begin
256 CheckHandle;
257 Result := TFB25Blob.Create(self,transaction as TFB25transaction,SubType,aCharSetID,BPB);
258 end;
259
260 function TFB25Attachment.OpenBlob(transaction: ITransaction;
261 BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
262 begin
263 CheckHandle;
264 Result := TFB25Blob.Create(self,transaction as TFB25transaction,BlobMetaData,BlobID,BPB);
265 end;
266
267 procedure TFB25Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
268 aSQLDialect: integer);
269 var TRHandle: TISC_TR_HANDLE;
270 begin
271 CheckHandle;
272 TRHandle := (Transaction as TFB25Transaction).Handle;
273 with FFirebird25ClientAPI do
274 if isc_dsql_execute_immediate(StatusVector, @fHandle, @TRHandle, 0,PAnsiChar(sql), aSQLDialect, nil) > 0 then
275 IBDatabaseError;
276 SignalActivity;
277 end;
278
279 function TFB25Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
280 aSQLDialect: integer; CursorName: AnsiString): IStatement;
281 begin
282 CheckHandle;
283 Result := TFB25Statement.Create(self,transaction,sql,aSQLDialect);
284 end;
285
286 function TFB25Attachment.PrepareWithNamedParameters(transaction: ITransaction;
287 sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
288 CaseSensitiveParams: boolean; CursorName: AnsiString): IStatement;
289 begin
290 CheckHandle;
291 Result := TFB25Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
292 GenerateParamNames,CaseSensitiveParams,CursorName);
293 end;
294
295 function TFB25Attachment.GetEventHandler(Events: TStrings): IEvents;
296 begin
297 CheckHandle;
298 Result := TFB25Events.Create(self,Events);
299 end;
300
301 function TFB25Attachment.OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData;
302 ArrayID: TISC_QUAD): IArray;
303 begin
304 CheckHandle;
305 Result := TFB25Array.Create(self,transaction as TFB25Transaction,
306 ArrayMetaData,ArrayID);
307 end;
308
309 function TFB25Attachment.CreateArray(transaction: ITransaction;
310 ArrayMetaData: IArrayMetaData): IArray;
311 begin
312 CheckHandle;
313 Result := TFB25Array.Create(self,transaction as TFB25Transaction,ArrayMetaData);
314 end;
315
316 function TFB25Attachment.CreateArrayMetaData(SQLType: cardinal;
317 tableName: AnsiString; columnName: AnsiString; Scale: integer; size: cardinal;
318 acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
319 ): IArrayMetaData;
320 begin
321 Result := TFB25ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,acharSetID,dimensions,bounds);
322 end;
323
324 function TFB25Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
325 columnName: AnsiString): IBlobMetaData;
326 begin
327 CheckHandle;
328 Result := TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
329 end;
330
331 function TFB25Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
332 columnName: AnsiString): IArrayMetaData;
333 begin
334 CheckHandle;
335 Result := TFB25ArrayMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
336 end;
337
338 procedure ISCVersionCallback(userArg: pointer; text: PAnsiChar); cdecl;
339 begin
340 TStrings(userArg).Add(text);
341 end;
342
343 procedure TFB25Attachment.getFBVersion(version: TStrings);
344 var callback: pointer;
345 begin
346 callback := @ISCVersionCallback;
347 version.Clear;
348 with FFirebird25ClientAPI do
349 if isc_version(@FHandle,TISC_CALLBACK(callback),PVoid(version)) > 0 then
350 IBDataBaseError;
351 end;
352
353 function TFB25Attachment.HasScollableCursors: boolean;
354 begin
355 Result := false;
356 end;
357
358 end.
359