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