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 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 60 by tony, Mon Mar 27 15:21: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;
162 <    function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
163 <    function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
164 <    function CharSetName2CharSetID(CharSetName: string; var CharSetID: integer): boolean;
165 <    function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
166 <  end;
178 > end;
179  
180 < const FirebirdClientAPI: TFBClientAPI = nil;
180 > var FirebirdClientAPI: TFBClientAPI = nil;
181  
182   implementation
183  
184 < uses IBUtils, {$IFDEF Unix} initc, {$ENDIF}
184 > uses IBUtils, Registry, {$IFDEF Unix} initc, {$ENDIF}
185 > {$IFDEF FPC}
186   {$IFDEF WINDOWS }
187 < Windows,Registry, WinDirs,
187 > WinDirs,
188 > {$ENDIF}
189 > {$ELSE}
190 > ShlObj,
191   {$ENDIF}
192   SysUtils;
193  
194   {$IFDEF UNIX}
195 < {$I uloadlibrary.inc}
195 > {$I 'include/uloadlibrary.inc'}
196   {$ELSE}
197 < {$I wloadlibrary.inc}
197 > {$I 'include/wloadlibrary.inc'}
198   {$ENDIF}
199  
184 – type
185 –  TCharsetMap = record
186 –    CharsetID: integer;
187 –    CharSetName: string;
188 –    CharSetWidth: integer;
189 –    CodePage: TSystemCodePage;
190 –  end;
191 –
192 – const
193 –  CharSetMap: array [0..69] of TCharsetMap = (
194 –  (CharsetID: 0; CharSetName: 'NONE'; CharSetWidth: 1; CodePage: CP_NONE),
195 –  (CharsetID: 1; CharSetName: 'OCTETS'; CharSetWidth: 1; CodePage: CP_NONE),
196 –  (CharsetID: 2; CharSetName: 'ASCII'; CharSetWidth: 1; CodePage: CP_ASCII),
197 –  (CharsetID: 3; CharSetName: 'UNICODE_FSS'; CharSetWidth: 3; CodePage: CP_UTF8),
198 –  (CharsetID: 4; CharSetName: 'UTF8'; CharSetWidth: 4; CodePage: CP_UTF8),
199 –  (CharsetID: 5; CharSetName: 'SJIS_0208'; CharSetWidth: 2; CodePage: 20932),
200 –  (CharsetID: 6; CharSetName: 'EUCJ_0208'; CharSetWidth: 2; CodePage: 20932),
201 –  (CharsetID: 7; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
202 –  (CharsetID: 8; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
203 –  (CharsetID: 9; CharSetName: 'DOS737'; CharSetWidth: 1; CodePage: 737),
204 –  (CharsetID: 10; CharSetName: 'DOS437'; CharSetWidth: 1; CodePage: 437),
205 –  (CharsetID: 11; CharSetName: 'DOS850'; CharSetWidth: 1; CodePage: 850),
206 –  (CharsetID: 12; CharSetName: 'DOS865'; CharSetWidth: 1; CodePage: 865),
207 –  (CharsetID: 13; CharSetName: 'DOS860'; CharSetWidth: 1; CodePage: 860),
208 –  (CharsetID: 14; CharSetName: 'DOS863'; CharSetWidth: 1; CodePage: 863),
209 –  (CharsetID: 15; CharSetName: 'DOS775'; CharSetWidth: 1; CodePage: 775),
210 –  (CharsetID: 16; CharSetName: 'DOS858'; CharSetWidth: 1; CodePage: 858),
211 –  (CharsetID: 17; CharSetName: 'DOS862'; CharSetWidth: 1; CodePage: 862),
212 –  (CharsetID: 18; CharSetName: 'DOS864'; CharSetWidth: 1; CodePage: 864),
213 –  (CharsetID: 19; CharSetName: 'NEXT'; CharSetWidth: 1; CodePage: CP_NONE),
214 –  (CharsetID: 20; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
215 –  (CharsetID: 21; CharSetName: 'ISO8859_1'; CharSetWidth: 1; CodePage: 28591),
216 –  (CharsetID: 22; CharSetName: 'ISO8859_2'; CharSetWidth: 1; CodePage: 28592),
217 –  (CharsetID: 23; CharSetName: 'ISO8859_3'; CharSetWidth: 1; CodePage: 28593),
218 –  (CharsetID: 24; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
219 –  (CharsetID: 25; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
220 –  (CharsetID: 26; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
221 –  (CharsetID: 27; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
222 –  (CharsetID: 28; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
223 –  (CharsetID: 29; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
224 –  (CharsetID: 30; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
225 –  (CharsetID: 31; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
226 –  (CharsetID: 32; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
227 –  (CharsetID: 33; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
228 –  (CharsetID: 34; CharSetName: 'ISO8859_4'; CharSetWidth: 1; CodePage: 28594),
229 –  (CharsetID: 35; CharSetName: 'ISO8859_5'; CharSetWidth: 1; CodePage: 28595),
230 –  (CharsetID: 36; CharSetName: 'ISO8859_6'; CharSetWidth: 1; CodePage: 28596),
231 –  (CharsetID: 37; CharSetName: 'ISO8859_7'; CharSetWidth: 1; CodePage: 28597),
232 –  (CharsetID: 38; CharSetName: 'ISO8859_8'; CharSetWidth: 1; CodePage: 28598),
233 –  (CharsetID: 39; CharSetName: 'ISO8859_9'; CharSetWidth: 1; CodePage: 28599),
234 –  (CharsetID: 40; CharSetName: 'ISO8859_13'; CharSetWidth: 1; CodePage: 28603),
235 –  (CharsetID: 41; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
236 –  (CharsetID: 42; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
237 –  (CharsetID: 43; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
238 –  (CharsetID: 44; CharSetName: 'KSC_5601'; CharSetWidth: 2; CodePage: 949),
239 –  (CharsetID: 45; CharSetName: 'DOS852'; CharSetWidth: 1; CodePage: 852),
240 –  (CharsetID: 46; CharSetName: 'DOS857'; CharSetWidth: 1; CodePage: 857),
241 –  (CharsetID: 47; CharSetName: 'DOS861'; CharSetWidth: 1; CodePage: 861),
242 –  (CharsetID: 48; CharSetName: 'DOS866'; CharSetWidth: 1; CodePage: 866),
243 –  (CharsetID: 49; CharSetName: 'DOS869'; CharSetWidth: 1; CodePage: 869),
244 –  (CharsetID: 50; CharSetName: 'CYRL'; CharSetWidth: 1; CodePage: 1251),
245 –  (CharsetID: 51; CharSetName: 'WIN1250'; CharSetWidth: 1; CodePage: 1250),
246 –  (CharsetID: 52; CharSetName: 'WIN1251'; CharSetWidth: 1; CodePage: 1251),
247 –  (CharsetID: 53; CharSetName: 'WIN1252'; CharSetWidth: 1; CodePage: 1252),
248 –  (CharsetID: 54; CharSetName: 'WIN1253'; CharSetWidth: 1; CodePage: 1253),
249 –  (CharsetID: 55; CharSetName: 'WIN1254'; CharSetWidth: 1; CodePage: 1254),
250 –  (CharsetID: 56; CharSetName: 'BIG_5'; CharSetWidth: 2; CodePage: 950),
251 –  (CharsetID: 57; CharSetName: 'GB_2312'; CharSetWidth: 2; CodePage: 936),
252 –  (CharsetID: 58; CharSetName: 'WIN1255'; CharSetWidth: 1; CodePage: 1255),
253 –  (CharsetID: 59; CharSetName: 'WIN1256'; CharSetWidth: 1; CodePage: 1256),
254 –  (CharsetID: 60; CharSetName: 'WIN1257'; CharSetWidth: 1; CodePage: 1257),
255 –  (CharsetID: 61; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
256 –  (CharsetID: 62; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
257 –  (CharsetID: 63; CharSetName: 'KOI8R'; CharSetWidth: 1; CodePage: 20866),
258 –  (CharsetID: 64; CharSetName: 'KOI8U'; CharSetWidth: 1; CodePage: 21866),
259 –  (CharsetID: 65; CharSetName: 'WIN1258'; CharSetWidth: 1; CodePage: 1258),
260 –  (CharsetID: 66; CharSetName: 'TIS620'; CharSetWidth: 1; CodePage: 874),
261 –  (CharsetID: 67; CharSetName: 'GBK'; CharSetWidth: 2; CodePage: 936),
262 –  (CharsetID: 68; CharSetName: 'CP943C'; CharSetWidth: 2; CodePage: 943),
263 –  (CharsetID: 69; CharSetName: 'GB18030'; CharSetWidth: 4; CodePage: 54936)
264 – );
265 –
200    {$IFDEF Unix}
201    {SetEnvironmentVariable doesn't exist so we have to use C Library}
202    function setenv(name:Pchar; value:Pchar; replace:integer):integer;cdecl;external clib name 'setenv';
203    function unsetenv(name:Pchar):integer;cdecl;external clib name 'unsetenv';
204 <  function SetEnvironmentVariable(name:PChar; value:PChar):boolean;
204 >  function SetEnvironmentVariable(name:PAnsiChar; value:PAnsiChar):boolean;
205    // Set environment variable; if empty string given, remove it.
206    begin
207      result:=false; //assume failure
# Line 302 | Line 236 | destructor TFBClientAPI.Destroy;
236   begin
237    FirebirdClientAPI := nil;
238    if FOwnsIBLibrary and (IBLibrary <> NilHandle) then
239 <    UnloadLibrary(IBLibrary);
239 >    FreeLibrary(IBLibrary);
240    IBLibrary := NilHandle;
241    inherited Destroy;
242   end;
# Line 312 | Line 246 | var
246    i: Integer;
247   begin
248    ReallocMem(Pointer(P), NewSize);
249 <  for i := OldSize to NewSize - 1 do PChar(P)[i] := #0;
249 >  for i := OldSize to NewSize - 1 do PAnsiChar(P)[i] := #0;
250   end;
251  
252   procedure TFBClientAPI.IBDataBaseError;
# Line 323 | Line 257 | end;
257   {Under Unixes, if using an embedded server then set up local TMP and LOCK Directories}
258  
259   procedure TFBClientAPI.SetupEnvironment;
260 < var TmpDir: string;
260 > var TmpDir: AnsiString;
261   begin
262    {$IFDEF UNIX}
263      TmpDir := GetTempDir +
# Line 332 | Line 266 | begin
266      begin
267        if not DirectoryExists(tmpDir) then
268          mkdir(tmpDir);
269 <      SetEnvironmentVariable('FIREBIRD_TMP',PChar(TmpDir));
269 >      SetEnvironmentVariable('FIREBIRD_TMP',PAnsiChar(TmpDir));
270      end;
271      if sysutils.GetEnvironmentVariable('FIREBIRD_LOCK') = '' then
272      begin
273        if not DirectoryExists(tmpDir) then
274          mkdir(tmpDir);
275 <      SetEnvironmentVariable('FIREBIRD_LOCK',PChar(TmpDir));
275 >      SetEnvironmentVariable('FIREBIRD_LOCK',PAnsiChar(TmpDir));
276      end;
277    {$ENDIF}
278   end;
279  
280 < procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PChar);
280 > procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
281   begin
282    while len > 0 do
283    begin
284 <    buffer^ := char(aValue and $FF);
284 >    buffer^ := aValue and $FF;
285      Inc(buffer);
286      Dec(len);
287      aValue := aValue shr 8;
# Line 359 | Line 293 | begin
293    Result := IBLibrary <> NilHandle;
294   end;
295  
296 < function TFBClientAPI.GetProcAddr(ProcName: PChar): Pointer;
296 > function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer;
297   begin
298    Result := GetProcAddress(IBLibrary, ProcName);
299    if not Assigned(Result) then
# Line 393 | Line 327 | begin
327    Result := FFBLibraryName;
328   end;
329  
396 – function TFBClientAPI.GetCharsetName(CharSetID: integer): string;
397 – begin
398 –  Result := '';
399 –  if (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap)) and
400 –                                  (CharSetMap[CharSetID].CharSetID = CharSetID) then
401 –    begin
402 –      Result := CharSetMap[CharSetID].CharSetName;
403 –      Exit;
404 –    end;
405 – end;
406 –
407 – function TFBClientAPI.CharSetID2CodePage(CharSetID: integer;
408 –  var CodePage: TSystemCodePage): boolean;
409 – begin
410 –  Result := (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap))
411 –               and (CharSetMap[CharSetID].CharSetID = CharSetID);
412 –  if Result then
413 –    begin
414 –      CodePage := CharSetMap[CharSetID].CodePage;
415 –      Result := true;
416 –      Exit;
417 –    end;
418 – end;
419 –
420 – function TFBClientAPI.CodePage2CharSetID(CodePage: TSystemCodePage;
421 –  var CharSetID: integer): boolean;
422 – var i: integer;
423 – begin
424 –  Result := false;
425 –  for i := Low(CharSetMap) to High(CharSetMap) do
426 –    if CharSetMap[i].CodePage = CodePage then
427 –    begin
428 –      CharSetID := CharSetMap[i].CharSetID;
429 –      Result := true;
430 –      Exit;
431 –    end;
432 – end;
433 –
434 – function TFBClientAPI.CharSetName2CharSetID(CharSetName: string;
435 –  var CharSetID: integer): boolean;
436 – var i: integer;
437 – begin
438 –  Result := false;
439 –  for i := Low(CharSetMap) to High(CharSetMap) do
440 –    if CompareStr(CharSetMap[i].CharSetName, CharSetName) = 0 then
441 –    begin
442 –      CharSetID := CharSetMap[i].CharSetID;
443 –      Result := true;
444 –      Exit;
445 –    end;
446 – end;
447 –
448 – function TFBClientAPI.CharSetWidth(CharSetID: integer; var Width: integer
449 –  ): boolean;
450 – begin
451 –  Result := (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap))
452 –               and (CharSetMap[CharSetID].CharSetID = CharSetID);
453 –  if Result then
454 –    begin
455 –      Width := CharSetMap[CharSetID].CharSetWidth;
456 –      Result := true;
457 –      Exit;
458 –    end;
459 – end;
460 –
330   const
331    IBLocalBufferLength = 512;
332    IBBigLocalBufferLength = IBLocalBufferLength * 2;
# Line 483 | Line 352 | begin
352      Result := isc_sqlcode(PISC_STATUS(StatusVector));
353   end;
354  
355 < function TFBStatus.GetMessage: string;
356 < var local_buffer: array[0..IBHugeLocalBufferLength - 1] of char;
355 > function TFBStatus.GetMessage: AnsiString;
356 > var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
357      IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
358      sqlcode: Long;
359      psb: PStatusVector;
# Line 530 | Line 399 | var
399    i: Integer;
400    procedure NextP(i: Integer);
401    begin
402 <    p := PISC_STATUS(PChar(p) + (i * SizeOf(ISC_STATUS)));
402 >    p := PISC_STATUS(PAnsiChar(p) + (i * SizeOf(ISC_STATUS)));
403    end;
404   begin
405    p := PISC_STATUS(StatusVector);
# Line 556 | Line 425 | end;
425  
426   function TFBStatus.GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
427   begin
428 <  EnterCriticalSection(FIBCS);
428 >  EnterCriticalSection(TFBClientAPI.FIBCS);
429    try
430      result := FIBDataBaseErrorMessages;
431    finally
432 <    LeaveCriticalSection(FIBCS);
432 >    LeaveCriticalSection(TFBClientAPI.FIBCS);
433    end;
434   end;
435  
436   procedure TFBStatus.SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages);
437   begin
438 <  EnterCriticalSection(FIBCS);
438 >  EnterCriticalSection(TFBClientAPI.FIBCS);
439    try
440      FIBDataBaseErrorMessages := Value;
441    finally
442 <    LeaveCriticalSection(FIBCS);
442 >    LeaveCriticalSection(TFBClientAPI.FIBCS);
443    end;
444   end;
445 +
446   initialization
447    TFBClientAPI.IBLibrary := NilHandle;
448 <  InitCriticalSection(TFBStatus.FIBCS);
448 >  {$IFNDEF FPC}
449 >  InitializeCriticalSection(TFBClientAPI.FIBCS);
450 >  {$ELSE}
451 >  InitCriticalSection(TFBClientAPI.FIBCS);
452 >  {$ENDIF}
453  
454   finalization
455 <  DoneCriticalSection(TFBStatus.FIBCS);
455 >  {$IFNDEF FPC}
456 >  DeleteCriticalSection(TFBClientAPI.FIBCS);
457 >  {$ELSE}
458 >  DoneCriticalSection(TFBClientAPI.FIBCS);
459 >  {$ENDIF}
460    if TFBClientAPI.IBLibrary <> NilHandle then
461    begin
462      FreeLibrary(TFBClientAPI.IBLibrary);

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines