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 345 by tony, Mon Aug 23 14:22:29 2021 UTC vs.
ibx/branches/udr/client/FBClientAPI.pas (file contents), Revision 385 by tony, Mon Jan 17 15:56:35 2022 UTC

# Line 119 | Line 119 | type
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;
# Line 194 | Line 197 | type
197  
198    public
199      {Taken from legacy API}
197 –    isc_sqlcode: Tisc_sqlcode;
200      isc_sql_interprete: Tisc_sql_interprete;
201 <    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;
201 >    isc_sqlcode: Tisc_sqlcode;
202  
203      constructor Create(aFBLibrary: TFBLibrary);
204      procedure IBAlloc(var P; OldSize, NewSize: Integer);
# Line 222 | Line 221 | type
221      property LocalTimeOffset: integer read FLocalTimeOffset;
222    public
223      {Encode/Decode}
224 <    procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte);
224 >    procedure EncodeInteger(aValue: int64; len: integer; buffer: PByte);
225      function DecodeInteger(bufptr: PByte; len: short): int64;
226      procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte);  virtual; abstract;
227      function SQLDecodeDate(byfptr: PByte): TDateTime;  virtual; abstract;
# Line 230 | Line 229 | type
229      function SQLDecodeTime(bufptr: PByte): TDateTime;  virtual; abstract;
230      procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); virtual; abstract;
231      function  SQLDecodeDateTime(bufptr: PByte): TDateTime; virtual; abstract;
233 –    function FormatStatus(Status: TFBStatus): AnsiString; virtual; abstract;
232      function Int128ToStr(bufptr: PByte; scale: integer): AnsiString; virtual;
233      procedure StrToInt128(scale: integer; aValue: AnsiString; bufptr: PByte);
234        virtual;
# Line 245 | Line 243 | type
243      function GetImplementationVersion: AnsiString;
244      function GetClientMajor: integer;  virtual; abstract;
245      function GetClientMinor: integer;  virtual; abstract;
246 < end;
246 >  end;
247 >
248 >    IJournallingHook = interface
249 >      ['{7d3e45e0-3628-416a-9e22-c20474825031}']
250 >      procedure TransactionStart(Tr: ITransaction);
251 >      function TransactionEnd(TransactionID: integer; Action: TTransactionAction): boolean;
252 >      procedure TransactionRetained(Tr: ITransaction; OldTransactionID: integer; Action: TTransactionAction);
253 >      procedure ExecQuery(Stmt: IStatement);
254 >    end;
255  
256   implementation
257  
# Line 403 | Line 409 | begin
409    raise EIBInterBaseError.Create(GetStatus);
410   end;
411  
412 < procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
412 > procedure TFBClientAPI.EncodeInteger(aValue: int64; len: integer; buffer: PByte);
413   begin
414    while len > 0 do
415    begin
# Line 414 | Line 420 | begin
420    end;
421   end;
422  
423 + (*
424 +  DecodeInteger is Translated from
425 +
426 + SINT64 API_ROUTINE isc_portable_integer(const UCHAR* ptr, SSHORT length)
427 + if (!ptr || length <= 0 || length > 8)
428 +        return 0;
429 +
430 + SINT64 value = 0;
431 + int shift = 0;
432 +
433 + while (--length > 0)
434 + {
435 +        value += ((SINT64) *ptr++) << shift;
436 +        shift += 8;
437 + }
438 +
439 + value += ((SINT64)(SCHAR) *ptr) << shift;
440 +
441 + return value;
442 + *)
443 +
444   function TFBClientAPI.DecodeInteger(bufptr: PByte; len: short): int64;
445 + var shift: integer;
446   begin
447 <  Result := isc_portable_integer(bufptr,len);
447 >  Result := 0;
448 >  if (BufPtr = nil) or (len <= 0) or (len > 8) then
449 >    Exit;
450 >
451 >  shift := 0;
452 >  dec(len);
453 >  while len > 0 do
454 >  begin
455 >    Result := Result + (int64(bufptr^) shl shift);
456 >    Inc(bufptr);
457 >    shift := shift + 8;
458 >    dec(len);
459 >  end;
460 >  Result := Result + (int64(bufptr^) shl shift);
461   end;
462  
463   function TFBClientAPI.Int128ToStr(bufptr: PByte; scale: integer): AnsiString;
# Line 465 | Line 506 | begin
506   end;
507  
508   {$IFDEF UNIX}
509 +
510   procedure TFBClientAPI.GetTZDataSettings;
511   var S: TStringList;
512   begin
513    FLocalTimeOffset := GetLocalTimeOffset;
514 <  FLocalTimeZoneName := strpas(tzname[tzdaylight]);
514 >  {$if declared(Gettzname)}
515 >  FLocalTimeZoneName := Gettzname(tzdaylight);
516 >  {$else}
517 >  FLocalTimeZoneName := tzname[tzdaylight];
518 >  {$ifend}
519    FIsDaylightSavingsTime := tzdaylight;
520    if FileExists(DefaultTimeZoneFile) then
521    begin
# Line 514 | Line 560 | end;
560  
561   function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer;
562   begin
563 <  Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
563 >  Result := nil;
564 >  if assigned(FFBLibrary) and (FFBLibrary.IBLibrary <> NilHandle) then
565 >    Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
566    if not Assigned(Result) then
567      raise Exception.CreateFmt(SFirebirdAPIFuncNotFound,[ProcName]);
568   end;
# Line 553 | Line 601 | function TFBClientAPI.LoadInterface: boo
601   begin
602    isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize}
603    isc_sql_interprete := GetProcAddr('isc_sql_interprete'); {do not localize}
556 –  isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize}
557 –  isc_event_block := GetProcAddr('isc_event_block'); {do not localize}
558 –  isc_free := GetProcAddr('isc_free'); {do not localize}
559 –  isc_portable_integer := GetProcAddr('isc_portable_integer'); {do not localize}
604    fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize}
605 <  Result := assigned(isc_free);
605 >  Result := true; {don't case if these fail to load}
606   end;
607  
608   procedure TFBClientAPI.FBShutdown;
# Line 569 | Line 613 | end;
613  
614   { TFBStatus }
615  
616 + function TFBStatus.SQLCodeSupported: boolean;
617 + begin
618 +  Result:= (FOwner <> nil) and assigned(FOwner.isc_sqlcode) and  assigned(FOwner.isc_sql_interprete);
619 + end;
620 +
621 + function TFBStatus.GetSQLMessage: Ansistring;
622 + var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
623 + begin
624 +  Result := '';
625 +  if (FOwner <> nil) and assigned(FOwner.isc_sql_interprete) then
626 +  begin
627 +     FOwner.isc_sql_interprete(Getsqlcode, local_buffer, sizeof(local_buffer));
628 +     Result := strpas(local_buffer);
629 +  end;
630 + end;
631 +
632   constructor TFBStatus.Create(aOwner: TFBClientAPI; prefix: AnsiString);
633   begin
634    inherited Create;
635    FOwner := aOwner;
636    FPrefix := prefix;
637 <  FIBDataBaseErrorMessages := [ShowSQLCode, ShowSQLMessage, ShowIBMessage];
637 >  FIBDataBaseErrorMessages := [ShowIBMessage];
638   end;
639  
640   function TFBStatus.GetIBErrorCode: TStatusCode;
# Line 584 | Line 644 | end;
644  
645   function TFBStatus.Getsqlcode: TStatusCode;
646   begin
647 <  with FOwner do
648 <    Result := isc_sqlcode(PISC_STATUS(StatusVector));
647 >  if (FOwner <> nil) and assigned(FOwner.isc_sqlcode) then
648 >    Result := FOwner.isc_sqlcode(PISC_STATUS(StatusVector))
649 >  else
650 >    Result := -999; {generic SQL Code}
651   end;
652  
653   function TFBStatus.GetMessage: AnsiString;
654 < var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
593 <    IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
594 <    sqlcode: Long;
654 > var IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
655   begin
656    Result := FPrefix;
657    IBDataBaseErrorMessages := FIBDataBaseErrorMessages;
658 <  sqlcode := Getsqlcode;
659 <  if (ShowSQLCode in IBDataBaseErrorMessages) then
660 <    Result := Result + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize}
661 <
662 <  if (ShowSQLMessage in IBDataBaseErrorMessages) then
663 <  begin
664 <    with FOwner do
665 <      isc_sql_interprete(sqlcode, local_buffer, sizeof(local_buffer));
666 <    if (ShowSQLCode in FIBDataBaseErrorMessages) then
667 <      Result := Result + LineEnding;
668 <    Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + ' ' + strpas(local_buffer);
658 >  if SQLCodeSupported then
659 >  begin
660 >    if (ShowSQLCode in IBDataBaseErrorMessages) then
661 >      Result := Result + 'SQLCODE: ' + IntToStr(Getsqlcode); {do not localize}
662 >
663 >    if (ShowSQLMessage in IBDataBaseErrorMessages) then
664 >    begin
665 >      if ShowSQLCode in IBDataBaseErrorMessages then
666 >        Result := Result + LineEnding;
667 >      Result := Result + GetSQLMessage;
668 >    end;
669    end;
670  
671    if (ShowIBMessage in IBDataBaseErrorMessages) then
672    begin
673 <    if (ShowSQLCode in IBDataBaseErrorMessages) or
614 <       (ShowSQLMessage in IBDataBaseErrorMessages) then
673 >    if Result <> FPrefix then
674        Result := Result + LineEnding;
675 <    Result := Result + FOwner.FormatStatus(self);
675 >    Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + LineEnding + GetIBMessage;
676    end;
677    if (Result <> '') and (Result[Length(Result)] = '.') then
678      Delete(Result, Length(Result), 1);

Comparing:
ibx/trunk/fbintf/client/FBClientAPI.pas (property svn:eol-style), Revision 345 by tony, Mon Aug 23 14:22:29 2021 UTC vs.
ibx/branches/udr/client/FBClientAPI.pas (property svn:eol-style), Revision 385 by tony, Mon Jan 17 15:56:35 2022 UTC

# Line 0 | Line 1
1 + native

Diff Legend

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