4 replies to this topic

[coruxito]

Hola amigos,

Tengo varios campos que los cree como Unique Keys en mi base de datos.
Lo que ocurre es que me gustaría hacer el tratamiento de cual de ellos salta de una manera más centralizada, no hacer un select cada vez que voy insertar un valor para saber si existe o no.
Por ejemplo tengo índices como IND_EMPLEADO_NOMBRE E IND_EMPRESA_RAZONSOCIAL. Las dos no son PRIMARY KEYS, únicamente son campos que no quiero que se repitan en la base de datos. Cuando em ambas tablas intento meter uno de esos campos duplicado me salta el típico:

[attempt to store duplicate value(visible to active transactions) in unique index "IND_EMPLEADO_NOMBRE"]
o
[attempt to store duplicate value(visible to active transactions) in unique index "IND_EMPRESA_RAZONSOCIAL"]

Miro que es un patrón que se repite y me gustaria poder capturar cual es exactamente, así haria algo un poco más "elegante" y mejor aprovechando lo que la Firebird ya está haciendo sin meter más carga al SGBD.

Sabéis alguna manera de capturar cual indices está saltando ?

[Delphius]

Hola coruxito,
No recuerdo bien el texto de todas las excepciones posibles de capturar pero si ese es el texto que te muestra el cuadro de diálogo de la excepción es posible entonces capturarla y extraer de éste el nombre del índice.
Como toda excepción, en su propiedad Message tiene el texto a mostrar. Aprovechando la cláusula try-except capturas la excepción y evalúas el Message para ver si contiene dicho texto, luego resta localizar en éste la primera comilla doble ("), lo que sigue del texto es justamente el nombre del índice.

Para lograr eso te puedes valer de funciones de tratamiento para cadenas como Pos(), Copy(), etc.

¿Me explico?

delphi

try
// hacer algo
except
// capturamos la excepción y buscamos el texto
  on E: Exception do
  begin
    // primero nos aseguramos que se trate efectivamente de la excepción correcta
    PosExp := Pos('[attempt to store duplicate value(visible to active transactions) in unique index', E.Exception);
    if PosExp = 1
       then begin
                  // entonces buscamos la comilla
                  PosExp := Pos('"',E.Message);
                  // copiamos el texto solamente desde la pos +1 hasta justo antes de "] del final
                  NombreIndice := Copy(E.Message, PosExp + 1, Length(E.Message) - PosExp - 2);
               end;
  end;
end;

Ojo: está escrito al vuelo, es sólo una orientación. Desconozco si existe una excepción propia para este tipo de error. De ser así entonces directamente en vez de evaluar con Exception utilizamos la clase definida y no se necesitaría de estar leyendo en Message si el texto es del error por índice.

Saludos,

[cadetill]

Buenas,

Yo te propongo una solución algo más elaborada. No está terminado (a ver si tengo tiempo y lo termino para publicarlo en el blog), pero para hacerte una idea de por donde tirar quizás pueda servirte. El ejemplo está hecho usando FIBPlus, dependiendo de los componentes que uses puede cambiar algo el código (pero la idea debería ser la misma)

Primero el bloque de código que puede dar error, en este caso al hacer el post

delphi

    try
      dsFIBMaster.Append;
      dsFIBMasterID.AsInteger := 1;
      dsFIBMasterCADENA.AsString := '2';
      dsFIBMasterUNICO.AsInteger := 2;
      dsFIBMasterREQUERIDO.AsInteger := 2;
      dsFIBMaster.Post;
    except // aquí empieza el control de error. Fíjate que se capturan diferentes tipos de errores, aunque básicamente siempre se llama a la misma función
      on E: EDatabaseError do
        ShowMessage(GetFIBMessageError(E));
      on E: EFIBClientError do
        ShowMessage(GetFIBMessageError(E));
      on E: Exception do
        ShowMessage(E.ClassName);
    end;

Y ahora el código que gestiona el error y devuelve la cadena resultante

delphi

function GetFIBMessageError(E: Exception): string;
  function GetValidationFieldMsg(BDMsg, Raiser: string): string;
  var
    Column,
    ErrorValue: string;
  begin
    Column := Copy(BDMsg, Pos('for column', BDMsg)+10, Pos(', value', BDMsg)-(Pos('for column', BDMsg)+10));
    ErrorValue := Copy(BDMsg,
                       PosEx('"', BDMsg, Pos(', value', BDMsg)),
                       PosEx('"', BDMsg, PosEx('"', BDMsg, Pos(', value', BDMsg))));
    Result := Format(errValidationField, ['Validación de campo incorrecta',
                                          Raiser,
                                          Format(errValidation, [Trim(Column), Trim(ErrorValue)])]);
  end;
 
  function GetConstraintFields(aConstraint: string): string;
  const
    SQL = 'select i.rdb$field_name, i.rdb$field_position from RDB$INDEX_SEGMENTS i where i.rdb$index_name = :constraint order by 2';
  var
    Q: TpFIBQuery;
  begin
    Q := TpFIBQuery.Create(nil);
    try
      Result := '';
      Q.Database := dbFIBBase;
      Q.Transaction := trFIBTrans;
      Q.Options := [qoStartTransaction];
      Q.SQL.Text := SQL;
      Q.ParamByName('constraint').AsString := aConstraint;
      Q.ExecQuery;
      while not Q.Eof do
      begin
        if Result = '' then Result := Trim(Q.Fields[0].AsString)
        else Result := Result + ',' + Trim(Q.Fields[0].AsString);
        Q.Next;
      end;
    finally
      if Assigned(Q) then FreeAndNil(Q);
    end;
  end;
 
  function GetDuplicatePrimUnqMsg(BDMsg, Raiser: string): string;
  var
    Constraint,
    Table,
    Cols: string;
    A, B: Integer;
  begin
    A := PosEx('"', BDMsg)+1;
    B := PosEx('"', BDMsg, A+1);
    Constraint := Trim(Copy(BDMsg, A, B-A));
 
    A := PosEx('"', BDMsg, B+1)+1;
    B := PosEx('"', BDMsg, A+1);
    Table := Trim(Copy(BDMsg, A, B-A));
 
    Cols := GetConstraintFields(Constraint);
 
    Result := Format(errPrimaryKey, ['Clave primaria o índice único duplicado',
                                     Raiser,
                                     Format(errDuplicatePriUniq, [Constraint, Cols, Table])]);
  end;
 
  function GetForeingKey(BDMsg, Raiser: string): string;
  var
    Constraint,
    Table,
    Cols: string;
    A, B: Integer;
  begin
    A := PosEx('"', BDMsg)+1;
    B := PosEx('"', BDMsg, A+1);
    Constraint := Trim(Copy(BDMsg, A, B-A));
 
    A := PosEx('"', BDMsg, B+1)+1;
    B := PosEx('"', BDMsg, A+1);
    Table := Trim(Copy(BDMsg, A, B-A));
 
    Cols := GetConstraintFields(Constraint);
 
    Result := Format(errForeingKey, ['Clave foránea inexistente',
                                     Raiser,
                                     Format(errDuplicatePriUniq, [Constraint, Cols, Table])]);
  end;
 
  function GetGeneralMsg(BDMsg, Raiser, Msg: string; IBError, SQLCode: Integer): string;
  begin
    Result := Format(errGeneralText, [BDMsg,
                                      raiser,
                                      Msg,
                                      IBError,
                                      SQLCode]);
  end;
begin
  Result := E.Message;
 
  // si la excepción recibida no es de la clase EFIBError, mostramos un error genérico
  if not(E is EFIBError) then
  begin
    if not(E is EDatabaseError) then
      Result := GetGeneralMsg('Error no codificado', '', E.Message, -1, -1)
    else
      Result := GetGeneralMsg('Error no codificado', '', EDatabaseError(E).Message, -1, -1);
    Exit;
  end;
 
  // aquí personalizamos los diferentes errores
  case EFIBError(E).IBErrorCode of
    isc_not_valid:
      Result := GetValidationFieldMsg(EFIBError(E).IBMessage, EFIBError(E).RaiserName); // validation column;
    isc_unique_key_violation:
      Result := GetDuplicatePrimUnqMsg(EFIBError(E).IBMessage, EFIBError(E).RaiserName); // duplicate primary or unique
    isc_foreign_key: Result :=
      GetForeingKey(EFIBError(E).IBMessage, EFIBError(E).RaiserName); // clave foránea inexistente
 
    // aquí se podría ir añadiendo tipos de errores y así personalizarlos todos. En FIBPlus están todos definidos en la unidad IB_ErrorCodes
 
    else
      Result := GetGeneralMsg(EFIBError(E).IBMessage, EFIBError(E).RaiserName, EFIBError(E).Msg, EFIBError(E).IBErrorCode, EFIBError(E).SQLCode);
  end;
end;

y los mensajes de error (para ya tenerlo todo

delphi

resourcestring
  errConnectingDB = 'Se ha producido un error conectando con la base de datos.'#13#13'Base de datos: %s'#13'Mensaje de error: %s';
 
  // general data
  qInEditInsert = 'Está añadiendo o modificando datos. Si cancela la pantalla sin aceptar los cambios, éstos no se guardarán. ¿Está seguro de querer continuar?';
 
  // Post Errors
  errGeneralText =
    '  Se ha producido un error en la grabación del registro. '#13#13 +
    '  Causa: %s '#13 +
    '  Generado por: %s '#13#13 +
    '  Información extra: %s '#13#13 +
    '  IBErrorCode: %d '#13#13 +
    '  SQLCode: %d';
 
  errValidationField =
    '  Se ha producido un error en la grabación del registro. '#13#13 +
    '  Causa: %s '#13 +
    '  Generado por: %s '#13#13 +
    '  Información extra: %s ';
 
  errPrimaryKey =
    '  Se ha producido un error en la grabación del registro. '#13#13 +
    '  Causa: %s '#13 +
    '  Generado por: %s '#13#13 +
    '  Información extra: %s ';
 
  errForeingKey =
    '  Se ha producido un error en la grabación del registro. '#13#13 +
    '  Causa: %s '#13 +
    '  Generado por: %s '#13#13 +
    '  Información extra: %s ';
 
  errValidation =
    #13'   - Campo: %s '#13 +
       '   - Valor no válido: %s '#13#13 +
       'Modifique el valor e inténtelo de nuevo. Si el problema persiste, contacte con el distribuidor.';
 
  errDuplicatePriUniq =
    #13'   - Índice: %s '#13 +
       '   - Campos afectados: %s '#13 +
       '   - Tabla: %s '#13#13 +
       'Modifique el/los valor/es e inténtelo de nuevo. Si el problema persiste, contacte con el distribuidor.';

Entiendo que si lo hubiera puesto todo en una unit hubiera quedado mejor, pero bueno, espero se entienda jejejeje

Nos leemos

[coruxito]

Hola amigos, agradezco a Delphius y a cadetill. La verdad que al final pillé la idea de Delphis pq la de cadetill sencillamente no la entendí muy bien.
Pero lo hize algo distinto, cree una procedure así:

delphi

procedure ErroresClaveDuplicada(Texto : String);
var
  Error : String;
  Pos_Ini: Integer;
begin
  Pos_Ini:=Pos('IND_',Texto);
  Error:=copy(Texto,Pos_Ini,length(Texto));
  Error:=copy(Error,1,length(Error)-1);
 
  if Error = 'IND_TIP_NOMBRE' then
  begin
    ShowMessage('Tipo ya existe');
  end
  else if Error = 'IND_AGE_NIF' then
  begin
    ShowMessage('NIF del Agente ya existe');
  end
  else if Error = 'IND_CLI_CUENTA' then
  begin
    ShowMessage('Numero de la cuenta ya existe');
  end
  else if Error = 'IND_EMP_NIF' then
  begin
    ShowMessage('NIF del Empleado ya existe');
  end
  else if Error = 'IND_EMP_SS' then
  begin
    ShowMessage('Numero de Seguridad Social del Empleado ya existe');
  end
  else if Error = 'IND_EPR_RAZON_SOCIAL' then
  begin
    ShowMessage('Razón Social de la Empresa ya existe');
  end
  else if Error = 'IND_FOR_NIF' then
  begin
    ShowMessage('NIF del Formador ya existe');
  end
  else if Error = 'IND_MOD_DESCRIPCION' then
  begin
    ShowMessage('Modalidad ya existe');
  end
  else if Error = 'IND_STA_NOMBRE' then
  begin
    ShowMessage('Estado ya existe');
  end
  else if Error = 'IND_STU_DESCRIPCION' then
  begin
    ShowMessage('Formación ya existe');
  end
  else
  begin
    ShowMessage('Error Desconocido');
  end;
end;

La instrucción que ejecuta la Query la pongo dentro deu un bloque como ese:

delphi

procedure TFormPrincipal.BGuardarTipoClick(Sender: TObject);
begin
  IBQueryInsertarTipos.ParamByName('tip_denominacion').Value:= ETipDenominacion.Text;
  IBQueryInsertarTipos.ParamByName('tip_horas').Value:= METipHoras.Text;
  IBQueryInsertarTipos.ParamByName('tip_idmodalidad').Value:= IBQueryCargaModalidades.FieldByName('mod_id').Value;
 
  try
    begin
      IBQueryInsertarTipos.ExecSQL;
      IBTransactionINSERT.Commit;
      Principal.RecargarDatos;
      Principal.TipoValorDefecto;
 
      ShowMessage('Tipo Ingresado con Exito');
    end
  except
    on E: Exception do
    begin
      Principal.ErroresClaveDuplicada(E.Message);
    end;
  end;
end;

Hago el mismo para todos formularios donde tenga la necesidad de hacer cambios en la base, de momento sólo funciona para los índices de las claves de tipo UNIQUE, pero me gustó tanto la solución que pretendo mejorarla para abarcar todos errores que sean tratados por los índices de Firebird(cada vez me va gustando más el SGBD).
Espero que sea útil para algunos ese código y que tb pueda ser criticado/mejorado.

Cuando cadetill tenga tiempo creo que seria muy interesante si pudiera explicar si solución para un novato como yo porque la verdad que tiene pinta de algo que abarca muchos tipos de fallos distintos.

Gracias como siempre sois unos cracks !!!

[Wilson]

Me alegra que hayas resuelto el asunto.

A continuación te coloco un ejemplo de como centralizar los mensajes de error de todo tipo, provenientes de una base de datos FIREBIRD, para el ejemplo uso DbExpress y obviamente TClientDataset, es un procedimiento único  que sirve para todas las tablas de la BD, que  intercepta el evento OnRenconcileError de todos los TClientDatasets de un módulo y un arcivo de texto de nombre Mensajes.txt que contiene los mensajes de error (incluidas las excepciones, constraints, etc. de toda la DB) y que se encuentra en la misma carpeta del ejecutable.

Pongamos como ejemplo  la siguiente BD:

CREATE EXCEPTION CODIGO_VACIO 'EL CODIGO NO DEBE ESTAR EN BLANCO';

CREATE EXCEPTION NOMBRE_VACIO 'DEBE DE INGRESAR UN NOMBRE DE ENTIDAD';

 

CREATE TABLE NOMBRES (

    ID_NOMBRE       INTEGER NOT NULL,

    NOMBRE          VARCHAR(30) NOT NULL ,

    CODIGO          VARCHAR(10) NOT NULL ,

 

PRIMARY KEY (ID_NOMBRE),

CONSTRAINT UQ_CODIGO_REPETIDO UNIQUE (CODIGO)

);

 

CREATE TABLE OTRATABLA (

    ID_TABLA       INTEGER NOT NULL,

    TABLA          VARCHAR(30) NOT NULL ,

 

PRIMARY KEY (ID_TABLA),

CONSTRAINT UQ_TABLA_REPETIDA UNIQUE (TABLA)

);

Agregamos en la sección private del módulo de datos (en Delphi) el siguiente campo:

delphi

private
  FErrores: TStringList;

Y luego intreceptar el evento OnReconcileError de los TClientDatset así­: (Si usas otros componentes de conexión, basta interceptar el evento apropiado de los Datasets y compartir el procedimiento)

delphi

procedure TMiModulo.Conciliacion(DataSet: TCustomClientDataSet;
  E: EReconcileError; UpdateKind: TUpdateKind; var Action: TReconcileAction);
const
  Archivo = 'Mensajes.txt';
var
  K: Integer;
  S, N: string;
begin
  if not Assigned(FErrores) then
  begin
    FErrores := TStringList.Create;
    S := ExtractFilePath(GetModuleName(HInstance)) + Archivo;
    if FileExists(S) then
      FErrores.LoadFromFile(S);
  end;
  S := E.Message;
  for K := 0 to FErrores.Count - 1 do
  begin
    N := FErrores.Names[K];
    if Pos(N, S) <> 0 then
    begin
      S := FErrores.Values[N];
      Break;
    end;
  end;
  MessageDlg(S, mtError, [mbOk], 0);
end;

A continuación escribo como deberian ir algunas lineas del archivo de texto:

CODIGO_VACIO=El código no debe estar en blanco//o lo que tu quieras
NOMBRE_VACIO=Debe ingresar un nombre de entidad
UQ_CODIGO_REPETIDO=Este codigo ya existe
UQ_TABLA_REPETIDA=Esta tabla ya existe

Saludos