ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBClientAPI.pas
(Generate patch)

Comparing ibx/trunk/fbintf/client/FBClientAPI.pas (file contents):
Revision 47 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
Revision 56 by tony, Mon Mar 6 10:20:02 2017 UTC

# Line 60 | Line 60
60   {                                                                        }
61   {************************************************************************}
62   unit FBClientAPI;
63 + {$IFDEF MSWINDOWS}
64 + {$DEFINE WINDOWS}
65 + {$ENDIF}
66  
67   {$IFDEF FPC}
68   {$mode delphi}
# Line 70 | Line 73 | unit FBClientAPI;
73   interface
74  
75   uses
76 <  Classes,  Dynlibs, IB, IBHeader, FBActivityMonitor, FBMessages, IBExternals;
76 >  Classes,
77 >    {$IFDEF WINDOWS}Windows, {$ENDIF}
78 >    {$IFDEF FPC} Dynlibs, {$ENDIF}
79 >   IB, IBHeader, FBActivityMonitor, FBMessages, IBExternals;
80  
81   {For Linux see result of GetFirebirdLibList method}
82   {$IFDEF DARWIN}
# Line 84 | Line 90 | FIREBIRD_CLIENT = 'fbclient.dll'; {do no
90   FIREBIRD_EMBEDDED = 'fbembed.dll';
91   {$ENDIF}
92  
93 + {$IFNDEF FPC}
94 + type
95 +  TLibHandle = THandle;
96 +
97 + const
98 +  NilHandle = 0;
99 +  DirectorySeparator = '\';
100 + {$ENDIF}
101 +
102   type
103    TStatusVector              = array[0..19] of NativeInt;
104    PStatusVector              = ^TStatusVector;
# Line 94 | Line 109 | type
109  
110    TFBStatus = class(TFBInterfacedObject)
111    private
97    FIBCS: TRTLCriticalSection; static;
112      FIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
113    protected
114      FOwner: TFBClientAPI;
# Line 105 | Line 119 | type
119      {IStatus}
120      function GetIBErrorCode: Long;
121      function Getsqlcode: Long;
122 <    function GetMessage: string;
122 >    function GetMessage: AnsiString;
123      function CheckStatusVector(ErrorCodes: array of TFBStatusCode): Boolean;
124      function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
125      procedure SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages);
# Line 116 | Line 130 | type
130    TFBClientAPI = class(TFBInterfacedObject)
131    private
132      FOwnsIBLibrary: boolean;
133 +    class var FIBCS: TRTLCriticalSection;
134      procedure LoadIBLibrary;
135    protected
136 <    FFBLibraryName: string; static;
137 <    FFBLibraryPath: string; static;
138 <    IBLibrary: TLibHandle; static;
139 <    function GetProcAddr(ProcName: PChar): Pointer;
136 >    class var FFBLibraryName: string;
137 >    class var IBLibrary: TLibHandle;
138 >    {$IFDEF WINDOWS}
139 >    class var FFBLibraryPath: string;
140 >    {$ENDIF}
141 >    function GetProcAddr(ProcName: PAnsiChar): Pointer;
142      function GetOverrideLibName: string;
143      {$IFDEF UNIX}
144      function GetFirebirdLibList: string; virtual; abstract;
# Line 143 | Line 160 | type
160      procedure SetupEnvironment;
161  
162      {Encode/Decode}
163 <    procedure EncodeInteger(aValue: integer; len: integer; buffer: PChar);
164 <    function DecodeInteger(bufptr: PChar; len: short): integer; virtual; abstract;
165 <    procedure SQLEncodeDate(aDate: TDateTime; bufptr: PChar); virtual; abstract;
166 <    function SQLDecodeDate(byfptr: PChar): TDateTime; virtual; abstract;
167 <    procedure SQLEncodeTime(aTime: TDateTime; bufptr: PChar); virtual; abstract;
168 <    function SQLDecodeTime(bufptr: PChar): TDateTime;  virtual; abstract;
169 <    procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PChar); virtual; abstract;
170 <    function SQLDecodeDateTime(bufptr: PChar): TDateTime; virtual; abstract;
163 >    procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte);
164 >    function DecodeInteger(bufptr: PByte; len: short): integer; virtual; abstract;
165 >    procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); virtual; abstract;
166 >    function SQLDecodeDate(byfptr: PByte): TDateTime; virtual; abstract;
167 >    procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); virtual; abstract;
168 >    function SQLDecodeTime(bufptr: PByte): TDateTime;  virtual; abstract;
169 >    procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); virtual; abstract;
170 >    function SQLDecodeDateTime(bufptr: PByte): TDateTime; virtual; abstract;
171  
172  
173      {IFirebirdAPI}
# Line 158 | Line 175 | type
175      function IsLibraryLoaded: boolean;
176      function IsEmbeddedServer: boolean; virtual; abstract;
177      function GetLibraryName: string;
178 <    function GetCharsetName(CharSetID: integer): string;
178 >    function GetCharsetName(CharSetID: integer): AnsiString;
179      function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
180      function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
181 <    function CharSetName2CharSetID(CharSetName: string; var CharSetID: integer): boolean;
181 >    function CharSetName2CharSetID(CharSetName: AnsiString; var CharSetID: integer): boolean;
182      function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
183    end;
184  
185 < const FirebirdClientAPI: TFBClientAPI = nil;
185 > var FirebirdClientAPI: TFBClientAPI = nil;
186  
187   implementation
188  
189 < uses IBUtils, {$IFDEF Unix} initc, {$ENDIF}
189 > uses IBUtils, Registry, {$IFDEF Unix} initc, {$ENDIF}
190 > {$IFDEF FPC}
191   {$IFDEF WINDOWS }
192 < Windows,Registry, WinDirs,
192 > WinDirs,
193 > {$ENDIF}
194 > {$ELSE}
195 > ShlObj,
196   {$ENDIF}
197   SysUtils;
198  
199   {$IFDEF UNIX}
200 < {$I uloadlibrary.inc}
200 > {$I 'include/uloadlibrary.inc'}
201   {$ELSE}
202 < {$I wloadlibrary.inc}
202 > {$I 'include/wloadlibrary.inc'}
203   {$ENDIF}
204  
205   type
206    TCharsetMap = record
207      CharsetID: integer;
208 <    CharSetName: string;
208 >    CharSetName: AnsiString;
209      CharSetWidth: integer;
210      CodePage: TSystemCodePage;
211    end;
# Line 267 | Line 288 | const
288    {SetEnvironmentVariable doesn't exist so we have to use C Library}
289    function setenv(name:Pchar; value:Pchar; replace:integer):integer;cdecl;external clib name 'setenv';
290    function unsetenv(name:Pchar):integer;cdecl;external clib name 'unsetenv';
291 <  function SetEnvironmentVariable(name:PChar; value:PChar):boolean;
291 >  function SetEnvironmentVariable(name:PAnsiChar; value:PAnsiChar):boolean;
292    // Set environment variable; if empty string given, remove it.
293    begin
294      result:=false; //assume failure
# Line 302 | Line 323 | destructor TFBClientAPI.Destroy;
323   begin
324    FirebirdClientAPI := nil;
325    if FOwnsIBLibrary and (IBLibrary <> NilHandle) then
326 <    UnloadLibrary(IBLibrary);
326 >    FreeLibrary(IBLibrary);
327    IBLibrary := NilHandle;
328    inherited Destroy;
329   end;
# Line 312 | Line 333 | var
333    i: Integer;
334   begin
335    ReallocMem(Pointer(P), NewSize);
336 <  for i := OldSize to NewSize - 1 do PChar(P)[i] := #0;
336 >  for i := OldSize to NewSize - 1 do PAnsiChar(P)[i] := #0;
337   end;
338  
339   procedure TFBClientAPI.IBDataBaseError;
# Line 323 | Line 344 | end;
344   {Under Unixes, if using an embedded server then set up local TMP and LOCK Directories}
345  
346   procedure TFBClientAPI.SetupEnvironment;
347 < var TmpDir: string;
347 > var TmpDir: AnsiString;
348   begin
349    {$IFDEF UNIX}
350      TmpDir := GetTempDir +
# Line 332 | Line 353 | begin
353      begin
354        if not DirectoryExists(tmpDir) then
355          mkdir(tmpDir);
356 <      SetEnvironmentVariable('FIREBIRD_TMP',PChar(TmpDir));
356 >      SetEnvironmentVariable('FIREBIRD_TMP',PAnsiChar(TmpDir));
357      end;
358      if sysutils.GetEnvironmentVariable('FIREBIRD_LOCK') = '' then
359      begin
360        if not DirectoryExists(tmpDir) then
361          mkdir(tmpDir);
362 <      SetEnvironmentVariable('FIREBIRD_LOCK',PChar(TmpDir));
362 >      SetEnvironmentVariable('FIREBIRD_LOCK',PAnsiChar(TmpDir));
363      end;
364    {$ENDIF}
365   end;
366  
367 < procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PChar);
367 > procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
368   begin
369    while len > 0 do
370    begin
371 <    buffer^ := char(aValue and $FF);
371 >    buffer^ := aValue and $FF;
372      Inc(buffer);
373      Dec(len);
374      aValue := aValue shr 8;
# Line 359 | Line 380 | begin
380    Result := IBLibrary <> NilHandle;
381   end;
382  
383 < function TFBClientAPI.GetProcAddr(ProcName: PChar): Pointer;
383 > function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer;
384   begin
385    Result := GetProcAddress(IBLibrary, ProcName);
386    if not Assigned(Result) then
# Line 393 | Line 414 | begin
414    Result := FFBLibraryName;
415   end;
416  
417 < function TFBClientAPI.GetCharsetName(CharSetID: integer): string;
417 > function TFBClientAPI.GetCharsetName(CharSetID: integer): AnsiString;
418   begin
419    Result := '';
420    if (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap)) and
# Line 431 | Line 452 | begin
452      end;
453   end;
454  
455 < function TFBClientAPI.CharSetName2CharSetID(CharSetName: string;
455 > function TFBClientAPI.CharSetName2CharSetID(CharSetName: AnsiString;
456    var CharSetID: integer): boolean;
457   var i: integer;
458   begin
459    Result := false;
460    for i := Low(CharSetMap) to High(CharSetMap) do
461 <    if CompareStr(CharSetMap[i].CharSetName, CharSetName) = 0 then
461 >    if AnsiCompareStr(CharSetMap[i].CharSetName, CharSetName) = 0 then
462      begin
463        CharSetID := CharSetMap[i].CharSetID;
464        Result := true;
# Line 483 | Line 504 | begin
504      Result := isc_sqlcode(PISC_STATUS(StatusVector));
505   end;
506  
507 < function TFBStatus.GetMessage: string;
508 < var local_buffer: array[0..IBHugeLocalBufferLength - 1] of char;
507 > function TFBStatus.GetMessage: AnsiString;
508 > var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
509      IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
510      sqlcode: Long;
511      psb: PStatusVector;
# Line 530 | Line 551 | var
551    i: Integer;
552    procedure NextP(i: Integer);
553    begin
554 <    p := PISC_STATUS(PChar(p) + (i * SizeOf(ISC_STATUS)));
554 >    p := PISC_STATUS(PAnsiChar(p) + (i * SizeOf(ISC_STATUS)));
555    end;
556   begin
557    p := PISC_STATUS(StatusVector);
# Line 556 | Line 577 | end;
577  
578   function TFBStatus.GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
579   begin
580 <  EnterCriticalSection(FIBCS);
580 >  EnterCriticalSection(TFBClientAPI.FIBCS);
581    try
582      result := FIBDataBaseErrorMessages;
583    finally
584 <    LeaveCriticalSection(FIBCS);
584 >    LeaveCriticalSection(TFBClientAPI.FIBCS);
585    end;
586   end;
587  
588   procedure TFBStatus.SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages);
589   begin
590 <  EnterCriticalSection(FIBCS);
590 >  EnterCriticalSection(TFBClientAPI.FIBCS);
591    try
592      FIBDataBaseErrorMessages := Value;
593    finally
594 <    LeaveCriticalSection(FIBCS);
594 >    LeaveCriticalSection(TFBClientAPI.FIBCS);
595    end;
596   end;
597   initialization
598    TFBClientAPI.IBLibrary := NilHandle;
599 <  InitCriticalSection(TFBStatus.FIBCS);
599 >  {$IFNDEF FPC}
600 >  InitializeCriticalSection(TFBClientAPI.FIBCS);
601 >  {$ELSE}
602 >  InitCriticalSection(TFBClientAPI.FIBCS);
603 >  {$ENDIF}
604  
605   finalization
606 <  DoneCriticalSection(TFBStatus.FIBCS);
606 >  {$IFNDEF FPC}
607 >  DeleteCriticalSection(TFBClientAPI.FIBCS);
608 >  {$ELSE}
609 >  DoneCriticalSection(TFBClientAPI.FIBCS);
610 >  {$ENDIF}
611    if TFBClientAPI.IBLibrary <> NilHandle then
612    begin
613      FreeLibrary(TFBClientAPI.IBLibrary);

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines