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

Comparing:
ibx/trunk/fbintf/client/FBClientAPI.pas (file contents), Revision 347 by tony, Mon Sep 20 22:08:20 2021 UTC vs.
ibx/branches/udr/client/FBClientAPI.pas (file contents), Revision 386 by tony, Tue Jan 18 12:05:35 2022 UTC

# Line 115 | Line 115 | type
115  
116    { TFBStatus }
117  
118 <  TFBStatus = class(TFBInterfacedObject)
118 >  TFBStatus = class(TFBInterfacedObject, IStatus)
119    private
120      FIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
121      FPrefix: AnsiString;
122 +    function SQLCodeSupported: boolean;
123    protected
124      FOwner: TFBClientAPI;
125 +    function GetIBMessage: Ansistring; virtual; abstract;
126 +    function GetSQLMessage: Ansistring;
127    public
128      constructor Create(aOwner: TFBClientAPI; prefix: AnsiString='');
129      function StatusVector: PStatusVector; virtual; abstract;
130 +    procedure Assign(src: TFBStatus); virtual;
131 +    function Clone: IStatus; virtual; abstract;
132  
133      {IStatus}
134      function GetIBErrorCode: TStatusCode;
# Line 194 | Line 199 | type
199  
200    public
201      {Taken from legacy API}
197 –    isc_sqlcode: Tisc_sqlcode;
202      isc_sql_interprete: Tisc_sql_interprete;
203 <    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 >    isc_sqlcode: Tisc_sqlcode;
204  
205      constructor Create(aFBLibrary: TFBLibrary);
206      procedure IBAlloc(var P; OldSize, NewSize: Integer);
# Line 222 | Line 223 | type
223      property LocalTimeOffset: integer read FLocalTimeOffset;
224    public
225      {Encode/Decode}
226 <    procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte);
226 >    procedure EncodeInteger(aValue: int64; len: integer; buffer: PByte);
227      function DecodeInteger(bufptr: PByte; len: short): int64;
228      procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte);  virtual; abstract;
229      function SQLDecodeDate(byfptr: PByte): TDateTime;  virtual; abstract;
# Line 230 | Line 231 | type
231      function SQLDecodeTime(bufptr: PByte): TDateTime;  virtual; abstract;
232      procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); virtual; abstract;
233      function  SQLDecodeDateTime(bufptr: PByte): TDateTime; virtual; abstract;
233 –    function FormatStatus(Status: TFBStatus): AnsiString; virtual; abstract;
234      function Int128ToStr(bufptr: PByte; scale: integer): AnsiString; virtual;
235      procedure StrToInt128(scale: integer; aValue: AnsiString; bufptr: PByte);
236        virtual;
# Line 245 | Line 245 | type
245      function GetImplementationVersion: AnsiString;
246      function GetClientMajor: integer;  virtual; abstract;
247      function GetClientMinor: integer;  virtual; abstract;
248 < end;
248 >  end;
249 >
250 >    IJournallingHook = interface
251 >      ['{7d3e45e0-3628-416a-9e22-c20474825031}']
252 >      procedure TransactionStart(Tr: ITransaction);
253 >      function TransactionEnd(TransactionID: integer; Action: TTransactionAction): boolean;
254 >      procedure TransactionRetained(Tr: ITransaction; OldTransactionID: integer; Action: TTransactionAction);
255 >      procedure ExecQuery(Stmt: IStatement);
256 >    end;
257  
258   implementation
259  
# Line 403 | Line 411 | begin
411    raise EIBInterBaseError.Create(GetStatus);
412   end;
413  
414 < procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
414 > procedure TFBClientAPI.EncodeInteger(aValue: int64; len: integer; buffer: PByte);
415   begin
416    while len > 0 do
417    begin
# Line 414 | Line 422 | begin
422    end;
423   end;
424  
425 + (*
426 +  DecodeInteger is Translated from
427 +
428 + SINT64 API_ROUTINE isc_portable_integer(const UCHAR* ptr, SSHORT length)
429 + if (!ptr || length <= 0 || length > 8)
430 +        return 0;
431 +
432 + SINT64 value = 0;
433 + int shift = 0;
434 +
435 + while (--length > 0)
436 + {
437 +        value += ((SINT64) *ptr++) << shift;
438 +        shift += 8;
439 + }
440 +
441 + value += ((SINT64)(SCHAR) *ptr) << shift;
442 +
443 + return value;
444 + *)
445 +
446   function TFBClientAPI.DecodeInteger(bufptr: PByte; len: short): int64;
447 + var shift: integer;
448   begin
449 <  Result := isc_portable_integer(bufptr,len);
449 >  Result := 0;
450 >  if (BufPtr = nil) or (len <= 0) or (len > 8) then
451 >    Exit;
452 >
453 >  shift := 0;
454 >  dec(len);
455 >  while len > 0 do
456 >  begin
457 >    Result := Result + (int64(bufptr^) shl shift);
458 >    Inc(bufptr);
459 >    shift := shift + 8;
460 >    dec(len);
461 >  end;
462 >  Result := Result + (int64(bufptr^) shl shift);
463   end;
464  
465   function TFBClientAPI.Int128ToStr(bufptr: PByte; scale: integer): AnsiString;
# Line 465 | Line 508 | begin
508   end;
509  
510   {$IFDEF UNIX}
511 +
512   procedure TFBClientAPI.GetTZDataSettings;
513   var S: TStringList;
514   begin
515    FLocalTimeOffset := GetLocalTimeOffset;
516 <  FLocalTimeZoneName := strpas(tzname[tzdaylight]);
516 >  {$if declared(Gettzname)}
517 >  FLocalTimeZoneName := Gettzname(tzdaylight);
518 >  {$else}
519 >  FLocalTimeZoneName := tzname[tzdaylight];
520 >  {$ifend}
521    FIsDaylightSavingsTime := tzdaylight;
522    if FileExists(DefaultTimeZoneFile) then
523    begin
# Line 555 | Line 603 | function TFBClientAPI.LoadInterface: boo
603   begin
604    isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize}
605    isc_sql_interprete := GetProcAddr('isc_sql_interprete'); {do not localize}
558 –  isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize}
559 –  isc_event_block := GetProcAddr('isc_event_block'); {do not localize}
560 –  isc_free := GetProcAddr('isc_free'); {do not localize}
561 –  isc_portable_integer := GetProcAddr('isc_portable_integer'); {do not localize}
606    fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize}
607 <  Result := assigned(isc_free);
607 >  Result := true; {don't case if these fail to load}
608   end;
609  
610   procedure TFBClientAPI.FBShutdown;
# Line 571 | Line 615 | end;
615  
616   { TFBStatus }
617  
618 + function TFBStatus.SQLCodeSupported: boolean;
619 + begin
620 +  Result:= (FOwner <> nil) and assigned(FOwner.isc_sqlcode) and  assigned(FOwner.isc_sql_interprete);
621 + end;
622 +
623 + function TFBStatus.GetSQLMessage: Ansistring;
624 + var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
625 + begin
626 +  Result := '';
627 +  if (FOwner <> nil) and assigned(FOwner.isc_sql_interprete) then
628 +  begin
629 +     FOwner.isc_sql_interprete(Getsqlcode, local_buffer, sizeof(local_buffer));
630 +     Result := strpas(local_buffer);
631 +  end;
632 + end;
633 +
634   constructor TFBStatus.Create(aOwner: TFBClientAPI; prefix: AnsiString);
635   begin
636    inherited Create;
637    FOwner := aOwner;
638    FPrefix := prefix;
639 <  FIBDataBaseErrorMessages := [ShowSQLCode, ShowSQLMessage, ShowIBMessage];
639 >  FIBDataBaseErrorMessages := [ShowIBMessage];
640 > end;
641 >
642 > procedure TFBStatus.Assign(src: TFBStatus);
643 > begin
644 >  FOwner := src.FOwner;
645 >  FPrefix := src.FPrefix;
646 >  SetIBDataBaseErrorMessages(src.GetIBDataBaseErrorMessages);
647   end;
648  
649   function TFBStatus.GetIBErrorCode: TStatusCode;
# Line 586 | Line 653 | end;
653  
654   function TFBStatus.Getsqlcode: TStatusCode;
655   begin
656 <  with FOwner do
657 <    Result := isc_sqlcode(PISC_STATUS(StatusVector));
656 >  if (FOwner <> nil) and assigned(FOwner.isc_sqlcode) then
657 >    Result := FOwner.isc_sqlcode(PISC_STATUS(StatusVector))
658 >  else
659 >    Result := -999; {generic SQL Code}
660   end;
661  
662   function TFBStatus.GetMessage: AnsiString;
663 < var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
595 <    IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
596 <    sqlcode: Long;
663 > var IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
664   begin
665    Result := FPrefix;
666    IBDataBaseErrorMessages := FIBDataBaseErrorMessages;
667 <  sqlcode := Getsqlcode;
668 <  if (ShowSQLCode in IBDataBaseErrorMessages) then
669 <    Result := Result + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize}
670 <
671 <  if (ShowSQLMessage in IBDataBaseErrorMessages) then
672 <  begin
673 <    with FOwner do
674 <      isc_sql_interprete(sqlcode, local_buffer, sizeof(local_buffer));
675 <    if (ShowSQLCode in FIBDataBaseErrorMessages) then
676 <      Result := Result + LineEnding;
677 <    Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + ' ' + strpas(local_buffer);
667 >  if SQLCodeSupported then
668 >  begin
669 >    if (ShowSQLCode in IBDataBaseErrorMessages) then
670 >      Result := Result + 'SQLCODE: ' + IntToStr(Getsqlcode); {do not localize}
671 >
672 >    if (ShowSQLMessage in IBDataBaseErrorMessages) then
673 >    begin
674 >      if ShowSQLCode in IBDataBaseErrorMessages then
675 >        Result := Result + LineEnding;
676 >      Result := Result + GetSQLMessage;
677 >    end;
678    end;
679  
680    if (ShowIBMessage in IBDataBaseErrorMessages) then
681    begin
682 <    if (ShowSQLCode in IBDataBaseErrorMessages) or
616 <       (ShowSQLMessage in IBDataBaseErrorMessages) then
682 >    if Result <> FPrefix then
683        Result := Result + LineEnding;
684 <    Result := Result + FOwner.FormatStatus(self);
684 >    Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + LineEnding + GetIBMessage;
685    end;
686    if (Result <> '') and (Result[Length(Result)] = '.') then
687      Delete(Result, Length(Result), 1);

Comparing:
ibx/trunk/fbintf/client/FBClientAPI.pas (property svn:eol-style), Revision 347 by tony, Mon Sep 20 22:08:20 2021 UTC vs.
ibx/branches/udr/client/FBClientAPI.pas (property svn:eol-style), Revision 386 by tony, Tue Jan 18 12:05:35 2022 UTC

# Line 0 | Line 1
1 + native

Diff Legend

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