Îòëàâëèâàòü íóæíî NativeCode, íàïpèìåp òàê:
procedure TFDMUtils.GeneralError( DataSet: TDataSet; E:
EDatabaseError; var Action: TDataAction);
var
i: Word;
ExtInfo : String;
begin
ExtInfo := '';
if (E is EDBEngineError) then
begin
if ( EDBEngineError( E ).Errors[0].NativeError = 0 ) then
begin // Local Error
if EDBEngineError( E ).Errors[0].Errorcode = 9732
then
ExtInfo := DataSet.FieldByName( trim( copy(
E.Message, 29, 20 ) ) ).DisplayLabel;
.......................................
end
else
begin // Remote SQL Server error
ExtInfo := ExtractFieldLabels( DataSet, E.Message );
case EDBEngineError( E ).Errors[0].NativeError of
233, 515 :
Alert( 'Îøèáêà', 'Hå âñå ïîëÿ
çàïîëíåíû ! ' + ExtInfo );
547 :
if ( StrPos( PChar( E.Message ), PChar('DELETE' )
) <> nil ) then
Alert('Îøèáêà ïpè óäàëåíèè',
'Èìåþòñÿ ïîä÷èíåííûå çàïèñè,
óäàëåíèå (èçìåíåíèå) íåâîçìîæíî! ' +
ExtInfo )
else
if ( StrPos( PChar( E.Message ), PChar(
'INSERT' ) ) <> nil ) then
Alert( 'Îøèáêà ïpè
âñòàâêå', 'Îòñóòñòâóåò çàïèñü â
ÌÀÑÒÅÐ-òàáëèöå! ' + ExtInfo )
else
if ( StrPos( PChar( E.Message ), PChar(
'UPDATE' )) <> nil ) then
Alert( 'Îøèáêà ïpè
îáíîâëåíèè', 'Îòñóòñòâóåò çàïèñü â
ÌÀÑÒÅÐ-òàáëèöå! ' + ExtInfo );
2601 :
Alert( 'Îøèáêà', 'Òàêàÿ çàïèñü
óæå åñòü!' );
else
Alert( 'Îøèáêà', 'Håèçâåñòíàÿ
îøèáêà, êîä - ' + inttostr( EDBEngineError( E
).Errors[0].NativeError ) + ExtInfo);
end;
end;
end;
end;
Ýòîò êîä áûë çàòî÷åí ïîä MSSQL, íî íå íóæíî ïûòàòüñÿ åãî èñïîëüçîâàòü, à ëó÷øå ïî ýòîìó ïpèìåpó íàïèñàòü ñâîþ ïðîöåäóðó.
Sergey Gristchuk
gristchuk@usa.net (2:463/209.31)