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: 266
Committed: Wed Dec 26 18:34:32 2018 UTC (5 years, 3 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/2.5/FB25Attachment.pas
File size: 13130 byte(s)
Log Message:
Fixes Merged

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