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
[-]
procedure _errores_interbase (E: EDatabaseError; var Action: TDataAction);
procedure _errores_database (E: EDatabaseError);
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
335544665: begin
E.Create('El identificador para la tabla ya se ha utilizado.');
MessageDlg(E.Message,mtWarning,[mbOK],0);
end;
335544347: begin 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;
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;
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;
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; end; Action := daAbort;
end;
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