ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/3.0/FB30ClientAPI.pas
Revision: 263
Committed: Thu Dec 6 15:55:01 2018 UTC (5 years, 4 months ago) by tony
Content type: text/x-pascal
File size: 11629 byte(s)
Log Message:
Release 2.3.2 committed

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 FB30ClientAPI;
28 tony 56 {$IFDEF MSWINDOWS}
29     {$DEFINE WINDOWS}
30     {$ENDIF}
31 tony 45
32     {$IFDEF FPC}
33     {$mode delphi}
34     {$interfaces COM}
35     {$ENDIF}
36    
37     interface
38    
39     uses
40     Classes, SysUtils, FBClientAPI, Firebird, IB, IBExternals;
41    
42     type
43    
44     { TFB30Status }
45    
46     TFB30Status = class(TFBStatus,IStatus)
47     private
48     FStatus: Firebird.IStatus;
49     public
50     procedure Init;
51     function InErrorState: boolean;
52     function GetStatus: Firebird.IStatus;
53     function StatusVector: PStatusVector; override;
54     end;
55    
56     Tfb_get_master_interface = function: IMaster;
57     {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
58    
59     { TFB30ClientAPI }
60    
61     TFB30ClientAPI = class(TFBClientAPI,IFirebirdAPI)
62     private
63     FMaster: Firebird.IMaster;
64     FUtil: Firebird.IUtil;
65     FProvider: Firebird.IProvider;
66     FConfigManager: Firebird.IConfigManager;
67     FStatus: TFB30Status;
68     FIsEmbeddedServer: boolean;
69     FStatusIntf: IStatus; {Keep a reference to the interface - automatic destroy
70     when this class is freed and last reference to IStatus
71     goes out of scope.}
72     procedure CheckPlugins;
73     public
74 tony 263 constructor Create(aFBLibrary: TFBLibrary);
75 tony 45 destructor Destroy; override;
76    
77     function StatusIntf: Firebird.IStatus;
78     procedure Check4DataBaseError;
79     function InErrorState: boolean;
80 tony 263 function LoadInterface: boolean; override;
81     function GetAPI: IFirebirdAPI; override;
82     {$IFDEF UNIX}
83     function GetFirebirdLibList: string; override;
84     {$ENDIF}
85 tony 45
86     public
87     {IFirebirdAPI}
88     function GetStatus: IStatus; override;
89     function AllocateDPB: IDPB;
90     function AllocateTPB: ITPB;
91    
92     {Database connections}
93 tony 56 function OpenDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
94     function CreateDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment; overload;
95     function CreateDatabase(sql: AnsiString; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
96 tony 45 {Start Transaction against multiple databases}
97     function StartTransaction(Attachments: array of IAttachment;
98     TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload;
99     function StartTransaction(Attachments: array of IAttachment;
100     TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload;
101    
102     {Service Manager}
103     function AllocateSPB: ISPB;
104 tony 143 function GetServiceManager(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
105     function GetServiceManager(ServerName: AnsiString; Port: Ansistring; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
106 tony 45
107     {Information}
108     function HasServiceAPI: boolean;
109     function HasRollbackRetaining: boolean;
110     function IsEmbeddedServer: boolean; override;
111 tony 56 function GetImplementationVersion: AnsiString;
112 tony 45
113     {Firebird 3 API}
114     function HasMasterIntf: boolean;
115     function GetIMaster: TObject;
116    
117     {Encode/Decode}
118 tony 56 function DecodeInteger(bufptr: PByte; len: short): integer; override;
119     procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); override;
120     function SQLDecodeDate(bufptr: PByte): TDateTime; override;
121     procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); override;
122     function SQLDecodeTime(bufptr: PByte): TDateTime; override;
123     procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); override;
124     function SQLDecodeDateTime(bufptr: PByte): TDateTime; override;
125 tony 45
126     {Firebird Interfaces}
127     property MasterIntf: Firebird.IMaster read FMaster;
128     property UtilIntf: Firebird.IUtil read FUtil;
129     property ProviderIntf: Firebird.IProvider read FProvider;
130     end;
131    
132     implementation
133    
134 tony 56 uses FBParamBlock, FB30Attachment, {$IFDEF FPC}dynlibs{$ELSE} windows{$ENDIF},
135     FBMessages, FB30Services, FB30Transaction;
136 tony 45
137     type
138     PISC_DATE = ^ISC_DATE;
139     PISC_TIME = ^ISC_TIME;
140    
141     { TFB30Status }
142    
143     procedure TFB30Status.Init;
144     begin
145     if assigned(FStatus) then
146     FStatus.Init;
147     end;
148    
149     function TFB30Status.InErrorState: boolean;
150     begin
151     with GetStatus do
152     Result := ((getState and STATE_ERRORS) <> 0);
153     end;
154    
155     function TFB30Status.GetStatus: Firebird.IStatus;
156     begin
157     if FStatus = nil then
158     with FOwner do
159     FStatus := (FOwner as TFB30ClientAPI).MasterIntf.GetStatus;
160     Result := FStatus;
161     end;
162    
163     function TFB30Status.StatusVector: PStatusVector;
164     begin
165     Result := PStatusVector(GetStatus.getErrors);
166     end;
167    
168     { TFB30ClientAPI }
169    
170     procedure TFB30ClientAPI.CheckPlugins;
171     var FBConf: Firebird.IFirebirdConf;
172 tony 56 Plugins: AnsiString;
173 tony 45 PluginsList: TStringList;
174     begin
175     FIsEmbeddedServer := false;
176     FBConf := FConfigManager.getFirebirdConf;
177     try
178     Plugins := FBConf.asString(FBConf.getKey('Providers'));
179     finally
180     FBConf.release;
181     end;
182     if Plugins = '' then Exit;
183    
184     PluginsList := TStringList.Create;
185     try
186     PluginsList.CommaText := Plugins;
187     FIsEmbeddedServer := PluginsList.IndexOf('Engine12') <> -1;
188     finally
189     PluginsList.Free;
190     end;
191     end;
192    
193     {$IFDEF UNIX}
194     function TFB30ClientAPI.GetFirebirdLibList: string;
195     begin
196     Result := 'libfbclient.so:libfbclient.so.2';
197     end;
198     {$ENDIF}
199    
200 tony 263 function TFB30ClientAPI.LoadInterface: boolean;
201 tony 45 var
202     fb_get_master_interface: Tfb_get_master_interface;
203     begin
204 tony 263 Result := inherited LoadInterface;
205     fb_get_master_interface := GetProcAddress(GetFBLibrary.GetHandle, 'fb_get_master_interface'); {do not localize}
206 tony 45 if assigned(fb_get_master_interface) then
207     begin
208     FMaster := fb_get_master_interface;
209     FUtil := FMaster.getUtilInterface;
210     FProvider := FMaster.getDispatcher;
211     FConfigManager := FMaster.getConfigManager;
212     CheckPlugins;
213     end;
214 tony 263 Result := Result and HasMasterIntf;
215 tony 45 end;
216    
217 tony 263 function TFB30ClientAPI.GetAPI: IFirebirdAPI;
218 tony 45 begin
219 tony 263 Result := self;
220     end;
221    
222     constructor TFB30ClientAPI.Create(aFBLibrary: TFBLibrary);
223     begin
224     inherited Create(aFBLibrary);
225 tony 45 FStatus := TFB30Status.Create(self);
226     FStatusIntf := FStatus;
227     end;
228    
229     destructor TFB30ClientAPI.Destroy;
230     begin
231     if assigned(FProvider) then
232     FProvider.release;
233     inherited Destroy;
234     end;
235    
236     function TFB30ClientAPI.StatusIntf: Firebird.IStatus;
237     begin
238     Result := FStatus.GetStatus;
239     Result.Init;
240     end;
241    
242     procedure TFB30ClientAPI.Check4DataBaseError;
243     begin
244     if FStatus.InErrorState then
245     IBDataBaseError;
246     end;
247    
248     function TFB30ClientAPI.InErrorState: boolean;
249     begin
250     Result := FStatus.InErrorState;
251     end;
252    
253     function TFB30ClientAPI.GetStatus: IStatus;
254     begin
255     Result := FStatusIntf;
256     end;
257    
258     function TFB30ClientAPI.AllocateDPB: IDPB;
259     begin
260 tony 263 Result := TDPB.Create(self);
261 tony 45 end;
262    
263     function TFB30ClientAPI.AllocateTPB: ITPB;
264     begin
265 tony 263 Result := TTPB.Create(self);
266 tony 45 end;
267    
268 tony 56 function TFB30ClientAPI.OpenDatabase(DatabaseName: AnsiString; DPB: IDPB;
269 tony 45 RaiseExceptionOnConnectError: boolean): IAttachment;
270     begin
271 tony 263 Result := TFB30Attachment.Create(self,DatabaseName, DPB, RaiseExceptionOnConnectError);
272 tony 45 if not Result.IsConnected then
273     Result := nil;
274     end;
275    
276 tony 56 function TFB30ClientAPI.CreateDatabase(DatabaseName: AnsiString; DPB: IDPB;
277 tony 45 RaiseExceptionOnError: boolean): IAttachment;
278     begin
279 tony 263 Result := TFB30Attachment.CreateDatabase(self,DatabaseName,DPB, RaiseExceptionOnError);
280 tony 45 if not Result.IsConnected then
281     Result := nil;
282     end;
283    
284 tony 56 function TFB30ClientAPI.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
285 tony 47 RaiseExceptionOnError: boolean): IAttachment;
286     begin
287 tony 263 Result := TFB30Attachment.CreateDatabase(self,sql,aSQLDialect, RaiseExceptionOnError);
288 tony 47 if not Result.IsConnected then
289     Result := nil;
290     end;
291    
292 tony 45 function TFB30ClientAPI.StartTransaction(Attachments: array of IAttachment;
293     TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction;
294     begin
295 tony 263 Result := TFB30Transaction.Create(self,Attachments,TPB,DefaultCompletion);
296 tony 45 end;
297    
298     function TFB30ClientAPI.StartTransaction(Attachments: array of IAttachment;
299     TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction;
300     begin
301 tony 263 Result := TFB30Transaction.Create(self,Attachments,TPB,DefaultCompletion);
302 tony 45 end;
303    
304     function TFB30ClientAPI.AllocateSPB: ISPB;
305     begin
306 tony 263 Result := TSPB.Create(self);
307 tony 45 end;
308    
309 tony 56 function TFB30ClientAPI.GetServiceManager(ServerName: AnsiString;
310 tony 45 Protocol: TProtocol; SPB: ISPB): IServiceManager;
311     begin
312 tony 263 Result := TFB30ServiceManager.Create(self,ServerName,Protocol,SPB);
313 tony 45 end;
314    
315 tony 143 function TFB30ClientAPI.GetServiceManager(ServerName: AnsiString;
316     Port: Ansistring; Protocol: TProtocol; SPB: ISPB): IServiceManager;
317     begin
318 tony 263 Result := TFB30ServiceManager.Create(self,ServerName,Protocol,SPB,Port);
319 tony 143 end;
320    
321 tony 45 function TFB30ClientAPI.HasServiceAPI: boolean;
322     begin
323     Result := true;
324     end;
325    
326     function TFB30ClientAPI.HasMasterIntf: boolean;
327     begin
328     Result := MasterIntf <> nil;
329     end;
330    
331     function TFB30ClientAPI.GetIMaster: TObject;
332     begin
333     Result := FMaster;
334     end;
335    
336     function TFB30ClientAPI.HasRollbackRetaining: boolean;
337     begin
338     Result := true;
339     end;
340    
341     function TFB30ClientAPI.IsEmbeddedServer: boolean;
342     begin
343     Result := FIsEmbeddedServer;
344     end;
345    
346 tony 56 function TFB30ClientAPI.GetImplementationVersion: AnsiString;
347 tony 45 begin
348     Result := Format('3.%d',[UtilIntf.GetClientVersion]);
349     end;
350    
351 tony 56 function TFB30ClientAPI.DecodeInteger(bufptr: PByte; len: short): integer;
352     var P: PByte;
353 tony 45 begin
354     Result := 0;
355     P := Bufptr + len - 1;
356     while P >= bufptr do
357     begin
358 tony 56 Result := (Result shl 8 ) or P^;
359 tony 45 Dec(P);
360     end;
361     end;
362    
363 tony 56 procedure TFB30ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PByte);
364 tony 45 var
365     Yr, Mn, Dy: Word;
366     begin
367     DecodeDate(aDate, Yr, Mn, Dy);
368     PISC_Date(Bufptr)^ := UtilIntf.encodeDate(Yr, Mn, Dy);
369     end;
370    
371 tony 56 function TFB30ClientAPI.SQLDecodeDate(bufptr: PByte): TDateTime;
372 tony 45 var
373 tony 56 Yr, Mn, Dy: cardinal;
374 tony 45 begin
375     UtilIntf.decodeDate(PISC_DATE(bufptr)^,@Yr, @Mn, @Dy);
376     try
377     result := EncodeDate(Yr, Mn,Dy);
378     except
379     on E: EConvertError do begin
380     IBError(ibxeInvalidDataConversion, [nil]);
381     end;
382     end;
383     end;
384    
385 tony 56 procedure TFB30ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PByte);
386 tony 45 var
387     Hr, Mt, S, Ms: Word;
388     begin
389     DecodeTime(aTime, Hr, Mt, S, Ms);
390     PISC_TIME(bufptr)^ := UtilIntf.encodeTime(Hr, Mt, S, Ms*10);
391     end;
392    
393 tony 56 function TFB30ClientAPI.SQLDecodeTime(bufptr: PByte): TDateTime;
394 tony 45 var
395 tony 56 Hr, Mt, S, Ms: cardinal;
396 tony 45 begin
397     UtilIntf.decodeTime(PISC_TIME(bufptr)^,@Hr, @Mt, @S, @Ms);
398     try
399     Result := EncodeTime(Hr, Mt, S, Ms div 10);
400     except
401     on E: EConvertError do begin
402     IBError(ibxeInvalidDataConversion, [nil]);
403     end;
404     end;
405     end;
406    
407 tony 56 procedure TFB30ClientAPI.SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte);
408 tony 45 begin
409     SQLEncodeDate(aDateTime,bufPtr);
410     Inc(bufptr,sizeof(ISC_DATE));
411     SQLEncodeTime(aDateTime,bufPtr);
412     end;
413    
414 tony 56 function TFB30ClientAPI.SQLDecodeDateTime(bufptr: PByte): TDateTime;
415 tony 45 begin
416     Result := SQLDecodeDate(bufPtr);
417     Inc(bufptr,sizeof(ISC_DATE));
418 tony 56 Result := Result + SQLDecodeTime(bufPtr);
419 tony 45 end;
420    
421     end.
422    
423 tony 56