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