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: 291
Committed: Fri Apr 17 10:26:08 2020 UTC (4 years, 7 months ago) by tony
Content type: text/x-pascal
File size: 11951 byte(s)
Log Message:
Changed for 2.3.4 merged into public release

File Contents

# User Rev Content
1 tony 45 (*
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 tony 56 {$IFDEF MSWINDOWS}
29     {$DEFINE WINDOWS}
30     {$ENDIF}
31 tony 45
32     {$IFDEF FPC}
33 tony 56 {$mode delphi}
34 tony 45 {$interfaces COM}
35     {$ENDIF}
36    
37     interface
38    
39     uses
40     Classes, SysUtils, IB, FBAttachment, FB25ClientAPI, IBHeader,
41 tony 56 FBParamBlock, FBOutputBlock, FBActivityMonitor;
42 tony 45
43     type
44     { TFB25Attachment }
45    
46     TFB25Attachment = class(TFBAttachment, IAttachment, IActivityMonitor)
47     private
48     FHandle: TISC_DB_HANDLE;
49 tony 263 FFirebird25ClientAPI: TFB25ClientAPI;
50 tony 45 protected
51     procedure CheckHandle; override;
52     public
53 tony 263 constructor Create(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
54 tony 45 RaiseExceptionOnConnectError: boolean);
55 tony 263 constructor CreateDatabase(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
56     constructor CreateDatabase(api: TFB25ClientAPI; sql: AnsiString; aSQLDialect: integer;
57 tony 47 RaiseExceptionOnError: boolean); overload;
58 tony 143 function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; override;
59 tony 45 property Handle: TISC_DB_HANDLE read FHandle;
60 tony 263 property Firebird25ClientAPI: TFB25ClientAPI read FFirebird25ClientAPI;
61 tony 45
62     public
63     {IAttachment}
64     procedure Connect;
65     procedure Disconnect(Force: boolean=false); override;
66 tony 117 function IsConnected: boolean; override;
67 tony 45 procedure DropDatabase;
68     function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
69     function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
70 tony 56 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 tony 270 aSQLDialect: integer; GenerateParamNames: boolean=false;
74     CaseSensitiveParams: boolean=false): IStatement; override;
75 tony 45 function GetEventHandler(Events: TStrings): IEvents; override;
76 tony 291 function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; override;
77 tony 45 function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
78 tony 56 function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; override;
79 tony 45
80 tony 291 function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; override;
81     function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; override;
82 tony 56 function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
83 tony 47 Scale: integer; size: cardinal;
84     acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
85     ): IArrayMetaData;
86 tony 45
87     {Database Information}
88    
89 tony 291 function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; override;
90     function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; override;
91 tony 266 procedure getFBVersion(version: TStrings);
92 tony 45 end;
93    
94     implementation
95    
96     uses FB25Events,FB25Transaction, FBMessages, FB25Blob,
97 tony 266 FB25Statement, FB25Array, IBUtils, IBExternals;
98 tony 45
99     { TFB25Attachment }
100    
101     procedure TFB25Attachment.CheckHandle;
102     begin
103     if FHandle = nil then
104     IBError(ibxeDatabaseClosed,[nil]);
105     end;
106    
107 tony 263 constructor TFB25Attachment.Create(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
108 tony 45 RaiseExceptionOnConnectError: boolean);
109     begin
110 tony 263 FFirebird25ClientAPI := api;
111 tony 45 if aDPB = nil then
112     begin
113     if RaiseExceptionOnConnectError then
114     IBError(ibxeNoDPB,[nil]);
115     Exit;
116     end;
117 tony 263 inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
118 tony 45 Connect;
119     end;
120    
121 tony 263 constructor TFB25Attachment.CreateDatabase(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
122 tony 45 RaiseExceptionOnError: boolean);
123 tony 56 var sql: AnsiString;
124 tony 45 tr_handle: TISC_TR_HANDLE;
125     begin
126 tony 263 inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
127     FFirebird25ClientAPI := api;
128 tony 45 sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
129     tr_handle := nil;
130 tony 263 with FFirebird25ClientAPI do
131 tony 56 if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PAnsiChar(sql),
132 tony 45 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 tony 117 end
140     else
141     GetODSAndConnectionInfo;
142 tony 45 end;
143    
144 tony 263 constructor TFB25Attachment.CreateDatabase(api: TFB25ClientAPI; sql: AnsiString; aSQLDialect: integer;
145 tony 47 RaiseExceptionOnError: boolean);
146     var tr_handle: TISC_TR_HANDLE;
147     begin
148 tony 263 inherited Create(api,'',nil,RaiseExceptionOnError);
149     FFirebird25ClientAPI := api;
150 tony 47 FSQLDialect := aSQLDialect;
151     tr_handle := nil;
152 tony 263 with FFirebird25ClientAPI do
153 tony 47 begin
154 tony 56 if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PAnsiChar(sql),
155 tony 47 aSQLDialect, nil) > 0) and RaiseExceptionOnError then
156     IBDataBaseError;
157    
158     end;
159 tony 117 GetODSAndConnectionInfo;
160     ExtractConnectString(sql,FDatabaseName);
161     DPBFromCreateSQL(sql);
162 tony 47 end;
163    
164 tony 143 function TFB25Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer
165     ): IDBInformation;
166     begin
167 tony 263 Result := TDBInformation.Create(FFirebird25ClientAPI);
168     with FFirebird25ClientAPI, Result as TDBInformation do
169 tony 143 if isc_database_info(StatusVector, @(FHandle), ReqBufLen, ReqBuffer,
170     getBufSize, Buffer) > 0 then
171     IBDataBaseError;
172     end;
173    
174 tony 45 procedure TFB25Attachment.Connect;
175     begin
176     FSQLDialect := 3;
177    
178 tony 263 with FFirebird25ClientAPI do
179 tony 45 if DPB = nil then
180     begin
181     if (isc_attach_database(StatusVector, Length(FDatabaseName),
182 tony 56 PAnsiChar(FDatabaseName), @FHandle, 0, nil) > 0) and FRaiseExceptionOnConnectError then
183 tony 45 IBDatabaseError;
184     end
185     else
186     begin
187     if (isc_attach_database(StatusVector, Length(FDatabaseName),
188 tony 56 PAnsiChar(FDatabaseName), @FHandle,
189 tony 45 (DPB as TDPB).getDataLength,
190     (DPB as TDPB).getBuffer) > 0 ) and FRaiseExceptionOnConnectError then
191     IBDatabaseError;
192    
193     end;
194 tony 117 GetODSAndConnectionInfo;
195 tony 45 end;
196    
197     procedure TFB25Attachment.Disconnect(Force: boolean);
198     begin
199     if FHandle = nil then
200     Exit;
201    
202     EndAllTransactions;
203     {Disconnect}
204 tony 263 with FFirebird25ClientAPI do
205 tony 45 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 tony 263 with FFirebird25ClientAPI do
223 tony 45 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 tony 263 Result := TFB25Transaction.Create(FFirebird25ClientAPI,self,TPB,DefaultCompletion);
233 tony 45 end;
234    
235     function TFB25Attachment.StartTransaction(TPB: ITPB;
236     DefaultCompletion: TTransactionCompletion): ITransaction;
237     begin
238     CheckHandle;
239 tony 263 Result := TFB25Transaction.Create(FFirebird25ClientAPI,self,TPB,DefaultCompletion);
240 tony 45 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 tony 56 procedure TFB25Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
264 tony 45 aSQLDialect: integer);
265     var TRHandle: TISC_TR_HANDLE;
266     begin
267     CheckHandle;
268     TRHandle := (Transaction as TFB25Transaction).Handle;
269 tony 263 with FFirebird25ClientAPI do
270 tony 56 if isc_dsql_execute_immediate(StatusVector, @fHandle, @TRHandle, 0,PAnsiChar(sql), aSQLDialect, nil) > 0 then
271 tony 45 IBDatabaseError;
272     SignalActivity;
273     end;
274    
275 tony 56 function TFB25Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
276 tony 45 aSQLDialect: integer): IStatement;
277     begin
278     CheckHandle;
279     Result := TFB25Statement.Create(self,transaction,sql,aSQLDialect);
280     end;
281    
282     function TFB25Attachment.PrepareWithNamedParameters(transaction: ITransaction;
283 tony 270 sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
284     CaseSensitiveParams: boolean): IStatement;
285 tony 45 begin
286     CheckHandle;
287     Result := TFB25Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
288 tony 270 GenerateParamNames,CaseSensitiveParams);
289 tony 45 end;
290    
291     function TFB25Attachment.GetEventHandler(Events: TStrings): IEvents;
292     begin
293     CheckHandle;
294     Result := TFB25Events.Create(self,Events);
295     end;
296    
297 tony 291 function TFB25Attachment.OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData;
298 tony 45 ArrayID: TISC_QUAD): IArray;
299     begin
300     CheckHandle;
301     Result := TFB25Array.Create(self,transaction as TFB25Transaction,
302 tony 291 ArrayMetaData,ArrayID);
303 tony 45 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 tony 47 function TFB25Attachment.CreateArrayMetaData(SQLType: cardinal;
313 tony 56 tableName: AnsiString; columnName: AnsiString; Scale: integer; size: cardinal;
314 tony 47 acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
315     ): IArrayMetaData;
316     begin
317 tony 60 Result := TFB25ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,acharSetID,dimensions,bounds);
318 tony 47 end;
319    
320 tony 45 function TFB25Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
321 tony 56 columnName: AnsiString): IBlobMetaData;
322 tony 45 begin
323     CheckHandle;
324     Result := TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
325     end;
326    
327     function TFB25Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
328 tony 56 columnName: AnsiString): IArrayMetaData;
329 tony 45 begin
330     CheckHandle;
331     Result := TFB25ArrayMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
332     end;
333    
334 tony 266 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 tony 267 version.Clear;
344     with FFirebird25ClientAPI do
345     if isc_version(@FHandle,TISC_CALLBACK(callback),PVoid(version)) > 0 then
346     IBDataBaseError;
347 tony 266 end;
348    
349 tony 45 end.
350