| 78 |
|
{$IFDEF FPC} Dynlibs, {$ENDIF} |
| 79 |
|
IB, IBHeader, FBActivityMonitor, FBMessages, IBExternals, FmtBCD; |
| 80 |
|
|
| 81 |
< |
{For Linux see result of GetFirebirdLibList method} |
| 81 |
> |
{For Linux see result of GetFirebirdLibListruntime/nongui/winipc.inc method} |
| 82 |
|
{$IFDEF DARWIN} |
| 83 |
|
const |
| 84 |
|
FIREBIRD_SO2 = 'libfbclient.dylib'; |
| 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); |
| 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: Long; |
| 135 |
< |
function Getsqlcode: Long; |
| 134 |
> |
function GetIBErrorCode: TStatusCode; |
| 135 |
> |
function Getsqlcode: TStatusCode; |
| 136 |
|
function GetMessage: AnsiString; |
| 137 |
|
function CheckStatusVector(ErrorCodes: array of TFBStatusCode): Boolean; |
| 138 |
|
function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
| 199 |
|
|
| 200 |
|
public |
| 201 |
|
{Taken from legacy API} |
| 196 |
– |
isc_sqlcode: Tisc_sqlcode; |
| 202 |
|
isc_sql_interprete: Tisc_sql_interprete; |
| 203 |
< |
isc_event_counts: Tisc_event_counts; |
| 199 |
< |
isc_event_block: Tisc_event_block; |
| 200 |
< |
isc_free: Tisc_free; |
| 203 |
> |
isc_sqlcode: Tisc_sqlcode; |
| 204 |
|
|
| 205 |
|
constructor Create(aFBLibrary: TFBLibrary); |
| 206 |
|
procedure IBAlloc(var P; OldSize, NewSize: Integer); |
| 223 |
|
property LocalTimeOffset: integer read FLocalTimeOffset; |
| 224 |
|
public |
| 225 |
|
{Encode/Decode} |
| 226 |
< |
procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte); |
| 227 |
< |
function DecodeInteger(bufptr: PByte; len: short): integer; virtual; abstract; |
| 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; |
| 230 |
|
procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); virtual; abstract; |
| 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; |
| 231 |
– |
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; |
| 237 |
|
procedure SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal; bufptr: PByte); virtual; |
| 238 |
|
function SQLDecFloatDecode(SQLType: cardinal; bufptr: PByte): tBCD; virtual; |
| 237 |
– |
function FormatStatus(Status: TFBStatus): AnsiString; virtual; abstract; |
| 239 |
|
|
| 240 |
|
{IFirebirdAPI} |
| 241 |
|
function GetStatus: IStatus; virtual; abstract; |
| 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; Completion: TTrCompletionState): boolean; |
| 254 |
> |
procedure TransactionRetained(Tr: ITransaction; OldTransactionID: integer; Action: TTransactionAction); |
| 255 |
> |
procedure ExecQuery(Stmt: IStatement); |
| 256 |
> |
procedure ExecImmediateJnl(sql: AnsiString; tr: ITransaction); |
| 257 |
> |
end; |
| 258 |
|
|
| 259 |
|
implementation |
| 260 |
|
|
| 412 |
|
raise EIBInterBaseError.Create(GetStatus); |
| 413 |
|
end; |
| 414 |
|
|
| 415 |
< |
procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte); |
| 415 |
> |
procedure TFBClientAPI.EncodeInteger(aValue: int64; len: integer; buffer: PByte); |
| 416 |
|
begin |
| 417 |
|
while len > 0 do |
| 418 |
|
begin |
| 423 |
|
end; |
| 424 |
|
end; |
| 425 |
|
|
| 426 |
+ |
(* |
| 427 |
+ |
DecodeInteger is Translated from |
| 428 |
+ |
|
| 429 |
+ |
SINT64 API_ROUTINE isc_portable_integer(const UCHAR* ptr, SSHORT length) |
| 430 |
+ |
if (!ptr || length <= 0 || length > 8) |
| 431 |
+ |
return 0; |
| 432 |
+ |
|
| 433 |
+ |
SINT64 value = 0; |
| 434 |
+ |
int shift = 0; |
| 435 |
+ |
|
| 436 |
+ |
while (--length > 0) |
| 437 |
+ |
{ |
| 438 |
+ |
value += ((SINT64) *ptr++) << shift; |
| 439 |
+ |
shift += 8; |
| 440 |
+ |
} |
| 441 |
+ |
|
| 442 |
+ |
value += ((SINT64)(SCHAR) *ptr) << shift; |
| 443 |
+ |
|
| 444 |
+ |
return value; |
| 445 |
+ |
*) |
| 446 |
+ |
|
| 447 |
+ |
function TFBClientAPI.DecodeInteger(bufptr: PByte; len: short): int64; |
| 448 |
+ |
var shift: integer; |
| 449 |
+ |
begin |
| 450 |
+ |
Result := 0; |
| 451 |
+ |
if (BufPtr = nil) or (len <= 0) or (len > 8) then |
| 452 |
+ |
Exit; |
| 453 |
+ |
|
| 454 |
+ |
shift := 0; |
| 455 |
+ |
dec(len); |
| 456 |
+ |
while len > 0 do |
| 457 |
+ |
begin |
| 458 |
+ |
Result := Result + (int64(bufptr^) shl shift); |
| 459 |
+ |
Inc(bufptr); |
| 460 |
+ |
shift := shift + 8; |
| 461 |
+ |
dec(len); |
| 462 |
+ |
end; |
| 463 |
+ |
Result := Result + (int64(bufptr^) shl shift); |
| 464 |
+ |
end; |
| 465 |
+ |
|
| 466 |
|
function TFBClientAPI.Int128ToStr(bufptr: PByte; scale: integer): AnsiString; |
| 467 |
|
begin |
| 468 |
|
if not HasInt128Support then |
| 509 |
|
end; |
| 510 |
|
|
| 511 |
|
{$IFDEF UNIX} |
| 512 |
+ |
|
| 513 |
|
procedure TFBClientAPI.GetTZDataSettings; |
| 514 |
|
var S: TStringList; |
| 515 |
|
begin |
| 516 |
|
FLocalTimeOffset := GetLocalTimeOffset; |
| 517 |
< |
FLocalTimeZoneName := strpas(tzname[tzdaylight]); |
| 517 |
> |
{$if declared(Gettzname)} |
| 518 |
> |
FLocalTimeZoneName := Gettzname(tzdaylight); |
| 519 |
> |
{$else} |
| 520 |
> |
FLocalTimeZoneName := tzname[tzdaylight]; |
| 521 |
> |
{$ifend} |
| 522 |
|
FIsDaylightSavingsTime := tzdaylight; |
| 523 |
|
if FileExists(DefaultTimeZoneFile) then |
| 524 |
|
begin |
| 563 |
|
|
| 564 |
|
function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer; |
| 565 |
|
begin |
| 566 |
< |
Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName); |
| 566 |
> |
Result := nil; |
| 567 |
> |
if assigned(FFBLibrary) and (FFBLibrary.IBLibrary <> NilHandle) then |
| 568 |
> |
Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName); |
| 569 |
|
if not Assigned(Result) then |
| 570 |
|
raise Exception.CreateFmt(SFirebirdAPIFuncNotFound,[ProcName]); |
| 571 |
|
end; |
| 604 |
|
begin |
| 605 |
|
isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize} |
| 606 |
|
isc_sql_interprete := GetProcAddr('isc_sql_interprete'); {do not localize} |
| 550 |
– |
isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize} |
| 551 |
– |
isc_event_block := GetProcAddr('isc_event_block'); {do not localize} |
| 552 |
– |
isc_free := GetProcAddr('isc_free'); {do not localize} |
| 607 |
|
fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize} |
| 608 |
< |
Result := assigned(isc_free); |
| 608 |
> |
Result := true; {don't case if these fail to load} |
| 609 |
|
end; |
| 610 |
|
|
| 611 |
|
procedure TFBClientAPI.FBShutdown; |
| 616 |
|
|
| 617 |
|
{ TFBStatus } |
| 618 |
|
|
| 619 |
< |
constructor TFBStatus.Create(aOwner: TFBClientAPI); |
| 619 |
> |
function TFBStatus.SQLCodeSupported: boolean; |
| 620 |
> |
begin |
| 621 |
> |
Result:= (FOwner <> nil) and assigned(FOwner.isc_sqlcode) and assigned(FOwner.isc_sql_interprete); |
| 622 |
> |
end; |
| 623 |
> |
|
| 624 |
> |
function TFBStatus.GetSQLMessage: Ansistring; |
| 625 |
> |
var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar; |
| 626 |
> |
begin |
| 627 |
> |
Result := ''; |
| 628 |
> |
if (FOwner <> nil) and assigned(FOwner.isc_sql_interprete) then |
| 629 |
> |
begin |
| 630 |
> |
FOwner.isc_sql_interprete(Getsqlcode, local_buffer, sizeof(local_buffer)); |
| 631 |
> |
Result := strpas(local_buffer); |
| 632 |
> |
end; |
| 633 |
> |
end; |
| 634 |
> |
|
| 635 |
> |
constructor TFBStatus.Create(aOwner: TFBClientAPI; prefix: AnsiString); |
| 636 |
|
begin |
| 637 |
|
inherited Create; |
| 638 |
|
FOwner := aOwner; |
| 639 |
< |
FIBDataBaseErrorMessages := [ShowSQLMessage, ShowIBMessage]; |
| 639 |
> |
FPrefix := prefix; |
| 640 |
> |
FIBDataBaseErrorMessages := [ShowIBMessage]; |
| 641 |
|
end; |
| 642 |
|
|
| 643 |
< |
function TFBStatus.GetIBErrorCode: Long; |
| 643 |
> |
procedure TFBStatus.Assign(src: TFBStatus); |
| 644 |
> |
begin |
| 645 |
> |
FOwner := src.FOwner; |
| 646 |
> |
FPrefix := src.FPrefix; |
| 647 |
> |
SetIBDataBaseErrorMessages(src.GetIBDataBaseErrorMessages); |
| 648 |
> |
end; |
| 649 |
> |
|
| 650 |
> |
function TFBStatus.GetIBErrorCode: TStatusCode; |
| 651 |
|
begin |
| 652 |
|
Result := StatusVector^[1]; |
| 653 |
|
end; |
| 654 |
|
|
| 655 |
< |
function TFBStatus.Getsqlcode: Long; |
| 655 |
> |
function TFBStatus.Getsqlcode: TStatusCode; |
| 656 |
|
begin |
| 657 |
< |
with FOwner do |
| 658 |
< |
Result := isc_sqlcode(PISC_STATUS(StatusVector)); |
| 657 |
> |
if (FOwner <> nil) and assigned(FOwner.isc_sqlcode) then |
| 658 |
> |
Result := FOwner.isc_sqlcode(PISC_STATUS(StatusVector)) |
| 659 |
> |
else |
| 660 |
> |
Result := -999; {generic SQL Code} |
| 661 |
|
end; |
| 662 |
|
|
| 663 |
|
function TFBStatus.GetMessage: AnsiString; |
| 664 |
< |
var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar; |
| 585 |
< |
IBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
| 586 |
< |
sqlcode: Long; |
| 664 |
> |
var IBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
| 665 |
|
begin |
| 666 |
< |
Result := ''; |
| 666 |
> |
Result := FPrefix; |
| 667 |
|
IBDataBaseErrorMessages := FIBDataBaseErrorMessages; |
| 668 |
< |
sqlcode := Getsqlcode; |
| 669 |
< |
if (ShowSQLCode in IBDataBaseErrorMessages) then |
| 670 |
< |
Result := Result + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize} |
| 671 |
< |
|
| 672 |
< |
Exclude(IBDataBaseErrorMessages, ShowSQLMessage); |
| 673 |
< |
if (ShowSQLMessage in IBDataBaseErrorMessages) then |
| 674 |
< |
begin |
| 675 |
< |
with FOwner do |
| 676 |
< |
isc_sql_interprete(sqlcode, local_buffer, sizeof(local_buffer)); |
| 677 |
< |
if (ShowSQLCode in FIBDataBaseErrorMessages) then |
| 678 |
< |
Result := Result + CRLF; |
| 601 |
< |
Result := Result + strpas(local_buffer); |
| 668 |
> |
if SQLCodeSupported then |
| 669 |
> |
begin |
| 670 |
> |
if (ShowSQLCode in IBDataBaseErrorMessages) then |
| 671 |
> |
Result := Result + 'SQLCODE: ' + IntToStr(Getsqlcode); {do not localize} |
| 672 |
> |
|
| 673 |
> |
if (ShowSQLMessage in IBDataBaseErrorMessages) then |
| 674 |
> |
begin |
| 675 |
> |
if ShowSQLCode in IBDataBaseErrorMessages then |
| 676 |
> |
Result := Result + LineEnding; |
| 677 |
> |
Result := Result + GetSQLMessage; |
| 678 |
> |
end; |
| 679 |
|
end; |
| 680 |
|
|
| 681 |
|
if (ShowIBMessage in IBDataBaseErrorMessages) then |
| 682 |
|
begin |
| 683 |
< |
if (ShowSQLCode in IBDataBaseErrorMessages) or |
| 607 |
< |
(ShowSQLMessage in IBDataBaseErrorMessages) then |
| 683 |
> |
if Result <> FPrefix then |
| 684 |
|
Result := Result + LineEnding; |
| 685 |
< |
Result := Result + FOwner.FormatStatus(self); |
| 685 |
> |
Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + LineEnding + GetIBMessage; |
| 686 |
|
end; |
| 687 |
|
if (Result <> '') and (Result[Length(Result)] = '.') then |
| 688 |
|
Delete(Result, Length(Result), 1); |
