Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Conexión con bases de datos
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Conexión con bases de datos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 30-09-2003
marcial marcial is offline
Miembro
 
Registrado: may 2003
Posts: 147
Poder: 22
marcial Va por buen camino
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
Responder Con Cita
  #2  
Antiguo 30-09-2003
Ruben_Cu Ruben_Cu is offline
No confirmado
 
Registrado: oct 2003
Ubicación: Mariel, Cuba
Posts: 271
Poder: 0
Ruben_Cu Va por buen camino
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
Responder Con Cita
  #3  
Antiguo 30-09-2003
marcial marcial is offline
Miembro
 
Registrado: may 2003
Posts: 147
Poder: 22
marcial Va por buen camino
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,
Responder Con Cita
  #4  
Antiguo 01-10-2003
Avatar de marcoszorrilla
marcoszorrilla marcoszorrilla is offline
Capo
 
Registrado: may 2003
Ubicación: Cantabria - España
Posts: 11.221
Poder: 10
marcoszorrilla Va por buen camino
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.
__________________
Guía de Estilo de los Foros
Cita:
- Ça c'est la caisse. Le mouton que tu veux est dedans.
Responder Con Cita
  #5  
Antiguo 01-10-2003
Avatar de marcoszorrilla
marcoszorrilla marcoszorrilla is offline
Capo
 
Registrado: may 2003
Ubicación: Cantabria - España
Posts: 11.221
Poder: 10
marcoszorrilla Va por buen camino
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.
__________________
Guía de Estilo de los Foros
Cita:
- Ça c'est la caisse. Le mouton que tu veux est dedans.

Última edición por marcoszorrilla fecha: 01-10-2003 a las 00:55:46.
Responder Con Cita
  #6  
Antiguo 03-10-2003
marcial marcial is offline
Miembro
 
Registrado: may 2003
Posts: 147
Poder: 22
marcial Va por buen camino
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
Responder Con Cita
  #7  
Antiguo 03-10-2003
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
 
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Poder: 23
José Luis Garcí Va camino a la fama
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.

Última edición por José Luis Garcí fecha: 03-10-2003 a las 16:23:55.
Responder Con Cita
  #8  
Antiguo 03-10-2003
marcial marcial is offline
Miembro
 
Registrado: may 2003
Posts: 147
Poder: 22
marcial Va por buen camino
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
Responder Con Cita
  #9  
Antiguo 04-10-2003
Avatar de Lepe
[Lepe] Lepe is offline
Miembro Premium
 
Registrado: may 2003
Posts: 7.424
Poder: 29
Lepe Va por buen camino
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
Responder Con Cita
  #10  
Antiguo 05-10-2003
Avatar de Lepe
[Lepe] Lepe is offline
Miembro Premium
 
Registrado: may 2003
Posts: 7.424
Poder: 29
Lepe Va por buen camino
Ahora con la funcion de MarcosZorrilla ya queda mejor, y si encima se le añade la funcion esa qryPuesto... entonces no digamos

enga, hasta otra.
Responder Con Cita
  #11  
Antiguo 05-10-2003
marcial marcial is offline
Miembro
 
Registrado: may 2003
Posts: 147
Poder: 22
marcial Va por buen camino
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

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
Responder Con Cita
  #12  
Antiguo 16-05-2007
Avatar de Goyo
Goyo Goyo is offline
Miembro
 
Registrado: feb 2006
Posts: 89
Poder: 19
Goyo Va por buen camino
Red face 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..
Responder Con Cita
  #13  
Antiguo 16-05-2007
Avatar de marcoszorrilla
marcoszorrilla marcoszorrilla is offline
Capo
 
Registrado: may 2003
Ubicación: Cantabria - España
Posts: 11.221
Poder: 10
marcoszorrilla Va por buen camino
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.
__________________
Guía de Estilo de los Foros
Cita:
- Ça c'est la caisse. Le mouton que tu veux est dedans.
Responder Con Cita
  #14  
Antiguo 16-05-2007
Avatar de Goyo
Goyo Goyo is offline
Miembro
 
Registrado: feb 2006
Posts: 89
Poder: 19
Goyo Va por buen camino
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....
Responder Con Cita
  #15  
Antiguo 16-05-2007
Avatar de marcoszorrilla
marcoszorrilla marcoszorrilla is offline
Capo
 
Registrado: may 2003
Ubicación: Cantabria - España
Posts: 11.221
Poder: 10
marcoszorrilla Va por buen camino
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.
__________________
Guía de Estilo de los Foros
Cita:
- Ça c'est la caisse. Le mouton que tu veux est dedans.
Responder Con Cita
  #16  
Antiguo 17-05-2007
Avatar de Goyo
Goyo Goyo is offline
Miembro
 
Registrado: feb 2006
Posts: 89
Poder: 19
Goyo Va por buen camino
Unhappy 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

Última edición por Goyo fecha: 17-05-2007 a las 20:47:44.
Responder Con Cita
  #17  
Antiguo 17-05-2007
Avatar de marcoszorrilla
marcoszorrilla marcoszorrilla is offline
Capo
 
Registrado: may 2003
Ubicación: Cantabria - España
Posts: 11.221
Poder: 10
marcoszorrilla Va por buen camino
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.
__________________
Guía de Estilo de los Foros
Cita:
- Ça c'est la caisse. Le mouton que tu veux est dedans.
Responder Con Cita
  #18  
Antiguo 17-05-2007
Avatar de Goyo
Goyo Goyo is offline
Miembro
 
Registrado: feb 2006
Posts: 89
Poder: 19
Goyo Va por buen camino
Thumbs up 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....
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 01:27:37.


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
Copyright 1996-2007 Club Delphi