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