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: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 11 months ago) by tony
Content type: text/x-pascal
File size: 11991 byte(s)
Log Message:
Committing updates for Release R2-0-0

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    
29     {$IFDEF FPC}
30     {$mode objfpc}{$H+}
31     {$interfaces COM}
32     {$ENDIF}
33    
34     interface
35    
36     uses
37     Classes, SysUtils, IB, FBAttachment, FB25ClientAPI, IBHeader,
38     FBParamBlock, FBOutputBlock, FBActivityMonitor;
39    
40     type
41     { TFB25Attachment }
42    
43     TFB25Attachment = class(TFBAttachment, IAttachment, IActivityMonitor)
44     private
45     FHandle: TISC_DB_HANDLE;
46     protected
47     procedure CheckHandle; override;
48     public
49     constructor Create(DatabaseName: string; aDPB: IDPB;
50     RaiseExceptionOnConnectError: boolean);
51     constructor CreateDatabase(DatabaseName: string; aDPB: IDPB; RaiseExceptionOnError: boolean);
52     property Handle: TISC_DB_HANDLE read FHandle;
53    
54     public
55     {IAttachment}
56     procedure Connect;
57     procedure Disconnect(Force: boolean=false); override;
58     function IsConnected: boolean;
59     procedure DropDatabase;
60     function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
61     function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
62     procedure ExecImmediate(transaction: ITransaction; sql: string; aSQLDialect: integer); override;
63     function Prepare(transaction: ITransaction; sql: string; aSQLDialect: integer): IStatement; override;
64     function PrepareWithNamedParameters(transaction: ITransaction; sql: string;
65     aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; override;
66     function GetEventHandler(Events: TStrings): IEvents; override;
67     function CreateBlob(transaction: ITransaction; RelationName, ColumnName: string; BPB: IBPB=nil): IBlob; overload;
68     function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
69     function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
70     function OpenBlob(transaction: ITransaction; RelationName, ColumnName: string; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
71     function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; override; overload;
72    
73     function OpenArray(transaction: ITransaction; RelationName, ColumnName: string;
74     ArrayID: TISC_QUAD): IArray;
75     function CreateArray(transaction: ITransaction; RelationName, ColumnName: string
76     ): IArray; overload;
77     function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
78    
79     {Database Information}
80    
81     function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: string): IBlobMetaData;
82     function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: string): IArrayMetaData;
83     function GetDBInformation(Requests: array of byte): IDBInformation; overload;
84     function GetDBInformation(Request: byte): IDBInformation; overload;
85     end;
86    
87     implementation
88    
89     uses FB25Events,FB25Transaction, FBMessages, FB25Blob,
90     FB25Statement, FB25Array;
91    
92     { TFB25Attachment }
93    
94     procedure TFB25Attachment.CheckHandle;
95     begin
96     if FHandle = nil then
97     IBError(ibxeDatabaseClosed,[nil]);
98     end;
99    
100     constructor TFB25Attachment.Create(DatabaseName: string; aDPB: IDPB;
101     RaiseExceptionOnConnectError: boolean);
102     begin
103     if aDPB = nil then
104     begin
105     if RaiseExceptionOnConnectError then
106     IBError(ibxeNoDPB,[nil]);
107     Exit;
108     end;
109     inherited Create(DatabaseName,aDPB,RaiseExceptionOnConnectError);
110     Connect;
111     end;
112    
113     constructor TFB25Attachment.CreateDatabase(DatabaseName: string; aDPB: IDPB;
114     RaiseExceptionOnError: boolean);
115     var sql: string;
116     tr_handle: TISC_TR_HANDLE;
117     begin
118     inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
119     sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
120     tr_handle := nil;
121     with Firebird25ClientAPI do
122     if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PChar(sql),
123     SQLDialect, nil) > 0) and RaiseExceptionOnError then
124     IBDataBaseError;
125     if DPB <> nil then
126     {Connect using known parameters}
127     begin
128     Disconnect;
129     Connect;
130     end;
131     end;
132    
133     procedure TFB25Attachment.Connect;
134     var Param: IDPBItem;
135     begin
136     FSQLDialect := 3;
137    
138     with Firebird25ClientAPI do
139     if DPB = nil then
140     begin
141     if (isc_attach_database(StatusVector, Length(FDatabaseName),
142     PChar(FDatabaseName), @FHandle, 0, nil) > 0) and FRaiseExceptionOnConnectError then
143     IBDatabaseError;
144     end
145     else
146     begin
147     if (isc_attach_database(StatusVector, Length(FDatabaseName),
148     PChar(FDatabaseName), @FHandle,
149     (DPB as TDPB).getDataLength,
150     (DPB as TDPB).getBuffer) > 0 ) and FRaiseExceptionOnConnectError then
151     IBDatabaseError;
152    
153     if IsConnected then
154     begin
155     Param := DPB.Find(isc_dpb_set_db_SQL_dialect);
156     if Param <> nil then
157     FSQLDialect := Param.AsByte;
158     Param := DPB.Find(isc_dpb_lc_ctype);
159     FHasDefaultCharSet := (Param <> nil) and
160     CharSetName2CharSetID(Param.AsString,FCharSetID) and
161     CharSetID2CodePage(FCharSetID,FCodePage) and
162     (FCharSetID > 1);
163     end;
164     end;
165     end;
166    
167     procedure TFB25Attachment.Disconnect(Force: boolean);
168     begin
169     if FHandle = nil then
170     Exit;
171    
172     EndAllTransactions;
173     {Disconnect}
174     with Firebird25ClientAPI do
175     if (isc_detach_database(StatusVector, @FHandle) > 0) and not Force then
176     IBDatabaseError;
177     FHandle := nil;
178     FHasDefaultCharSet := false;
179     FCodePage := CP_NONE;
180     FCharSetID := 0;
181     end;
182    
183     function TFB25Attachment.IsConnected: boolean;
184     begin
185     Result := FHandle <> nil;
186     end;
187    
188     procedure TFB25Attachment.DropDatabase;
189     begin
190     CheckHandle;
191     EndAllTransactions;
192     with Firebird25ClientAPI do
193     if isc_drop_database(StatusVector, @FHandle) > 0 then
194     IBDatabaseError;
195     FHandle := nil;
196     end;
197    
198     function TFB25Attachment.StartTransaction(TPB: array of byte;
199     DefaultCompletion: TTransactionCompletion): ITransaction;
200     begin
201     CheckHandle;
202     Result := TFB25Transaction.Create(self,TPB,DefaultCompletion);
203     end;
204    
205     function TFB25Attachment.StartTransaction(TPB: ITPB;
206     DefaultCompletion: TTransactionCompletion): ITransaction;
207     begin
208     CheckHandle;
209     Result := TFB25Transaction.Create(self,TPB,DefaultCompletion);
210     end;
211    
212     function TFB25Attachment.CreateBlob(transaction: ITransaction; RelationName,
213     ColumnName: string; BPB: IBPB): IBlob;
214     begin
215     CheckHandle;
216     Result := TFB25Blob.Create(self,transaction as TFB25transaction,
217     TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,RelationName,ColumnName),BPB);
218     end;
219    
220     function TFB25Attachment.CreateBlob(transaction: ITransaction;
221     BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
222     begin
223     CheckHandle;
224     Result := TFB25Blob.Create(self,transaction as TFB25transaction,BlobMetaData,BPB);
225     end;
226    
227     function TFB25Attachment.CreateBlob(transaction: ITransaction;
228     SubType: integer; aCharSetID: cardinal; BPB: IBPB): IBlob;
229     begin
230     CheckHandle;
231     Result := TFB25Blob.Create(self,transaction as TFB25transaction,SubType,aCharSetID,BPB);
232     end;
233    
234     function TFB25Attachment.OpenBlob(transaction: ITransaction; RelationName,
235     ColumnName: string; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
236     begin
237     CheckHandle;
238     Result := TFB25Blob.Create(self,transaction as TFB25transaction,
239     TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,RelationName,ColumnName),
240     BlobID,BPB);
241     end;
242    
243     function TFB25Attachment.OpenBlob(transaction: ITransaction;
244     BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
245     begin
246     CheckHandle;
247     Result := TFB25Blob.Create(self,transaction as TFB25transaction,BlobMetaData,BlobID,BPB);
248     end;
249    
250     procedure TFB25Attachment.ExecImmediate(transaction: ITransaction; sql: string;
251     aSQLDialect: integer);
252     var TRHandle: TISC_TR_HANDLE;
253     begin
254     CheckHandle;
255     TRHandle := (Transaction as TFB25Transaction).Handle;
256     with Firebird25ClientAPI do
257     if isc_dsql_execute_immediate(StatusVector, @fHandle, @TRHandle, 0,PChar(sql), aSQLDialect, nil) > 0 then
258     IBDatabaseError;
259     SignalActivity;
260     end;
261    
262     function TFB25Attachment.Prepare(transaction: ITransaction; sql: string;
263     aSQLDialect: integer): IStatement;
264     begin
265     CheckHandle;
266     Result := TFB25Statement.Create(self,transaction,sql,aSQLDialect);
267     end;
268    
269     function TFB25Attachment.PrepareWithNamedParameters(transaction: ITransaction;
270     sql: string; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
271     begin
272     CheckHandle;
273     Result := TFB25Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
274     GenerateParamNames);
275     end;
276    
277     function TFB25Attachment.GetEventHandler(Events: TStrings): IEvents;
278     begin
279     CheckHandle;
280     Result := TFB25Events.Create(self,Events);
281     end;
282    
283     function TFB25Attachment.OpenArray(transaction: ITransaction; RelationName, ColumnName: string;
284     ArrayID: TISC_QUAD): IArray;
285     begin
286     CheckHandle;
287     Result := TFB25Array.Create(self,transaction as TFB25Transaction,
288     GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
289     end;
290    
291     function TFB25Attachment.CreateArray(transaction: ITransaction; RelationName, ColumnName: string): IArray;
292     begin
293     CheckHandle;
294     Result := TFB25Array.Create(self,transaction as TFB25Transaction,
295     GetArrayMetaData(transaction,RelationName,ColumnName));
296     end;
297    
298     function TFB25Attachment.CreateArray(transaction: ITransaction;
299     ArrayMetaData: IArrayMetaData): IArray;
300     begin
301     CheckHandle;
302     Result := TFB25Array.Create(self,transaction as TFB25Transaction,ArrayMetaData);
303     end;
304    
305     function TFB25Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
306     columnName: string): IBlobMetaData;
307     begin
308     CheckHandle;
309     Result := TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
310     end;
311    
312     function TFB25Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
313     columnName: string): IArrayMetaData;
314     begin
315     CheckHandle;
316     Result := TFB25ArrayMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
317     end;
318    
319     function TFB25Attachment.GetDBInformation(Requests: array of byte
320     ): IDBInformation;
321     var ReqBuffer: PByte;
322     i: integer;
323     begin
324     CheckHandle;
325     if Length(Requests) = 1 then
326     Result := GetDBInformation(Requests[0])
327     else
328     begin
329     Result := TDBInformation.Create;
330     GetMem(ReqBuffer,Length(Requests));
331     try
332     for i := 0 to Length(Requests) - 1 do
333     ReqBuffer[i] := Requests[i];
334    
335     with Firebird25ClientAPI, Result as TDBInformation do
336     if isc_database_info(StatusVector, @(FHandle), Length(Requests), PChar(ReqBuffer),
337     getBufSize, Buffer) > 0 then
338     IBDataBaseError;
339    
340     finally
341     FreeMem(ReqBuffer);
342     end;
343     end;
344     end;
345    
346     function TFB25Attachment.GetDBInformation(Request: byte): IDBInformation;
347     begin
348     CheckHandle;
349     Result := TDBInformation.Create;
350     with Firebird25ClientAPI, Result as TDBInformation do
351     if isc_database_info(StatusVector, @(FHandle), 1, @Request,
352     getBufSize, Buffer) > 0 then
353     IBDataBaseError;
354     end;
355    
356     end.
357