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

Comparing:
ibx/trunk/fbintf/client/FBClientAPI.pas (file contents), Revision 319 by tony, Thu Feb 25 12:05:40 2021 UTC vs.
ibx/branches/journaling/fbintf/client/FBClientAPI.pas (file contents), Revision 362 by tony, Tue Dec 7 13:27:39 2021 UTC

# Line 118 | Line 118 | type
118    TFBStatus = class(TFBInterfacedObject)
119    private
120      FIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
121 +    FPrefix: AnsiString;
122    protected
123      FOwner: TFBClientAPI;
124    public
125 <    constructor Create(aOwner: TFBClientAPI);
125 >    constructor Create(aOwner: TFBClientAPI; prefix: AnsiString='');
126      function StatusVector: PStatusVector; virtual; abstract;
127  
128      {IStatus}
129 <    function GetIBErrorCode: Long;
130 <    function Getsqlcode: Long;
129 >    function GetIBErrorCode: TStatusCode;
130 >    function Getsqlcode: TStatusCode;
131      function GetMessage: AnsiString;
132      function CheckStatusVector(ErrorCodes: array of TFBStatusCode): Boolean;
133      function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
# Line 198 | Line 199 | type
199      isc_event_counts: Tisc_event_counts;
200      isc_event_block: Tisc_event_block;
201      isc_free: Tisc_free;
202 +    isc_portable_integer: Tisc_portable_integer;
203  
204      constructor Create(aFBLibrary: TFBLibrary);
205      procedure IBAlloc(var P; OldSize, NewSize: Integer);
# Line 221 | Line 223 | type
223    public
224      {Encode/Decode}
225      procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte);
226 <    function DecodeInteger(bufptr: PByte; len: short): integer; virtual; abstract;
226 >    function DecodeInteger(bufptr: PByte; len: short): int64;
227      procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte);  virtual; abstract;
228      function SQLDecodeDate(byfptr: PByte): TDateTime;  virtual; abstract;
229      procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte);  virtual; abstract;
# Line 412 | Line 414 | begin
414    end;
415   end;
416  
417 + function TFBClientAPI.DecodeInteger(bufptr: PByte; len: short): int64;
418 + begin
419 +  Result := isc_portable_integer(bufptr,len);
420 + end;
421 +
422   function TFBClientAPI.Int128ToStr(bufptr: PByte; scale: integer): AnsiString;
423   begin
424    if not HasInt128Support then
# Line 458 | Line 465 | begin
465   end;
466  
467   {$IFDEF UNIX}
468 +
469   procedure TFBClientAPI.GetTZDataSettings;
470   var S: TStringList;
471   begin
472    FLocalTimeOffset := GetLocalTimeOffset;
473 <  FLocalTimeZoneName := strpas(tzname[tzdaylight]);
473 >  {$if declared(Gettzname)}
474 >  FLocalTimeZoneName := Gettzname(tzdaylight);
475 >  {$else}
476 >  FLocalTimeZoneName := tzname[tzdaylight];
477 >  {$ifend}
478    FIsDaylightSavingsTime := tzdaylight;
479    if FileExists(DefaultTimeZoneFile) then
480    begin
# Line 507 | Line 519 | end;
519  
520   function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer;
521   begin
522 <  Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
522 >  Result := nil;
523 >  if assigned(FFBLibrary) and (FFBLibrary.IBLibrary <> NilHandle) then
524 >    Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
525    if not Assigned(Result) then
526      raise Exception.CreateFmt(SFirebirdAPIFuncNotFound,[ProcName]);
527   end;
# Line 549 | Line 563 | begin
563    isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize}
564    isc_event_block := GetProcAddr('isc_event_block'); {do not localize}
565    isc_free := GetProcAddr('isc_free'); {do not localize}
566 +  isc_portable_integer := GetProcAddr('isc_portable_integer'); {do not localize}
567    fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize}
568    Result := assigned(isc_free);
569   end;
# Line 561 | Line 576 | end;
576  
577   { TFBStatus }
578  
579 < constructor TFBStatus.Create(aOwner: TFBClientAPI);
579 > constructor TFBStatus.Create(aOwner: TFBClientAPI; prefix: AnsiString);
580   begin
581    inherited Create;
582    FOwner := aOwner;
583 <  FIBDataBaseErrorMessages := [ShowSQLMessage, ShowIBMessage];
583 >  FPrefix := prefix;
584 >  FIBDataBaseErrorMessages := [ShowSQLCode, ShowSQLMessage, ShowIBMessage];
585   end;
586  
587 < function TFBStatus.GetIBErrorCode: Long;
587 > function TFBStatus.GetIBErrorCode: TStatusCode;
588   begin
589    Result := StatusVector^[1];
590   end;
591  
592 < function TFBStatus.Getsqlcode: Long;
592 > function TFBStatus.Getsqlcode: TStatusCode;
593   begin
594    with FOwner do
595      Result := isc_sqlcode(PISC_STATUS(StatusVector));
# Line 584 | Line 600 | var local_buffer: array[0..IBHugeLocalBu
600      IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
601      sqlcode: Long;
602   begin
603 <  Result := '';
603 >  Result := FPrefix;
604    IBDataBaseErrorMessages := FIBDataBaseErrorMessages;
605    sqlcode := Getsqlcode;
606    if (ShowSQLCode in IBDataBaseErrorMessages) then
607      Result := Result + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize}
608  
593  Exclude(IBDataBaseErrorMessages, ShowSQLMessage);
609    if (ShowSQLMessage in IBDataBaseErrorMessages) then
610    begin
611      with FOwner do
612        isc_sql_interprete(sqlcode, local_buffer, sizeof(local_buffer));
613      if (ShowSQLCode in FIBDataBaseErrorMessages) then
614 <      Result := Result + CRLF;
615 <    Result := Result + strpas(local_buffer);
614 >      Result := Result + LineEnding;
615 >    Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + ' ' + strpas(local_buffer);
616    end;
617  
618    if (ShowIBMessage in IBDataBaseErrorMessages) then

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines