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/branches/udr/client/FBClientAPI.pas (file contents):
Revision 370 by tony, Wed Jan 5 14:59:15 2022 UTC vs.
Revision 371 by tony, Wed Jan 5 15:21:22 2022 UTC

# Line 121 | Line 121 | type
121      FPrefix: AnsiString;
122    protected
123      FOwner: TFBClientAPI;
124 +    function GetIBMessage: Ansistring; virtual; abstract;
125 +    function GetSQLMessage: Ansistring;
126    public
127      constructor Create(aOwner: TFBClientAPI; prefix: AnsiString='');
128      function StatusVector: PStatusVector; virtual; abstract;
# Line 194 | Line 196 | type
196  
197    public
198      {Taken from legacy API}
197    isc_sqlcode: Tisc_sqlcode;
199      isc_sql_interprete: Tisc_sql_interprete;
200 <    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;
200 >    isc_sqlcode: Tisc_sqlcode;
201  
202      constructor Create(aFBLibrary: TFBLibrary);
203      procedure IBAlloc(var P; OldSize, NewSize: Integer);
# Line 222 | Line 220 | type
220      property LocalTimeOffset: integer read FLocalTimeOffset;
221    public
222      {Encode/Decode}
223 <    procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte);
223 >    procedure EncodeInteger(aValue: int64; len: integer; buffer: PByte);
224      function DecodeInteger(bufptr: PByte; len: short): int64;
225      procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte);  virtual; abstract;
226      function SQLDecodeDate(byfptr: PByte): TDateTime;  virtual; abstract;
# Line 230 | Line 228 | type
228      function SQLDecodeTime(bufptr: PByte): TDateTime;  virtual; abstract;
229      procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); virtual; abstract;
230      function  SQLDecodeDateTime(bufptr: PByte): TDateTime; virtual; abstract;
233    function FormatStatus(Status: TFBStatus): AnsiString; virtual; abstract;
231      function Int128ToStr(bufptr: PByte; scale: integer): AnsiString; virtual;
232      procedure StrToInt128(scale: integer; aValue: AnsiString; bufptr: PByte);
233        virtual;
# Line 411 | Line 408 | begin
408    raise EIBInterBaseError.Create(GetStatus);
409   end;
410  
411 < procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
411 > procedure TFBClientAPI.EncodeInteger(aValue: int64; len: integer; buffer: PByte);
412   begin
413    while len > 0 do
414    begin
# Line 422 | Line 419 | begin
419    end;
420   end;
421  
422 + (*
423 +  DecodeInteger is Translated from
424 +
425 + SINT64 API_ROUTINE isc_portable_integer(const UCHAR* ptr, SSHORT length)
426 + if (!ptr || length <= 0 || length > 8)
427 +        return 0;
428 +
429 + SINT64 value = 0;
430 + int shift = 0;
431 +
432 + while (--length > 0)
433 + {
434 +        value += ((SINT64) *ptr++) << shift;
435 +        shift += 8;
436 + }
437 +
438 + value += ((SINT64)(SCHAR) *ptr) << shift;
439 +
440 + return value;
441 + *)
442 +
443   function TFBClientAPI.DecodeInteger(bufptr: PByte; len: short): int64;
444 + var shift: integer;
445   begin
446 <  Result := isc_portable_integer(bufptr,len);
446 >  Result := 0;
447 >  if (BufPtr = nil) or (len <= 0) or (len > 8) then
448 >    Exit;
449 >
450 >  shift := 0;
451 >  dec(len);
452 >  while len > 0 do
453 >  begin
454 >    Result := Result + (int64(bufptr^) shl shift);
455 >    Inc(bufptr);
456 >    shift := shift + 8;
457 >    dec(len);
458 >  end;
459 >  Result := Result + (int64(bufptr^) shl shift);
460   end;
461  
462   function TFBClientAPI.Int128ToStr(bufptr: PByte; scale: integer): AnsiString;
# Line 568 | Line 600 | function TFBClientAPI.LoadInterface: boo
600   begin
601    isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize}
602    isc_sql_interprete := GetProcAddr('isc_sql_interprete'); {do not localize}
571  isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize}
572  isc_event_block := GetProcAddr('isc_event_block'); {do not localize}
573  isc_free := GetProcAddr('isc_free'); {do not localize}
574  isc_portable_integer := GetProcAddr('isc_portable_integer'); {do not localize}
603    fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize}
604 <  Result := assigned(isc_free);
604 >  Result := true; {don't case if these fail to load}
605   end;
606  
607   procedure TFBClientAPI.FBShutdown;
# Line 584 | Line 612 | end;
612  
613   { TFBStatus }
614  
615 + function TFBStatus.GetSQLMessage: Ansistring;
616 + var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
617 + begin
618 +  Result := '';
619 +  if (FOwner <> nil) and assigned(FOwner.isc_sql_interprete) then
620 +  begin
621 +     FOwner.isc_sql_interprete(Getsqlcode, local_buffer, sizeof(local_buffer));
622 +     Result := strpas(local_buffer);
623 +  end;
624 + end;
625 +
626   constructor TFBStatus.Create(aOwner: TFBClientAPI; prefix: AnsiString);
627   begin
628    inherited Create;
# Line 599 | Line 638 | end;
638  
639   function TFBStatus.Getsqlcode: TStatusCode;
640   begin
641 <  with FOwner do
642 <    Result := isc_sqlcode(PISC_STATUS(StatusVector));
641 >  if (FOwner <> nil) and assigned(FOwner.isc_sqlcode) then
642 >    Result := FOwner.isc_sqlcode(PISC_STATUS(StatusVector))
643 >  else
644 >    Result := -999; {generic SQL Code}
645   end;
646  
647   function TFBStatus.GetMessage: AnsiString;
648 < var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
608 <    IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
609 <    sqlcode: Long;
648 > var IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
649   begin
650    Result := FPrefix;
651    IBDataBaseErrorMessages := FIBDataBaseErrorMessages;
613  sqlcode := Getsqlcode;
652    if (ShowSQLCode in IBDataBaseErrorMessages) then
653 <    Result := Result + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize}
653 >    Result := Result + 'SQLCODE: ' + IntToStr(Getsqlcode); {do not localize}
654  
655 <  if (ShowSQLMessage in IBDataBaseErrorMessages) then
655 >  if [ShowSQLMessage, ShowIBMessage]*IBDataBaseErrorMessages <> [] then
656    begin
619    with FOwner do
620      isc_sql_interprete(sqlcode, local_buffer, sizeof(local_buffer));
657      if (ShowSQLCode in FIBDataBaseErrorMessages) then
658        Result := Result + LineEnding;
659 <    Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + ' ' + strpas(local_buffer);
659 >    Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + ' ';
660    end;
661  
662 +  if (ShowSQLMessage in IBDataBaseErrorMessages) then
663 +    Result := Result + GetSQLMessage;
664 +
665    if (ShowIBMessage in IBDataBaseErrorMessages) then
666    begin
667 <    if (ShowSQLCode in IBDataBaseErrorMessages) or
629 <       (ShowSQLMessage in IBDataBaseErrorMessages) then
667 >    if ShowSQLMessage in IBDataBaseErrorMessages then
668        Result := Result + LineEnding;
669 <    Result := Result + FOwner.FormatStatus(self);
669 >    Result := Result + GetIBMessage;
670    end;
671    if (Result <> '') and (Result[Length(Result)] = '.') then
672      Delete(Result, Length(Result), 1);

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines