Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Conexión con bases de datos (https://www.clubdelphi.com/foros/forumdisplay.php?f=2)
-   -   Quien Bloquea un registro? (https://www.clubdelphi.com/foros/showthread.php?t=4040)

marcial 30-09-2003 00:15:49
Quien Bloquea un registro?
 
Hola a todos y gracias por anticipdo. He buscado y leido en el foro pero no he encontrado respuesta al problema: ¿Que usuario esta bloqueando un registro en una tabla paradox?.

Hay un ejemplo en el foro paro da errores. He mirado en los trucos de IanMartens pero tampoco he visto nada que me ayude.......

Por favor, habría alguien que me indicase como pudo sacar el mensaje: "Registro bloqueado por el usuario XXXXXX"?

Muchas gracias por vuestra ayuda
Marcial

Ruben_Cu 30-09-2003 02:58:01
Hola marcial, el encargado de administrar los usuarios en paradox y generar los mensajes es el fichero PDOXUSRS.NET para mas información sobre esto pasate por paradox en red y tendras mas argumentos incluyendo links a articulos de Borland.
Saludos

marcial 30-09-2003 22:35:23
Cita:
Posteado originalmente por Ruben_Cu
Hola marcial, el encargado de administrar los usuarios en paradox y generar los mensajes es el fichero PDOXUSRS.NET para mas información sobre esto pasate por paradox en red y tendras mas argumentos incluyendo links a articulos de Borland.
Saludos

Gracias Ruben por tu interës; ya se que es pdoxusrs:net quien bloquea; pero lo que yo quiero conseguir es evitar ese mensaje ta horrible de paradox y sacar uno mio diciendo en español: Registro bloqueado por USUARIO,

marcoszorrilla 30-09-2003 23:31:07
Prueba con este procedimiento que yo utilizo con las tablas Paradox y me va perfectamente:

Código:
Procedure midberror(DataSet: TDataSet; E: EDatabaseError);

…….

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

implementation

……

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;

//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;
Un Saludo.

marcoszorrilla 30-09-2003 23:53:44
Le he añadido una función para que nos devuelva el nombre del ordenador de la red que esta bloqueando el registro, así queda mejor. II

Código:
Procedure midberror(DataSet: TDataSet; E: EDatabaseError);
function GetComputerNetName: string
…….

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

implementation

……

Procedure midberror(DataSet: TDataSet; E: EDatabaseError);
var
mierror:double;
sComputerNetName:String;
sMsgeErrorBloqueo:String;
begin

mierror:= (E as EDBEngineError).Errors[0].Errorcode;
sComputerNetName:=GetComputerNetName();
sMsgeErrorBloqueo:='Imposible hacer modificaciones registro bloqueado por el usuario.'+ sComputerNetName;

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;

    if (E as EDBEngineError).Errors[0].Errorcode =  eRegisterLocked then
    begin
      Application.MessageBox(Pchar(sMsgeErrorBloqueo),'Atención',mb_Ok +
mb_IconQuestion);
      Abort;
      end;
     
end;

//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;

function GetComputerNetName: string;
var
  buffer: array[0..255] of char;
  size: dword;
begin
  size := 256;
  if GetComputerName(buffer, size) then
    Result := buffer
  else
    Result := ''
end;


Un Saludo.

marcial 02-10-2003 23:23:36
Cita:
Posteado originalmente por marcoszorrilla
Le he añadido una función para que nos devuelva el nombre del ordenador de la red que esta bloqueando el registro, así queda mejor. II

Código:
Procedure midberror(DataSet: TDataSet; E: EDatabaseError);
function GetComputerNetName: string
…….

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

implementation

……

Procedure midberror(DataSet: TDataSet; E: EDatabaseError);
var
mierror:double;
sComputerNetName:String;
sMsgeErrorBloqueo:String;
begin

mierror:= (E as EDBEngineError).Errors[0].Errorcode;
sComputerNetName:=GetComputerNetName();
sMsgeErrorBloqueo:='Imposible hacer modificaciones registro bloqueado por el usuario.'+ sComputerNetName;

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;

    if (E as EDBEngineError).Errors[0].Errorcode =  eRegisterLocked then
    begin
      Application.MessageBox(Pchar(sMsgeErrorBloqueo),'Atención',mb_Ok +
mb_IconQuestion);
      Abort;
      end;
     
end;

//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;

function GetComputerNetName: string;
var
  buffer: array[0..255] of char;
  size: dword;
begin
  size := 256;
  if GetComputerName(buffer, size) then
    Result := buffer
  else
    Result := ''
end;


Un Saludo.


Gracias de nuevo por contestar, pero creo que si pongo "if GetComputerName..." lo que obtengo es el nombre del usuario local y lo que yo quiero saber es qué usuario de la red es el que bloquea, no el nombre de mi usuario.

PC1 PC2
Edita primero el registro Quiero que aparezca: Registro bloqueado por PC1

José Luis Garcí 03-10-2003 15:21:20
Busca en el hitorico del foro anterior y encontraras un ejemplo completo y tambien encontraras una funcion que haces lo que quieres, los dos ejemplos son mios asi que mira, si no la encuentras mandame un emilio y te envio la transcripción de la función.
Esta lo que hace es cojer el error que canta el programa (donde curiosamente viene el usuario) y los pasa de manera que nosotros queremos.

Un saludo desde Canarias.

marcial 03-10-2003 18:28:09
Cita:
Posteado originalmente por José Luis Garcí
Busca en el hitorico del foro anterior y encontraras un ejemplo completo y tambien encontraras una funcion que haces lo que quieres, los dos ejemplos son mios asi que mira, si no la encuentras mandame un emilio y te envio la transcripción de la función.
Esta lo que hace es cojer el error que canta el programa (donde curiosamente viene el usuario) y los pasa de manera que nosotros queremos.

Un saludo desde Canarias.

Muchas gracias por contestar mi duda pero tengo que decirte que ya leí tus mensajes de marzo pasado y tampoco pude solucionarlo.

Leí todos los trucos de Ian Marteens y no encontré la solución, y probé el programa que escribiste y me da un error que no supe solucionar; el error es el siguiente:

usua:=(copy(error(Ansipos('User:',error)+5),(length(error)-(ansipos('User:',error)+4))));

me dice dos cosas: 1) Missing operator or semicolon. 2) Not enough actual parameters y el cursor se pone entre el la A del primer Ansipos y el paréntesis e su izquierda. Tambien he quitado el apöstrofo de text1+usua'+text2 pero tampoco.

No he sabido modificarlo para que funcione. ¿Podrías ayudarme?

Gracias por anticipado

Marcial

Lepe 04-10-2003 11:37:22
Yo tambien uso la funcion esa del usuario.... pero da mas problemas que otra cosa, sobre todo, porque la cadena 'User' puede estar contenida en otros errores al editar el registro. Pero vamos, lo que buscas es esto:
Código:
Function USUARIO(Error:string):string;
begin
Result :=copy(error,(Ansipos('User:',error)+6),length(error)-(ansipos('User:',error)+4));
qrypuesto.ParamByName('prPuesto').AsString:=copy(error,(Ansipos('User:',error)+6),length(error)-(ansipos('User:',error)+4));
qrypuesto.Prepare;
qryPuesto.open;
try
 if not (qrypuesto.IsEmpty) then
    if not qrypuesto.Fields[0].IsNull then
        Result:= qrypuesto.Fields[0].AsString
finally
 qrypuesto.Close;
end;
result := uppercase(result);
end;
qrypuesto es una consulta que hago a mi tabla login, donde guardo el nombre de mi usuario ( el de mi programa) con el nombre del ordenador donde está trabajando, así, muestro el usuario de mi programa que ha bloqueado el registro en lugar de mostrar el nombre del ordenador.

Eso si, cuando un usuario se va del sistema tienes que borrar el campo 'puesto' de la tabla login.


Advertencia: No uses GetUserName, usuario que inició la sesion en Windows, ya que seria dependiente del sistema operativo que usa el Cliente ;)

Lepe 05-10-2003 13:56:41
Ahora con la funcion de MarcosZorrilla ya queda mejor, y si encima se le añade la funcion esa qryPuesto... entonces no digamos :p

enga, hasta otra.

marcial 05-10-2003 14:19:30
Cita:
Posteado originalmente por Lepe
Ahora con la funcion de MarcosZorrilla ya queda mejor, y si encima se le añade la funcion esa qryPuesto... entonces no digamos :p

enga, hasta otra.


Muchisimas gracias a todos por vuestra ayuda.......ahora estoy encantado de boquear y desbloquar los registros sólo por ver ese tan deseado mensaje.........Gracias otra vez a todos

Marcial

Goyo 15-05-2007 23:04:52
Quisiera saber como enviar mensajes de error en campos obligatorios
 
Cita:
Empezado por marcoszorrilla
Prueba con este procedimiento que yo utilizo con las tablas Paradox y me va perfectamente:

Código:
Procedure midberror(DataSet: TDataSet; E: EDatabaseError);
 
…….
 
Const
  eKeyViol = 9729;
  eRequiredFieldMissing = 9732;
  eForeignKey = 9733;
  eDetailsExist = 9734;
  eSqlGralerror = 13059;
  eInvalidTime = 10058;
  eInvalidDate = 75; 
  EinvalidDateTime=10060;
  eRegisterLocked= 10241;
 
implementation
 
……
 
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;
 
//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;
Un Saludo.
Referente al este articulo, quisiera saber Marcoszorilla en donde empleas este procedimiento, tengo unas tablas en paradox y un modulo, donde tengo los datos obligatorios y la llave primaria en en la tabla Empleados.

de antamano gracias..

marcoszorrilla 16-05-2007 00:48:52
Debes de llamar al procedimiento indicado en el evento:

OnPostError del Ttable correspondiente.

Código Delphi [-]
procedure TDmPal.SociosPostError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
midberror(Socios,e);
end;

Un Saludo.

Goyo 16-05-2007 20:26:51
donde debo poner el codigo que indicas...
 
lo que me indicaste lo puse dentro del Modulo de Datos

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);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  DM: TDM;
implementation
{$R *.dfm}
 
procedure TDM.TbEmpleadosPostError(DataSet: TDataSet; E: EDatabaseError;
  var Action: TDataAction);
begin
 midberror(TbEmpleados,E);
end;
end.

me cree un archivo unit y lo grabe con el nombre de midberror y a su vez puse el llamado dentro del Modulo de Datos.

unit Modulo;
interface
uses
SysUtils, Classes, DB, DBTables, midberror;
y la verdad no se donde escribir el demas codigo (osea este) porque me marco errores... 
Código Delphi [-]
unit midberror;

Procedure midberror(DataSet: TDataSet; E: EDatabaseError);
Const
  eKeyViol = 9729;
  eRequiredFieldMissing = 9732;
  eForeignKey = 9733;
  eDetailsExist = 9734;
  eSqlGralerror = 13059;
  eInvalidTime = 10058;
  eInvalidDate = 75;   
  EinvalidDateTime=10060;
  eRegisterLocked= 10241;
 
implementation
 
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;
gracias de antemano....

marcoszorrilla 16-05-2007 22:41:44
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 17-05-2007 18:29:10
a ver si ahora si me puedo explicar... y mil disculpas
 
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 17-05-2007 19:40:13
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 17-05-2007 21:11:13
ya funciona, y me manda los mensajes requeridos
 
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....


La franja horaria es GMT +2. Ahora son las 07:10:45.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi