| 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; |
| 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); |
| 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; |
| 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; |
| 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 |
|
|
| 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 |
| 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; |
| 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 |
| 601 |
|
begin |
| 602 |
|
isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize} |
| 603 |
|
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} |
| 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; |
| 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; |
| 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; |
| 595 |
< |
IBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
| 596 |
< |
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 |
| 616 |
< |
(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); |
