--- ibx/trunk/fbintf/client/FBClientAPI.pas 2017/02/24 17:05:03 55 +++ ibx/trunk/fbintf/client/FBClientAPI.pas 2017/03/06 10:20:02 56 @@ -60,6 +60,9 @@ { } {************************************************************************} unit FBClientAPI; +{$IFDEF MSWINDOWS} +{$DEFINE WINDOWS} +{$ENDIF} {$IFDEF FPC} {$mode delphi} @@ -70,7 +73,10 @@ unit FBClientAPI; interface uses - Classes, Dynlibs, IB, IBHeader, FBActivityMonitor, FBMessages, IBExternals; + Classes, + {$IFDEF WINDOWS}Windows, {$ENDIF} + {$IFDEF FPC} Dynlibs, {$ENDIF} + IB, IBHeader, FBActivityMonitor, FBMessages, IBExternals; {For Linux see result of GetFirebirdLibList method} {$IFDEF DARWIN} @@ -84,6 +90,15 @@ FIREBIRD_CLIENT = 'fbclient.dll'; {do no FIREBIRD_EMBEDDED = 'fbembed.dll'; {$ENDIF} +{$IFNDEF FPC} +type + TLibHandle = THandle; + +const + NilHandle = 0; + DirectorySeparator = '\'; +{$ENDIF} + type TStatusVector = array[0..19] of NativeInt; PStatusVector = ^TStatusVector; @@ -94,7 +109,6 @@ type TFBStatus = class(TFBInterfacedObject) private - FIBCS: TRTLCriticalSection; static; FIBDataBaseErrorMessages: TIBDataBaseErrorMessages; protected FOwner: TFBClientAPI; @@ -105,7 +119,7 @@ type {IStatus} function GetIBErrorCode: Long; function Getsqlcode: Long; - function GetMessage: string; + function GetMessage: AnsiString; function CheckStatusVector(ErrorCodes: array of TFBStatusCode): Boolean; function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages; procedure SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages); @@ -116,12 +130,15 @@ type TFBClientAPI = class(TFBInterfacedObject) private FOwnsIBLibrary: boolean; + class var FIBCS: TRTLCriticalSection; procedure LoadIBLibrary; protected - FFBLibraryName: string; static; - FFBLibraryPath: string; static; - IBLibrary: TLibHandle; static; - function GetProcAddr(ProcName: PChar): Pointer; + class var FFBLibraryName: string; + class var IBLibrary: TLibHandle; + {$IFDEF WINDOWS} + class var FFBLibraryPath: string; + {$ENDIF} + function GetProcAddr(ProcName: PAnsiChar): Pointer; function GetOverrideLibName: string; {$IFDEF UNIX} function GetFirebirdLibList: string; virtual; abstract; @@ -143,14 +160,14 @@ type procedure SetupEnvironment; {Encode/Decode} - procedure EncodeInteger(aValue: integer; len: integer; buffer: PChar); - function DecodeInteger(bufptr: PChar; len: short): integer; virtual; abstract; - procedure SQLEncodeDate(aDate: TDateTime; bufptr: PChar); virtual; abstract; - function SQLDecodeDate(byfptr: PChar): TDateTime; virtual; abstract; - procedure SQLEncodeTime(aTime: TDateTime; bufptr: PChar); virtual; abstract; - function SQLDecodeTime(bufptr: PChar): TDateTime; virtual; abstract; - procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PChar); virtual; abstract; - function SQLDecodeDateTime(bufptr: PChar): TDateTime; virtual; abstract; + procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte); + function DecodeInteger(bufptr: PByte; len: short): integer; virtual; abstract; + procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); virtual; abstract; + function SQLDecodeDate(byfptr: PByte): TDateTime; virtual; abstract; + procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); virtual; abstract; + function SQLDecodeTime(bufptr: PByte): TDateTime; virtual; abstract; + procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); virtual; abstract; + function SQLDecodeDateTime(bufptr: PByte): TDateTime; virtual; abstract; {IFirebirdAPI} @@ -158,33 +175,37 @@ type function IsLibraryLoaded: boolean; function IsEmbeddedServer: boolean; virtual; abstract; function GetLibraryName: string; - function GetCharsetName(CharSetID: integer): string; + function GetCharsetName(CharSetID: integer): AnsiString; function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean; function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean; - function CharSetName2CharSetID(CharSetName: string; var CharSetID: integer): boolean; + function CharSetName2CharSetID(CharSetName: AnsiString; var CharSetID: integer): boolean; function CharSetWidth(CharSetID: integer; var Width: integer): boolean; end; -const FirebirdClientAPI: TFBClientAPI = nil; +var FirebirdClientAPI: TFBClientAPI = nil; implementation -uses IBUtils, {$IFDEF Unix} initc, {$ENDIF} +uses IBUtils, Registry, {$IFDEF Unix} initc, {$ENDIF} +{$IFDEF FPC} {$IFDEF WINDOWS } -Windows,Registry, WinDirs, +WinDirs, +{$ENDIF} +{$ELSE} + ShlObj, {$ENDIF} SysUtils; {$IFDEF UNIX} -{$I uloadlibrary.inc} +{$I 'include/uloadlibrary.inc'} {$ELSE} -{$I wloadlibrary.inc} +{$I 'include/wloadlibrary.inc'} {$ENDIF} type TCharsetMap = record CharsetID: integer; - CharSetName: string; + CharSetName: AnsiString; CharSetWidth: integer; CodePage: TSystemCodePage; end; @@ -267,7 +288,7 @@ const {SetEnvironmentVariable doesn't exist so we have to use C Library} function setenv(name:Pchar; value:Pchar; replace:integer):integer;cdecl;external clib name 'setenv'; function unsetenv(name:Pchar):integer;cdecl;external clib name 'unsetenv'; - function SetEnvironmentVariable(name:PChar; value:PChar):boolean; + function SetEnvironmentVariable(name:PAnsiChar; value:PAnsiChar):boolean; // Set environment variable; if empty string given, remove it. begin result:=false; //assume failure @@ -302,7 +323,7 @@ destructor TFBClientAPI.Destroy; begin FirebirdClientAPI := nil; if FOwnsIBLibrary and (IBLibrary <> NilHandle) then - UnloadLibrary(IBLibrary); + FreeLibrary(IBLibrary); IBLibrary := NilHandle; inherited Destroy; end; @@ -312,7 +333,7 @@ var i: Integer; begin ReallocMem(Pointer(P), NewSize); - for i := OldSize to NewSize - 1 do PChar(P)[i] := #0; + for i := OldSize to NewSize - 1 do PAnsiChar(P)[i] := #0; end; procedure TFBClientAPI.IBDataBaseError; @@ -323,7 +344,7 @@ end; {Under Unixes, if using an embedded server then set up local TMP and LOCK Directories} procedure TFBClientAPI.SetupEnvironment; -var TmpDir: string; +var TmpDir: AnsiString; begin {$IFDEF UNIX} TmpDir := GetTempDir + @@ -332,22 +353,22 @@ begin begin if not DirectoryExists(tmpDir) then mkdir(tmpDir); - SetEnvironmentVariable('FIREBIRD_TMP',PChar(TmpDir)); + SetEnvironmentVariable('FIREBIRD_TMP',PAnsiChar(TmpDir)); end; if sysutils.GetEnvironmentVariable('FIREBIRD_LOCK') = '' then begin if not DirectoryExists(tmpDir) then mkdir(tmpDir); - SetEnvironmentVariable('FIREBIRD_LOCK',PChar(TmpDir)); + SetEnvironmentVariable('FIREBIRD_LOCK',PAnsiChar(TmpDir)); end; {$ENDIF} end; -procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PChar); +procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte); begin while len > 0 do begin - buffer^ := char(aValue and $FF); + buffer^ := aValue and $FF; Inc(buffer); Dec(len); aValue := aValue shr 8; @@ -359,7 +380,7 @@ begin Result := IBLibrary <> NilHandle; end; -function TFBClientAPI.GetProcAddr(ProcName: PChar): Pointer; +function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer; begin Result := GetProcAddress(IBLibrary, ProcName); if not Assigned(Result) then @@ -393,7 +414,7 @@ begin Result := FFBLibraryName; end; -function TFBClientAPI.GetCharsetName(CharSetID: integer): string; +function TFBClientAPI.GetCharsetName(CharSetID: integer): AnsiString; begin Result := ''; if (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap)) and @@ -431,13 +452,13 @@ begin end; end; -function TFBClientAPI.CharSetName2CharSetID(CharSetName: string; +function TFBClientAPI.CharSetName2CharSetID(CharSetName: AnsiString; var CharSetID: integer): boolean; var i: integer; begin Result := false; for i := Low(CharSetMap) to High(CharSetMap) do - if CompareStr(CharSetMap[i].CharSetName, CharSetName) = 0 then + if AnsiCompareStr(CharSetMap[i].CharSetName, CharSetName) = 0 then begin CharSetID := CharSetMap[i].CharSetID; Result := true; @@ -483,8 +504,8 @@ begin Result := isc_sqlcode(PISC_STATUS(StatusVector)); end; -function TFBStatus.GetMessage: string; -var local_buffer: array[0..IBHugeLocalBufferLength - 1] of char; +function TFBStatus.GetMessage: AnsiString; +var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar; IBDataBaseErrorMessages: TIBDataBaseErrorMessages; sqlcode: Long; psb: PStatusVector; @@ -530,7 +551,7 @@ var i: Integer; procedure NextP(i: Integer); begin - p := PISC_STATUS(PChar(p) + (i * SizeOf(ISC_STATUS))); + p := PISC_STATUS(PAnsiChar(p) + (i * SizeOf(ISC_STATUS))); end; begin p := PISC_STATUS(StatusVector); @@ -556,29 +577,37 @@ end; function TFBStatus.GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages; begin - EnterCriticalSection(FIBCS); + EnterCriticalSection(TFBClientAPI.FIBCS); try result := FIBDataBaseErrorMessages; finally - LeaveCriticalSection(FIBCS); + LeaveCriticalSection(TFBClientAPI.FIBCS); end; end; procedure TFBStatus.SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages); begin - EnterCriticalSection(FIBCS); + EnterCriticalSection(TFBClientAPI.FIBCS); try FIBDataBaseErrorMessages := Value; finally - LeaveCriticalSection(FIBCS); + LeaveCriticalSection(TFBClientAPI.FIBCS); end; end; initialization TFBClientAPI.IBLibrary := NilHandle; - InitCriticalSection(TFBStatus.FIBCS); + {$IFNDEF FPC} + InitializeCriticalSection(TFBClientAPI.FIBCS); + {$ELSE} + InitCriticalSection(TFBClientAPI.FIBCS); + {$ENDIF} finalization - DoneCriticalSection(TFBStatus.FIBCS); + {$IFNDEF FPC} + DeleteCriticalSection(TFBClientAPI.FIBCS); + {$ELSE} + DoneCriticalSection(TFBClientAPI.FIBCS); + {$ENDIF} if TFBClientAPI.IBLibrary <> NilHandle then begin FreeLibrary(TFBClientAPI.IBLibrary);