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; |
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; Action: TTransactionAction): boolean; |
254 |
> |
procedure TransactionRetained(Tr: ITransaction; OldTransactionID: integer; Action: TTransactionAction); |
255 |
> |
procedure ExecQuery(Stmt: IStatement); |
256 |
> |
end; |
257 |
|
|
258 |
|
implementation |
259 |
|
|
422 |
|
end; |
423 |
|
end; |
424 |
|
|
425 |
+ |
function TFBClientAPI.DecodeInteger(bufptr: PByte; len: short): int64; |
426 |
+ |
begin |
427 |
+ |
Result := isc_portable_integer(bufptr,len); |
428 |
+ |
end; |
429 |
+ |
|
430 |
|
function TFBClientAPI.Int128ToStr(bufptr: PByte; scale: integer): AnsiString; |
431 |
|
begin |
432 |
|
if not HasInt128Support then |
473 |
|
end; |
474 |
|
|
475 |
|
{$IFDEF UNIX} |
476 |
+ |
|
477 |
|
procedure TFBClientAPI.GetTZDataSettings; |
478 |
|
var S: TStringList; |
479 |
|
begin |
480 |
|
FLocalTimeOffset := GetLocalTimeOffset; |
481 |
< |
FLocalTimeZoneName := strpas(tzname[tzdaylight]); |
481 |
> |
{$if declared(Gettzname)} |
482 |
> |
FLocalTimeZoneName := Gettzname(tzdaylight); |
483 |
> |
{$else} |
484 |
> |
FLocalTimeZoneName := tzname[tzdaylight]; |
485 |
> |
{$ifend} |
486 |
|
FIsDaylightSavingsTime := tzdaylight; |
487 |
|
if FileExists(DefaultTimeZoneFile) then |
488 |
|
begin |
527 |
|
|
528 |
|
function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer; |
529 |
|
begin |
530 |
< |
Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName); |
530 |
> |
Result := nil; |
531 |
> |
if assigned(FFBLibrary) and (FFBLibrary.IBLibrary <> NilHandle) then |
532 |
> |
Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName); |
533 |
|
if not Assigned(Result) then |
534 |
|
raise Exception.CreateFmt(SFirebirdAPIFuncNotFound,[ProcName]); |
535 |
|
end; |
571 |
|
isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize} |
572 |
|
isc_event_block := GetProcAddr('isc_event_block'); {do not localize} |
573 |
|
isc_free := GetProcAddr('isc_free'); {do not localize} |
574 |
+ |
isc_portable_integer := GetProcAddr('isc_portable_integer'); {do not localize} |
575 |
|
fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize} |
576 |
|
Result := assigned(isc_free); |
577 |
|
end; |
584 |
|
|
585 |
|
{ TFBStatus } |
586 |
|
|
587 |
< |
constructor TFBStatus.Create(aOwner: TFBClientAPI); |
587 |
> |
constructor TFBStatus.Create(aOwner: TFBClientAPI; prefix: AnsiString); |
588 |
|
begin |
589 |
|
inherited Create; |
590 |
|
FOwner := aOwner; |
591 |
< |
FIBDataBaseErrorMessages := [ShowSQLMessage, ShowIBMessage]; |
591 |
> |
FPrefix := prefix; |
592 |
> |
FIBDataBaseErrorMessages := [ShowSQLCode, ShowSQLMessage, ShowIBMessage]; |
593 |
|
end; |
594 |
|
|
595 |
< |
function TFBStatus.GetIBErrorCode: Long; |
595 |
> |
function TFBStatus.GetIBErrorCode: TStatusCode; |
596 |
|
begin |
597 |
|
Result := StatusVector^[1]; |
598 |
|
end; |
599 |
|
|
600 |
< |
function TFBStatus.Getsqlcode: Long; |
600 |
> |
function TFBStatus.Getsqlcode: TStatusCode; |
601 |
|
begin |
602 |
|
with FOwner do |
603 |
|
Result := isc_sqlcode(PISC_STATUS(StatusVector)); |
608 |
|
IBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
609 |
|
sqlcode: Long; |
610 |
|
begin |
611 |
< |
Result := ''; |
611 |
> |
Result := FPrefix; |
612 |
|
IBDataBaseErrorMessages := FIBDataBaseErrorMessages; |
613 |
|
sqlcode := Getsqlcode; |
614 |
|
if (ShowSQLCode in IBDataBaseErrorMessages) then |
615 |
|
Result := Result + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize} |
616 |
|
|
594 |
– |
Exclude(IBDataBaseErrorMessages, ShowSQLMessage); |
617 |
|
if (ShowSQLMessage in IBDataBaseErrorMessages) then |
618 |
|
begin |
619 |
|
with FOwner do |
620 |
|
isc_sql_interprete(sqlcode, local_buffer, sizeof(local_buffer)); |
621 |
|
if (ShowSQLCode in FIBDataBaseErrorMessages) then |
622 |
< |
Result := Result + CRLF; |
623 |
< |
Result := Result + strpas(local_buffer); |
622 |
> |
Result := Result + LineEnding; |
623 |
> |
Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + ' ' + strpas(local_buffer); |
624 |
|
end; |
625 |
|
|
626 |
|
if (ShowIBMessage in IBDataBaseErrorMessages) then |