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; |
127 |
|
public |
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: TStatusCode; |
250 |
|
IJournallingHook = interface |
251 |
|
['{7d3e45e0-3628-416a-9e22-c20474825031}'] |
252 |
|
procedure TransactionStart(Tr: ITransaction); |
253 |
< |
function TransactionEnd(TransactionID: integer; Action: TTransactionAction): boolean; |
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 |
616 |
|
|
617 |
|
{ TFBStatus } |
618 |
|
|
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 |
637 |
|
inherited Create; |
638 |
|
FOwner := aOwner; |
639 |
|
FPrefix := prefix; |
640 |
< |
FIBDataBaseErrorMessages := [ShowSQLCode, ShowSQLMessage, ShowIBMessage]; |
640 |
> |
FIBDataBaseErrorMessages := [ShowIBMessage]; |
641 |
> |
end; |
642 |
> |
|
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; |
665 |
|
begin |
666 |
|
Result := FPrefix; |
667 |
|
IBDataBaseErrorMessages := FIBDataBaseErrorMessages; |
668 |
< |
if (ShowSQLCode in IBDataBaseErrorMessages) then |
653 |
< |
Result := Result + 'SQLCODE: ' + IntToStr(Getsqlcode); {do not localize} |
654 |
< |
|
655 |
< |
if [ShowSQLMessage, ShowIBMessage]*IBDataBaseErrorMessages <> [] then |
668 |
> |
if SQLCodeSupported then |
669 |
|
begin |
670 |
< |
if (ShowSQLCode in FIBDataBaseErrorMessages) then |
671 |
< |
Result := Result + LineEnding; |
659 |
< |
Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + ' '; |
660 |
< |
end; |
670 |
> |
if (ShowSQLCode in IBDataBaseErrorMessages) then |
671 |
> |
Result := Result + 'SQLCODE: ' + IntToStr(Getsqlcode); {do not localize} |
672 |
|
|
673 |
< |
if (ShowSQLMessage in IBDataBaseErrorMessages) then |
674 |
< |
Result := Result + GetSQLMessage; |
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 ShowSQLMessage in IBDataBaseErrorMessages then |
683 |
> |
if Result <> FPrefix then |
684 |
|
Result := Result + LineEnding; |
685 |
< |
Result := Result + GetIBMessage; |
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); |