| 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'; |
| 118 |
|
TFBStatus = class(TFBInterfacedObject) |
| 119 |
|
private |
| 120 |
|
FIBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
| 121 |
+ |
FPrefix: AnsiString; |
| 122 |
|
protected |
| 123 |
|
FOwner: TFBClientAPI; |
| 124 |
|
public |
| 125 |
< |
constructor Create(aOwner: TFBClientAPI); |
| 125 |
> |
constructor Create(aOwner: TFBClientAPI; prefix: AnsiString=''); |
| 126 |
|
function StatusVector: PStatusVector; virtual; abstract; |
| 127 |
|
|
| 128 |
|
{IStatus} |
| 129 |
< |
function GetIBErrorCode: Long; |
| 130 |
< |
function Getsqlcode: Long; |
| 129 |
> |
function GetIBErrorCode: TStatusCode; |
| 130 |
> |
function Getsqlcode: TStatusCode; |
| 131 |
|
function GetMessage: AnsiString; |
| 132 |
|
function CheckStatusVector(ErrorCodes: array of TFBStatusCode): Boolean; |
| 133 |
|
function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
| 199 |
|
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 |
|
|
| 204 |
|
constructor Create(aFBLibrary: TFBLibrary); |
| 205 |
|
procedure IBAlloc(var P; OldSize, NewSize: Integer); |
| 223 |
|
public |
| 224 |
|
{Encode/Decode} |
| 225 |
|
procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte); |
| 226 |
< |
function DecodeInteger(bufptr: PByte; len: short): integer; virtual; abstract; |
| 226 |
> |
function DecodeInteger(bufptr: PByte; len: short): int64; |
| 227 |
|
procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); virtual; abstract; |
| 228 |
|
function SQLDecodeDate(byfptr: PByte): TDateTime; virtual; abstract; |
| 229 |
|
procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); virtual; abstract; |
| 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; |
| 414 |
|
end; |
| 415 |
|
end; |
| 416 |
|
|
| 417 |
+ |
function TFBClientAPI.DecodeInteger(bufptr: PByte; len: short): int64; |
| 418 |
+ |
begin |
| 419 |
+ |
Result := isc_portable_integer(bufptr,len); |
| 420 |
+ |
end; |
| 421 |
+ |
|
| 422 |
|
function TFBClientAPI.Int128ToStr(bufptr: PByte; scale: integer): AnsiString; |
| 423 |
|
begin |
| 424 |
|
if not HasInt128Support then |
| 514 |
|
|
| 515 |
|
function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer; |
| 516 |
|
begin |
| 517 |
< |
Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName); |
| 517 |
> |
Result := nil; |
| 518 |
> |
if assigned(FFBLibrary) and (FFBLibrary.IBLibrary <> NilHandle) then |
| 519 |
> |
Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName); |
| 520 |
|
if not Assigned(Result) then |
| 521 |
|
raise Exception.CreateFmt(SFirebirdAPIFuncNotFound,[ProcName]); |
| 522 |
|
end; |
| 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} |
| 562 |
|
fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize} |
| 563 |
|
Result := assigned(isc_free); |
| 564 |
|
end; |
| 571 |
|
|
| 572 |
|
{ TFBStatus } |
| 573 |
|
|
| 574 |
< |
constructor TFBStatus.Create(aOwner: TFBClientAPI); |
| 574 |
> |
constructor TFBStatus.Create(aOwner: TFBClientAPI; prefix: AnsiString); |
| 575 |
|
begin |
| 576 |
|
inherited Create; |
| 577 |
|
FOwner := aOwner; |
| 578 |
< |
FIBDataBaseErrorMessages := [ShowSQLMessage, ShowIBMessage]; |
| 578 |
> |
FPrefix := prefix; |
| 579 |
> |
FIBDataBaseErrorMessages := [ShowSQLCode, ShowSQLMessage, ShowIBMessage]; |
| 580 |
|
end; |
| 581 |
|
|
| 582 |
< |
function TFBStatus.GetIBErrorCode: Long; |
| 582 |
> |
function TFBStatus.GetIBErrorCode: TStatusCode; |
| 583 |
|
begin |
| 584 |
|
Result := StatusVector^[1]; |
| 585 |
|
end; |
| 586 |
|
|
| 587 |
< |
function TFBStatus.Getsqlcode: Long; |
| 587 |
> |
function TFBStatus.Getsqlcode: TStatusCode; |
| 588 |
|
begin |
| 589 |
|
with FOwner do |
| 590 |
|
Result := isc_sqlcode(PISC_STATUS(StatusVector)); |
| 595 |
|
IBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
| 596 |
|
sqlcode: Long; |
| 597 |
|
begin |
| 598 |
< |
Result := ''; |
| 598 |
> |
Result := FPrefix; |
| 599 |
|
IBDataBaseErrorMessages := FIBDataBaseErrorMessages; |
| 600 |
|
sqlcode := Getsqlcode; |
| 601 |
|
if (ShowSQLCode in IBDataBaseErrorMessages) then |
| 602 |
|
Result := Result + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize} |
| 603 |
|
|
| 594 |
– |
Exclude(IBDataBaseErrorMessages, ShowSQLMessage); |
| 604 |
|
if (ShowSQLMessage in IBDataBaseErrorMessages) then |
| 605 |
|
begin |
| 606 |
|
with FOwner do |
| 607 |
|
isc_sql_interprete(sqlcode, local_buffer, sizeof(local_buffer)); |
| 608 |
|
if (ShowSQLCode in FIBDataBaseErrorMessages) then |
| 609 |
< |
Result := Result + CRLF; |
| 610 |
< |
Result := Result + strpas(local_buffer); |
| 609 |
> |
Result := Result + LineEnding; |
| 610 |
> |
Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + ' ' + strpas(local_buffer); |
| 611 |
|
end; |
| 612 |
|
|
| 613 |
|
if (ShowIBMessage in IBDataBaseErrorMessages) then |
