[lbuelvas]

Hola foro,

Para atrapar errores utilizo una rutina (no me acuerdo de donde tome unas porciones de código y lo mejore) que me ha servido tanto para firebird 1.5 como para interbase 6.0.2.0.

Esto funciona con los componentes IBX y atrapa los errores mas comunes y los pone en español.

En una biblioteca crear los siguientes procedimientos:

Código Delphi [-]
//Manejo de Errores EDataBaseError (Nivel aplicacion) y EIBError (Nivel Interbase)
procedure  _errores_interbase  (E: EDatabaseError; var Action: TDataAction);
procedure  _errores_database   (E: EDatabaseError);

//*************************************************************************
//Manejo de Errores EDataBaseError (Nivel aplicacion) y EIBError (Nivel Interbase)
//*************************************************************************

//atrapa el error generado por el motor de bases de Datos Interbase V.6.01 o posterior
//E              -> es el nombre de la excepcion tipo EDatabaseError
//Action         -> la accion que debe tomar el Dataset
procedure _errores_interbase (E: EDatabaseError; var Action: TDataAction);
Var
 Nro_Error : Variant;
 cadena: string;
begin
  cadena := E.Message;
  _errores_database(E);
  if (E is EIBError) then begin
    SysUtils.Beep;
    Nro_Error :=  (E as EIBError).IBErrorCode;
    case (E as EIBError).IBErrorCode of
      //isc_unique_key_violation             335544665L violation of PRIMARY or UNIQUE KEY constraint
      335544665: begin
                   E.Create('El identificador para la tabla ya se ha utilizado.');
                   MessageDlg(E.Message,mtWarning,[mbOK],0);
                 end;
      //isc_not_valid                        335544347L validation error for column
      335544347: begin  //Valor NULL o diferente al dominio
                   //validation error for column XXXX, value "*** null ***"'
                   E.Create('Error de Validacion, valor requerido para el campo ' +
                             Copy(E.Message, 28, Pos(',',E.Message) - 28));
                   MessageDlg(E.Message,mtWarning,[mbOK],0);
                 end;
     //isc_foreign_key                       335544466L violation of FOREIGN KEY constraint
      335544466: begin
                   E.Create('Se ha violado la restriccion: '                                                        + _fin_linea(1) +
                             Copy(E.Message,Pos('"',E.Message), Length(E.Message) - Pos('"',E.Message)  )    + '".' + _fin_linea(1) +
                            'El registro actual tiene asociado(s) registro(s) en otra tabla que dependen de él, ó'  + _fin_linea(1) +
                            'se esta colocando un valor inválido en un campo del registro actual');
                   E.Message := StringReplace(E.Message, 'on table', 'de la tabla', [rfreplaceall]);
                   MessageDlg(E.Message,mtWarning,[mbOK],0);
                 end;
      //isc_dsql_error                       335544569L Dynamic SQL Error
      335544569: begin
                   E.Create('Error de Conversión de la Cadena : ' +
                   Copy(E.Message,Pos('"',E.Message), Length(E.Message) - Pos('"',E.Message)  ) );
                   MessageDlg(E.Message,mtWarning,[mbOK],0);
                 end;
      //isc_except                           335544517L exception 
      335544517: begin
                   E.Create('Excepcion : ' +
                   Copy(E.Message,Pos(_fin_linea(1) , E.Message), Length(E.Message)));
                   MessageDlg(E.Message,mtWarning,[mbOK],0);
                 end;
      else         MessageDlg('Error (' + IntToStr(Nro_Error) + ') - ' + E.Message,mtWarning,[mbOK],0);
    end;  //case
  end;// If EIBError
  Action := daAbort;
end;

//atrapa el error generado por la aplicacion
//E              -> es el nombre de la excepcion tipo EDatabaseError
procedure _errores_database (E: EDatabaseError);
var
  cadena: string;
  posicion: integer;
  longitud: integer;
begin
  if (E is EDatabaseError) then begin
    SysUtils.Beep;
    cadena := E.Message;
    if pos('must have a value',cadena) <> 0 then begin
      posicion := pos(chr(39),cadena);
      delete(cadena,1,posicion);
      posicion := pos(chr(39),cadena);
      longitud := length(cadena);
      delete(cadena,posicion,longitud);
      MessageDlg('El campo' + _comillas(cadena) + 'debe tener un valor',mtWarning, [mbOK],0);
    end;
  end;
end;

En los datamodulos o donde tenga los componentes de conexion a bases de datos colocar, en mi caso se llama DataModulo.

Código Delphi [-]
procedure Maneja_Error   (DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);

procedure TDataModulo.Maneja_Error(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
begin
  _errores_interbase(E,Action);
end;

y en los eventos OnPostError y OnDeleteError de los TIBDataset escriba directamente

Código Delphi [-]
Maneja_Error