ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/FBClientAPI.pas
Revision: 319
Committed: Thu Feb 25 12:05:40 2021 UTC (3 years, 1 month ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/FBClientAPI.pas
File size: 20177 byte(s)
Log Message:
Merge into public release

File Contents

# Content
1 (*
2 * Firebird Interface (fbintf). The fbintf components provide a set of
3 * Pascal language bindings for the Firebird API. Although predominantly
4 * a new development they include source code taken from IBX and may be
5 * considered a derived product. This software thus also includes the copyright
6 * notice and license conditions from IBX.
7 *
8 * Except for those parts dervied from IBX, contents of this file are subject
9 * to the Initial Developer's Public License Version 1.0 (the "License"); you
10 * may not use this file except in compliance with the License. You may obtain a
11 * copy of the License here:
12 *
13 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
14 *
15 * Software distributed under the License is distributed on an "AS
16 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
17 * implied. See the License for the specific language governing rights
18 * and limitations under the License.
19 *
20 * The Initial Developer of the Original Code is Tony Whyman.
21 *
22 * The Original Code is (C) 2016 Tony Whyman, MWA Software
23 * (http://www.mwasoftware.co.uk).
24 *
25 * All Rights Reserved.
26 *
27 * Contributor(s): ______________________________________.
28 *
29 *)
30 {************************************************************************}
31 { }
32 { Borland Delphi Visual Component Library }
33 { InterBase Express core components }
34 { }
35 { Copyright (c) 1998-2000 Inprise Corporation }
36 { }
37 { InterBase Express is based in part on the product }
38 { Free IB Components, written by Gregory H. Deatz for }
39 { Hoagland, Longo, Moran, Dunst & Doukas Company. }
40 { Free IB Components is used under license. }
41 { }
42 { The contents of this file are subject to the InterBase }
43 { Public License Version 1.0 (the "License"); you may not }
44 { use this file except in compliance with the License. You }
45 { may obtain a copy of the License at http://www.Inprise.com/IPL.html }
46 { Software distributed under the License is distributed on }
47 { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
48 { express or implied. See the License for the specific language }
49 { governing rights and limitations under the License. }
50 { The Original Code was created by InterBase Software Corporation }
51 { and its successors. }
52 { Portions created by Inprise Corporation are Copyright (C) Inprise }
53 { Corporation. All Rights Reserved. }
54 { Contributor(s): Jeff Overcash }
55 { }
56 { IBX For Lazarus (Firebird Express) }
57 { Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
58 { Portions created by MWA Software are copyright McCallum Whyman }
59 { Associates Ltd 2011 - 2015 }
60 { }
61 {************************************************************************}
62 unit FBClientAPI;
63 {$IFDEF MSWINDOWS}
64 {$DEFINE WINDOWS}
65 {$ENDIF}
66
67 {$IFDEF FPC}
68 {$mode delphi}
69 {$codepage UTF8}
70 {$interfaces COM}
71 {$ENDIF}
72
73 interface
74
75 uses
76 Classes,
77 {$IFDEF WINDOWS}Windows, {$ENDIF}
78 {$IFDEF FPC} Dynlibs, {$ENDIF}
79 IB, IBHeader, FBActivityMonitor, FBMessages, IBExternals, FmtBCD;
80
81 {For Linux see result of GetFirebirdLibListruntime/nongui/winipc.inc method}
82 {$IFDEF DARWIN}
83 const
84 FIREBIRD_SO2 = 'libfbclient.dylib';
85 {$ENDIF}
86 {$IFDEF WINDOWS}
87 const
88 IBASE_DLL = 'gds32.dll';
89 FIREBIRD_CLIENT = 'fbclient.dll'; {do not localize}
90 FIREBIRD_EMBEDDED = 'fbembed.dll';
91 {$ENDIF}
92
93 const
94 {fb_shutdown reasons}
95 fb_shutrsn_svc_stopped = -1;
96 fb_shutrsn_no_connection = -2;
97 fb_shutrsn_app_stopped = -3;
98 fb_shutrsn_signal = -5;
99 fb_shutrsn_services = -6;
100 fb_shutrsn_exit_called = -7;
101
102 const
103 DefaultTimeZoneFile = '/etc/timezone';
104
105 const
106 IBLocalBufferLength = 512;
107 IBBigLocalBufferLength = IBLocalBufferLength * 2;
108 IBHugeLocalBufferLength = IBBigLocalBufferLength * 20;
109
110 type
111 TStatusVector = array[0..19] of NativeInt;
112 PStatusVector = ^TStatusVector;
113
114 TFBClientAPI = class;
115
116 { TFBStatus }
117
118 TFBStatus = class(TFBInterfacedObject)
119 private
120 FIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
121 protected
122 FOwner: TFBClientAPI;
123 public
124 constructor Create(aOwner: TFBClientAPI);
125 function StatusVector: PStatusVector; virtual; abstract;
126
127 {IStatus}
128 function GetIBErrorCode: Long;
129 function Getsqlcode: Long;
130 function GetMessage: AnsiString;
131 function CheckStatusVector(ErrorCodes: array of TFBStatusCode): Boolean;
132 function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
133 procedure SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages);
134 end;
135
136 { TFBLibrary }
137
138 TFBLibrary = class(TFBInterfacedObject,IFirebirdLibrary)
139 private
140 class var FEnvSetupDone: boolean;
141 class var FLibraryList: array of IFirebirdLibrary;
142 private
143 FFirebirdAPI: IFirebirdAPI;
144 FRequestedLibName: string;
145 function LoadIBLibrary: boolean;
146 protected
147 FFBLibraryName: string;
148 FIBLibrary: TLibHandle;
149 procedure FreeFBLibrary;
150 function GetOverrideLibName: string;
151 class procedure SetupEnvironment;
152 protected
153 function GetFirebird3API: IFirebirdAPI; virtual; abstract;
154 function GetLegacyFirebirdAPI: IFirebirdAPI; virtual; abstract;
155 public
156 constructor Create(aLibPathName: string='');
157 destructor Destroy; override;
158 class function GetFBLibrary(aLibPathName: string): IFirebirdLibrary;
159 class procedure FreeLibraries;
160 function SameLibrary(aLibName: string): boolean;
161
162 public
163 {IFirebirdLibrary}
164 function GetHandle: TLibHandle;
165 function GetLibraryName: string;
166 function GetLibraryFilePath: string;
167 function GetFirebirdAPI: IFirebirdAPI;
168 property IBLibrary: TLibHandle read FIBLibrary;
169 end;
170
171 { TFBClientAPI }
172
173 TFBClientAPI = class(TFBInterfacedObject)
174 private
175 FLocalTimeZoneName: AnsiString; {Informal Time Zone Name from tzname e.g. GMT or BST}
176 FTZDataTimeZoneID: AnsiString; {TZData DB ID e.g. Europe/London}
177 FLocalTimeOffset: integer;
178 FIsDaylightSavingsTime: boolean;
179 class var FIBCS: TRTLCriticalSection;
180 function FBTimeStampToDateTime(aDate, aTime: longint): TDateTime;
181 procedure GetTZDataSettings;
182 protected
183 FFBLibrary: TFBLibrary;
184 function GetProcAddr(ProcName: PAnsiChar): Pointer;
185
186 protected type
187 Tfb_shutdown = function (timeout: uint;
188 const reason: int): int;
189 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
190 protected
191 {FB Shutdown API}
192 fb_shutdown: Tfb_shutdown;
193
194 public
195 {Taken from legacy API}
196 isc_sqlcode: Tisc_sqlcode;
197 isc_sql_interprete: Tisc_sql_interprete;
198 isc_event_counts: Tisc_event_counts;
199 isc_event_block: Tisc_event_block;
200 isc_free: Tisc_free;
201
202 constructor Create(aFBLibrary: TFBLibrary);
203 procedure IBAlloc(var P; OldSize, NewSize: Integer);
204 procedure IBDataBaseError;
205 function LoadInterface: boolean; virtual;
206 procedure FBShutdown; virtual;
207 function GetAPI: IFirebirdAPI; virtual; abstract;
208 {$IFDEF UNIX}
209 function GetFirebirdLibList: string; virtual; abstract;
210 {$ENDIF}
211 function HasDecFloatSupport: boolean;
212 function HasInt128Support: boolean; virtual;
213 function HasLocalTZDB: boolean; virtual;
214 function HasExtendedTZSupport: boolean; virtual;
215 function HasTimeZoneSupport: boolean; virtual;
216
217 public
218 property LocalTimeZoneName: AnsiString read FLocalTimeZoneName;
219 property TZDataTimeZoneID: AnsiString read FTZDataTimeZoneID;
220 property LocalTimeOffset: integer read FLocalTimeOffset;
221 public
222 {Encode/Decode}
223 procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte);
224 function DecodeInteger(bufptr: PByte; len: short): integer; virtual; abstract;
225 procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); virtual; abstract;
226 function SQLDecodeDate(byfptr: PByte): TDateTime; virtual; abstract;
227 procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); virtual; abstract;
228 function SQLDecodeTime(bufptr: PByte): TDateTime; virtual; abstract;
229 procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); virtual; abstract;
230 function SQLDecodeDateTime(bufptr: PByte): TDateTime; virtual; abstract;
231 function FormatStatus(Status: TFBStatus): AnsiString; virtual; abstract;
232 function Int128ToStr(bufptr: PByte; scale: integer): AnsiString; virtual;
233 procedure StrToInt128(scale: integer; aValue: AnsiString; bufptr: PByte);
234 virtual;
235 procedure SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal; bufptr: PByte); virtual;
236 function SQLDecFloatDecode(SQLType: cardinal; bufptr: PByte): tBCD; virtual;
237
238 {IFirebirdAPI}
239 function GetStatus: IStatus; virtual; abstract;
240 function IsLibraryLoaded: boolean;
241 function IsEmbeddedServer: boolean; virtual; abstract;
242 function GetFBLibrary: IFirebirdLibrary;
243 function GetImplementationVersion: AnsiString;
244 function GetClientMajor: integer; virtual; abstract;
245 function GetClientMinor: integer; virtual; abstract;
246 end;
247
248 implementation
249
250 uses IBUtils, Registry,
251 {$IFDEF Unix} unix, initc, dl, {$ENDIF}
252 {$IFDEF FPC}
253 {$IFDEF WINDOWS }
254 WinDirs,
255 {$ENDIF}
256 {$ELSE}
257 ShlObj,
258 {$ENDIF}
259 SysUtils;
260
261 {$IFDEF UNIX}
262 {$I 'include/uloadlibrary.inc'}
263 {$ELSE}
264 {$I 'include/wloadlibrary.inc'}
265 {$ENDIF}
266
267
268 { TFBLibrary }
269
270 function TFBLibrary.GetOverrideLibName: string;
271 begin
272 Result := FFBLibraryName;
273 if (Result = '') and AllowUseOfFBLIB then
274 Result := GetEnvironmentVariable('FBLIB');
275 if Result = '' then
276 begin
277 if assigned(OnGetLibraryName) then
278 OnGetLibraryName(Result)
279 end;
280 end;
281
282 procedure TFBLibrary.FreeFBLibrary;
283 begin
284 (FFirebirdAPI as TFBClientAPI).FBShutdown;
285 if FIBLibrary <> NilHandle then
286 FreeLibrary(FIBLibrary);
287 FIBLibrary := NilHandle;
288 FFBLibraryName := '';
289 end;
290
291 function TFBLibrary.GetLibraryName: string;
292 begin
293 Result := ExtractFileName(FFBLibraryName);
294 end;
295
296 function TFBLibrary.GetFirebirdAPI: IFirebirdAPI;
297 begin
298 Result := FFirebirdAPI;
299 end;
300
301 constructor TFBLibrary.Create(aLibPathName: string);
302 begin
303 inherited Create;
304 SetupEnvironment;
305 FFBLibraryName := aLibPathName;
306 FIBLibrary := NilHandle;
307 FFirebirdAPI := GetFirebird3API;
308 FRequestedLibName := aLibPathName;
309 if aLibPathName <> '' then
310 begin
311 SetLength(FLibraryList,Length(FLibraryList)+1);
312 FLibraryList[Length(FLibraryList)-1] := self;
313 end;
314 if FFirebirdAPI <> nil then
315 begin
316 {First try Firebird 3}
317 if not LoadIBLibrary or not (FFirebirdAPI as TFBClientAPI).LoadInterface then
318 FFirebirdAPI := nil;
319 end;
320
321 if FFirebirdAPI = nil then
322 begin
323 {now try Firebird 2.5. Under Unix we need to reload the library in case we
324 are to use the embedded library}
325 FFirebirdAPI := GetLegacyFirebirdAPI;
326 if FFirebirdAPI <> nil then
327 begin
328 {$IFDEF UNIX}
329 FreeFBLibrary;
330 {$ENDIF}
331 if not LoadIBLibrary or not (FFirebirdAPI as TFBClientAPI).LoadInterface then
332 FFirebirdAPI := nil;
333 end;
334 end;
335 {Note: FFirebirdAPI will be set to nil if the Firebird API fails to load}
336 end;
337
338 destructor TFBLibrary.Destroy;
339 begin
340 FreeFBLibrary;
341 FFirebirdAPI := nil;
342 inherited Destroy;
343 end;
344
345 class function TFBLibrary.GetFBLibrary(aLibPathName: string): IFirebirdLibrary;
346 var i: integer;
347 begin
348 Result := nil;
349 if aLibPathName <> '' then
350 begin
351 for i := 0 to Length(FLibraryList) - 1 do
352 begin
353 if (FLibraryList[i] as TFBLibrary).SameLibrary(aLibPathName) then
354 begin
355 Result := FLibraryList[i];
356 Exit;
357 end;
358 end;
359 Result := Create(aLibPathName);
360 end;
361
362 end;
363
364 class procedure TFBLibrary.FreeLibraries;
365 var i: integer;
366 begin
367 for i := 0 to Length(FLibraryList) - 1 do
368 FLibraryList[i] := nil;
369 SetLength(FLibraryList,0);
370 end;
371
372 function TFBLibrary.SameLibrary(aLibName: string): boolean;
373 begin
374 Result := FRequestedLibName = aLibName;
375 end;
376
377 function TFBLibrary.GetHandle: TLibHandle;
378 begin
379 Result := FIBLibrary;
380 end;
381
382 { TFBClientAPI }
383
384 constructor TFBClientAPI.Create(aFBLibrary: TFBLibrary);
385 begin
386 inherited Create;
387 FFBLibrary := aFBLibrary;
388 GetTZDataSettings;
389 end;
390
391 procedure TFBClientAPI.IBAlloc(var P; OldSize, NewSize: Integer);
392 var
393 i: Integer;
394 begin
395 ReallocMem(Pointer(P), NewSize);
396 for i := OldSize to NewSize - 1 do PAnsiChar(P)[i] := #0;
397 end;
398
399 procedure TFBClientAPI.IBDataBaseError;
400 begin
401 raise EIBInterBaseError.Create(GetStatus);
402 end;
403
404 procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
405 begin
406 while len > 0 do
407 begin
408 buffer^ := aValue and $FF;
409 Inc(buffer);
410 Dec(len);
411 aValue := aValue shr 8;
412 end;
413 end;
414
415 function TFBClientAPI.Int128ToStr(bufptr: PByte; scale: integer): AnsiString;
416 begin
417 if not HasInt128Support then
418 IBError(ibxeNotSupported,[]);
419 end;
420
421 procedure TFBClientAPI.StrToInt128(scale: integer; aValue: AnsiString; bufptr: PByte);
422 begin
423 if not HasInt128Support then
424 IBError(ibxeNotSupported,[]);
425 end;
426
427 procedure TFBClientAPI.SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal;
428 bufptr: PByte);
429 begin
430 if not HasDecFloatSupport then
431 IBError(ibxeNotSupported,[]);
432 end;
433
434 function TFBClientAPI.SQLDecFloatDecode(SQLType: cardinal; bufptr: PByte): tBCD;
435 begin
436 if not HasDecFloatSupport then
437 IBError(ibxeNotSupported,[]);
438 end;
439
440 function TFBClientAPI.IsLibraryLoaded: boolean;
441 begin
442 Result := FFBLibrary.IBLibrary <> NilHandle;
443 end;
444
445 function TFBClientAPI.GetFBLibrary: IFirebirdLibrary;
446 begin
447 Result := FFBLibrary;
448 end;
449
450 function TFBClientAPI.FBTimeStampToDateTime(aDate, aTime: longint): TDateTime;
451 begin
452 {aDate/aTime are in TTimestamp format but aTime is decimilliseconds}
453 aDate := aDate - DateDelta;
454 if aDate < 0 then
455 Result := trunc(aDate) - abs(frac(aTime / (MSecsPerDay*10)))
456 else
457 Result := trunc(aDate) + abs(frac(aTime / (MSecsPerDay*10)));
458 end;
459
460 {$IFDEF UNIX}
461 procedure TFBClientAPI.GetTZDataSettings;
462 var S: TStringList;
463 begin
464 FLocalTimeOffset := GetLocalTimeOffset;
465 FLocalTimeZoneName := strpas(tzname[tzdaylight]);
466 FIsDaylightSavingsTime := tzdaylight;
467 if FileExists(DefaultTimeZoneFile) then
468 begin
469 S := TStringList.Create;
470 try
471 S.LoadFromFile(DefaultTimeZoneFile);
472 if S.Count > 0 then
473 FTZDataTimeZoneID := S[0];
474 finally
475 S.Free;
476 end;
477 end;
478 end;
479 {$ENDIF}
480
481 {$IFDEF WINDOWS}
482 procedure TFBClientAPI.GetTZDataSettings;
483 var TZInfo: TTimeZoneInformation;
484 begin
485 FIsDaylightSavingsTime := false;
486 {is there any way of working out the default TZData DB time zone ID under Windows?}
487 case GetTimeZoneInformation(TZInfo) of
488 TIME_ZONE_ID_UNKNOWN:
489 begin
490 FLocalTimeZoneName := '';
491 FLocalTimeOffset := 0;
492 end;
493 TIME_ZONE_ID_STANDARD:
494 begin
495 FLocalTimeZoneName := strpas(PWideChar(@TZInfo.StandardName));
496 FLocalTimeOffset := TZInfo.Bias;
497 end;
498 TIME_ZONE_ID_DAYLIGHT:
499 begin
500 FLocalTimeZoneName := strpas(PWideChar(@TZInfo.DaylightName));
501 FLocalTimeOffset := TZInfo.DayLightBias;
502 FIsDaylightSavingsTime := true;
503 end;
504 end;
505 end;
506 {$ENDIF}
507
508 function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer;
509 begin
510 Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
511 if not Assigned(Result) then
512 raise Exception.CreateFmt(SFirebirdAPIFuncNotFound,[ProcName]);
513 end;
514
515 function TFBClientAPI.HasDecFloatSupport: boolean;
516 begin
517 Result := GetClientMajor >= 4;
518 end;
519
520 function TFBClientAPI.HasInt128Support: boolean;
521 begin
522 Result := false;
523 end;
524
525 function TFBClientAPI.HasLocalTZDB: boolean;
526 begin
527 Result := false;
528 end;
529
530 function TFBClientAPI.HasExtendedTZSupport: boolean;
531 begin
532 Result := false;
533 end;
534
535 function TFBClientAPI.HasTimeZoneSupport: boolean;
536 begin
537 Result := false;
538 end;
539
540 function TFBClientAPI.GetImplementationVersion: AnsiString;
541 begin
542 Result := Format('%d.%d',[GetClientMajor,GetClientMinor]);
543 end;
544
545 function TFBClientAPI.LoadInterface: boolean;
546 begin
547 isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize}
548 isc_sql_interprete := GetProcAddr('isc_sql_interprete'); {do not localize}
549 isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize}
550 isc_event_block := GetProcAddr('isc_event_block'); {do not localize}
551 isc_free := GetProcAddr('isc_free'); {do not localize}
552 fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize}
553 Result := assigned(isc_free);
554 end;
555
556 procedure TFBClientAPI.FBShutdown;
557 begin
558 if assigned(fb_shutdown) then
559 fb_shutdown(0,fb_shutrsn_exit_called);
560 end;
561
562 { TFBStatus }
563
564 constructor TFBStatus.Create(aOwner: TFBClientAPI);
565 begin
566 inherited Create;
567 FOwner := aOwner;
568 FIBDataBaseErrorMessages := [ShowSQLMessage, ShowIBMessage];
569 end;
570
571 function TFBStatus.GetIBErrorCode: Long;
572 begin
573 Result := StatusVector^[1];
574 end;
575
576 function TFBStatus.Getsqlcode: Long;
577 begin
578 with FOwner do
579 Result := isc_sqlcode(PISC_STATUS(StatusVector));
580 end;
581
582 function TFBStatus.GetMessage: AnsiString;
583 var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
584 IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
585 sqlcode: Long;
586 begin
587 Result := '';
588 IBDataBaseErrorMessages := FIBDataBaseErrorMessages;
589 sqlcode := Getsqlcode;
590 if (ShowSQLCode in IBDataBaseErrorMessages) then
591 Result := Result + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize}
592
593 Exclude(IBDataBaseErrorMessages, ShowSQLMessage);
594 if (ShowSQLMessage in IBDataBaseErrorMessages) then
595 begin
596 with FOwner do
597 isc_sql_interprete(sqlcode, local_buffer, sizeof(local_buffer));
598 if (ShowSQLCode in FIBDataBaseErrorMessages) then
599 Result := Result + CRLF;
600 Result := Result + strpas(local_buffer);
601 end;
602
603 if (ShowIBMessage in IBDataBaseErrorMessages) then
604 begin
605 if (ShowSQLCode in IBDataBaseErrorMessages) or
606 (ShowSQLMessage in IBDataBaseErrorMessages) then
607 Result := Result + LineEnding;
608 Result := Result + FOwner.FormatStatus(self);
609 end;
610 if (Result <> '') and (Result[Length(Result)] = '.') then
611 Delete(Result, Length(Result), 1);
612 end;
613
614 function TFBStatus.CheckStatusVector(ErrorCodes: array of TFBStatusCode
615 ): Boolean;
616 var
617 p: PISC_STATUS;
618 i: Integer;
619 procedure NextP(i: Integer);
620 begin
621 p := PISC_STATUS(PAnsiChar(p) + (i * SizeOf(ISC_STATUS)));
622 end;
623 begin
624 p := PISC_STATUS(StatusVector);
625 result := False;
626 while (p^ <> 0) and (not result) do
627 case p^ of
628 3: NextP(3);
629 1, 4:
630 begin
631 NextP(1);
632 i := 0;
633 while (i <= High(ErrorCodes)) and (not result) do
634 begin
635 result := p^ = ErrorCodes[i];
636 Inc(i);
637 end;
638 NextP(1);
639 end;
640 else
641 NextP(2);
642 end;
643 end;
644
645 function TFBStatus.GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
646 begin
647 EnterCriticalSection(TFBClientAPI.FIBCS);
648 try
649 result := FIBDataBaseErrorMessages;
650 finally
651 LeaveCriticalSection(TFBClientAPI.FIBCS);
652 end;
653 end;
654
655 procedure TFBStatus.SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages);
656 begin
657 EnterCriticalSection(TFBClientAPI.FIBCS);
658 try
659 FIBDataBaseErrorMessages := Value;
660 finally
661 LeaveCriticalSection(TFBClientAPI.FIBCS);
662 end;
663 end;
664
665 initialization
666 TFBLibrary.FEnvSetupDone := false;
667 {$IFNDEF FPC}
668 InitializeCriticalSection(TFBClientAPI.FIBCS);
669 {$ELSE}
670 InitCriticalSection(TFBClientAPI.FIBCS);
671 {$ENDIF}
672
673 finalization
674 TFBLibrary.FreeLibraries;
675 {$IFNDEF FPC}
676 DeleteCriticalSection(TFBClientAPI.FIBCS);
677 {$ELSE}
678 DoneCriticalSection(TFBClientAPI.FIBCS);
679 {$ENDIF}
680 end.
681