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