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; |
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 |
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} |
560 |
|
fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize} |
561 |
|
Result := assigned(isc_free); |
562 |
|
end; |
569 |
|
|
570 |
|
{ TFBStatus } |
571 |
|
|
572 |
< |
constructor TFBStatus.Create(aOwner: TFBClientAPI); |
572 |
> |
constructor TFBStatus.Create(aOwner: TFBClientAPI; prefix: AnsiString); |
573 |
|
begin |
574 |
|
inherited Create; |
575 |
|
FOwner := aOwner; |
576 |
< |
FIBDataBaseErrorMessages := [ShowSQLMessage, ShowIBMessage]; |
576 |
> |
FPrefix := prefix; |
577 |
> |
FIBDataBaseErrorMessages := [ShowSQLCode, ShowSQLMessage, ShowIBMessage]; |
578 |
|
end; |
579 |
|
|
580 |
< |
function TFBStatus.GetIBErrorCode: Long; |
580 |
> |
function TFBStatus.GetIBErrorCode: TStatusCode; |
581 |
|
begin |
582 |
|
Result := StatusVector^[1]; |
583 |
|
end; |
584 |
|
|
585 |
< |
function TFBStatus.Getsqlcode: Long; |
585 |
> |
function TFBStatus.Getsqlcode: TStatusCode; |
586 |
|
begin |
587 |
|
with FOwner do |
588 |
|
Result := isc_sqlcode(PISC_STATUS(StatusVector)); |
593 |
|
IBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
594 |
|
sqlcode: Long; |
595 |
|
begin |
596 |
< |
Result := ''; |
596 |
> |
Result := FPrefix; |
597 |
|
IBDataBaseErrorMessages := FIBDataBaseErrorMessages; |
598 |
|
sqlcode := Getsqlcode; |
599 |
|
if (ShowSQLCode in IBDataBaseErrorMessages) then |
600 |
|
Result := Result + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize} |
601 |
|
|
593 |
– |
Exclude(IBDataBaseErrorMessages, ShowSQLMessage); |
602 |
|
if (ShowSQLMessage in IBDataBaseErrorMessages) then |
603 |
|
begin |
604 |
|
with FOwner do |
605 |
|
isc_sql_interprete(sqlcode, local_buffer, sizeof(local_buffer)); |
606 |
|
if (ShowSQLCode in FIBDataBaseErrorMessages) then |
607 |
< |
Result := Result + CRLF; |
608 |
< |
Result := Result + strpas(local_buffer); |
607 |
> |
Result := Result + LineEnding; |
608 |
> |
Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + ' ' + strpas(local_buffer); |
609 |
|
end; |
610 |
|
|
611 |
|
if (ShowIBMessage in IBDataBaseErrorMessages) then |