Quien Bloquea un registro?

marcoszorrilla · #1 16-05-2007

Tendrás que decirnos que errores son los que te marca, que seguramente vendrán por la falta de alguna Unit. Yo uso ese procedimiento hace mucho tiempo y nunca me ha fallado.

Un Saludo.

Goyo · #2 17-05-2007

Código Delphi [-]unit Modulo;
interface
uses
  SysUtils, Classes, DB, DBTables;
type
  TDM = class(TDataModule)
    DsEmpleados: TDataSource;
    TbEmpleados: TTable;
    Database: TDatabase;
    DsDepartamentos: TDataSource;
    DsPuestos: TDataSource;
    TbDepartamentos: TTable;
    TbPuestos: TTable;
    DsDirecciones: TDataSource;
    TbDirecciones: TTable;
    DsEspecialidades: TDataSource;
    TbEspecialidades: TTable;
    TbDireccionesId_Direccion: TStringField;
    TbDireccionesDireccion: TStringField;
    TbDepartamentosId_Departamento: TStringField;
    TbDepartamentosId_Direccion: TStringField;
    TbDepartamentosDepartamento: TStringField;
    TbPuestosId_Puesto: TStringField;
    TbPuestosPuesto1: TStringField;
    TbPuestosPuesto2: TStringField;
    TbPuestosSueldoDiario: TFloatField;
    TbPuestosDespensa: TFloatField;
    TbEspecialidadesId_Especialidad: TStringField;
    TbEspecialidadesEspecialidad: TStringField;
    procedure TbEmpleadosPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    Procedure midberror(DataSet: TDataSet; E: EDatabaseError);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  DM: TDM;
  Const
  eKeyViol = 9729;
  eRequiredFieldMissing = 9732;
  eForeignKey = 9733;
  eDetailsExist = 9734;
  eSqlGralerror = 13059;
  eInvalidTime = 10058;
  eInvalidDate = 75;
  EinvalidDateTime=10060;
  eRegisterLocked= 10241;
implementation
{$R *.dfm}
Procedure midberror(DataSet: TDataSet; E: EDatabaseError);
var
  mierror:double;
begin
mierror:= (E as EDBEngineError).Errors[0].Errorcode;
if (E is EDBEngineError) then
    if (E as EDBEngineError).Errors[0].Errorcode = eKeyViol then
      begin
       Application.MessageBox('Imposible dar alta ese registro ya existe','Atención',mb_Ok + mb_IconQuestion);
       Abort;
    end;
if (E as EDBEngineError).Errors[0].Errorcode = eRequiredFieldMissing then
    begin
      Application.MessageBox('Imposible dar alta hay un campo vacio.','Atención',mb_Ok + mb_IconQuestion);
      Abort;
    end;
if (E as EDBEngineError).Errors[0].Errorcode = eInvalidTime then
    begin
      Application.MessageBox('Formato de hora incorrecto.','Atención',mb_Ok + mb_IconQuestion);
      Abort;
    end;
if (E as EDBEngineError).Errors[0].Errorcode = eInvalidDate then
    begin
      Application.MessageBox('Formato de fecha incorrecto.','Atención',mb_Ok + mb_IconQuestion);
      Abort;
    end;
if (E as EDBEngineError).Errors[0].Errorcode = eInvalidDateTime then
    begin
      Application.MessageBox('Formato de fecha-hora incorrecto.','Atención',mb_Ok + mb_IconQuestion);
      Abort;
    end;
   //campo en blanco
if (E as EDBEngineError).Errors[0].Errorcode =   eSqlGralerror then
    begin
      Application.MessageBox('Imposible dar alta hay un campo requerido vacío.','Atención',mb_Ok + mb_IconQuestion);
      Abort;
    end;
  //Registro bloqueado
if (E as EDBEngineError).Errors[0].Errorcode =   eRegisterLocked then
    begin
      Application.MessageBox('Imposible hacer modificaciones registro bloqueado por otro usuario.','Atención',mb_Ok + mb_IconQuestion);
      Abort;
    end;
end;
procedure TbEmpleadosPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
begin
  midberror(TBEmpleados,e);
end;
end.

aqui te muestro el codigo completo de mi Modulo.pas (es donde tengo las tablas que operan el sistema) y los errores que me marcan son los siguientes:
[Hint] Modulo.pas(67): Value assigned to 'mierror' never used
[Error] Modulo.pas(120): Undeclared identifier: 'TbEmpleados'
[Error] Modulo.pas(35): Unsatisfied forward or external declaration: 'TDM.TbEmpleadosPostError'
[Error] Modulo.pas(37): Unsatisfied forward or external declaration: 'TDM.midberror'
[Fatal Error] Cardex.pas(162): Could not compile used unit 'Modulo.pas'
...

y en lo que respecta a esta parte del codigo a que te refieres o a donde lo pongo:

Código Delphi [-]//aqui capturamos el error de bloqueo
procedure TdmoPalma.CliEditError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
midberror(cli,e);
end;

procedure TdmoPalma.CliPostError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
midberror(cli,e);
end;

que significa esta funcion TdmoPalma.CliEditError....

Cli = si no me equivoco es el nombre de la tabla TbEmpleados
TdmoPalma = ?
CliEditError = ?
CliPostError = ?

Espero tu ayuda y de antemano muchas gracias por
contestar mis mensajes...
gracias

marcoszorrilla · #3 17-05-2007

Aquí tienes un ejemplo completo que funciona correctamente.

Código Delphi [-]unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables;

  Procedure midberror(DataSet: TDataSet; E: EDatabaseError);

type
  TForm1 = class(TForm)
    Table1: TTable;
    DataSource1: TDataSource;
    procedure Table1PostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
Const
  eKeyViol = 9729;
  eRequiredFieldMissing = 9732;
  eForeignKey = 9733;
  eDetailsExist = 9734;
  eSqlGralerror = 13059;
  eInvalidTime = 10058;
  eInvalidDate = 75;
  EinvalidDateTime=10060;
  eRegisterLocked= 10241;
implementation

{$R *.DFM}

Procedure midberror(DataSet: TDataSet; E: EDatabaseError);
begin
if (E is EDBEngineError) then
    if (E as EDBEngineError).Errors[0].Errorcode = eKeyViol then
    begin
      Application.MessageBox('Imposible dar alta ese registro ya existe','Atención',mb_Ok +
mb_IconQuestion);
      Abort;
      end;

if (E as EDBEngineError).Errors[0].Errorcode = eRequiredFieldMissing then
    begin
      Application.MessageBox('Imposible dar alta hay un campo vacio.','Atención',mb_Ok +
mb_IconQuestion);
      Abort;
      end;

      //campo en blanco

      if (E as EDBEngineError).Errors[0].Errorcode =   eSqlGralerror then
    begin
      Application.MessageBox('Imposible dar alta hay un campo requerido vacío.','Atención',mb_Ok +
mb_IconQuestion);
      Abort;
      end;

end;

procedure TForm1.Table1PostError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
MiDbError(Table1, e);
end;

end.

Un Saludo.

Goyo · #4 17-05-2007

gracias Marcoszorrilla por la gran ayuda que has brindado...
aqui pongo el codigo que puse dentro de mi Modulo de Datos para cada una de las tablas que tengo en mi aplicacion..

Código Delphi [-]unit Modulo;
interface
uses
//  SysUtils, Classes, DB, DBTables;
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 Db, DBTables;
Procedure midberror(DataSet: TDataSet; E: EDatabaseError);
type
  TDM = class(TDataModule)
    DsEmpleados: TDataSource;
    TbEmpleados: TTable;
    Database: TDatabase;
    DsDepartamentos: TDataSource;
    DsPuestos: TDataSource;
    TbDepartamentos: TTable;
    TbPuestos: TTable;
    DsDirecciones: TDataSource;
    TbDirecciones: TTable;
    DsEspecialidades: TDataSource;
    TbEspecialidades: TTable;
    TbDireccionesId_Direccion: TStringField;
    TbDireccionesDireccion: TStringField;
    TbDepartamentosId_Departamento: TStringField;
    TbDepartamentosId_Direccion: TStringField;
    TbDepartamentosDepartamento: TStringField;
    TbPuestosId_Puesto: TStringField;
    TbPuestosPuesto1: TStringField;
    TbPuestosPuesto2: TStringField;
    TbPuestosSueldoDiario: TFloatField;
    TbPuestosDespensa: TFloatField;
    TbEspecialidadesId_Especialidad: TStringField;
    TbEspecialidadesEspecialidad: TStringField;
    procedure TbEmpleadosPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure TbEspecialidadesPostError(DataSet: TDataSet;
      E: EDatabaseError; var Action: TDataAction);
    procedure TbDireccionesPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure TbDepartamentosPostError(DataSet: TDataSet;
      E: EDatabaseError; var Action: TDataAction);
    procedure TbPuestosPostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  DM: TDM;
Const
  eKeyViol = 9729;
  eRequiredFieldMissing = 9732;
  eForeignKey = 9733;
  eDetailsExist = 9734;
  eSqlGralerror = 13059;
  eInvalidTime = 10058;
  eInvalidDate = 75;
  EinvalidDateTime=10060;
  eRegisterLocked= 10241;
implementation
{$R *.dfm}
Procedure midberror(DataSet: TDataSet; E: EDatabaseError);
begin
if (E is EDBEngineError) then
    if (E as EDBEngineError).Errors[0].Errorcode = eKeyViol then
    begin
      Application.MessageBox('Imposible dar alta ese registro ya existe','Atención',mb_Ok + mb_IconQuestion);
      Abort;
      end;
if (E as EDBEngineError).Errors[0].Errorcode = eRequiredFieldMissing then
    begin
      Application.MessageBox('Imposible dar alta hay un campo vacio.','Atención',mb_Ok + mb_IconQuestion);
      Abort;
      end;
     //campos en blanco y requeridos
if (E as EDBEngineError).Errors[0].Errorcode =   eSqlGralerror then
    begin
      Application.MessageBox('Imposible dar alta hay un campo requerido vacío.','Atención',mb_Ok + mb_IconQuestion);
      Abort;
      end;
end;
procedure TDM.TbEmpleadosPostError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
  MiDbError(TbEmpleados, e);
end;

procedure TDM.TbEspecialidadesPostError(DataSet: TDataSet;
  E: EDatabaseError; var Action: TDataAction);
begin
  MiDbError(TbEspecialidades, e);
end;
procedure TDM.TbDireccionesPostError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
  MiDbError(TbDirecciones, e);
end;
procedure TDM.TbDepartamentosPostError(DataSet: TDataSet;
  E: EDatabaseError; var Action: TDataAction);
begin
  MiDbError(TbDepartamentos, e);
end;
procedure TDM.TbPuestosPostError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
  MiDbError(TbPuestos, e);
end;
end.

funciona y manda los mensajes

gracias y un saludo....

Herramientas	Buscar en Tema
Mostrar Versión Imprimible Enviar por Correo	Buscar en Tema: Búsqueda Avanzada
Desplegado
Cambiar a Modo Lineal Modo Híbrido Cambiar a Modo Hilado