Estoy haciendo un programa en Lazarus, este tiene guarda en una tabla de una base de datos firebird el nombre de usuario y contraseña. Necestito ahce una modificación para que más de un usuario pueda usar el programa.
El acceso a la base de datos es a través de componentes mercury (son muy parecidos a ibx pero están disponibles para Lazarus también, bajo windows y Linux)
Pongo el código del formulario Login y del formulario Usuarios que permite para modificar, ingresar nuevos, borrar usuarios
delphi
unit Ulogin; {$MODE Delphi} interface uses LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TFrmLogin = class(TForm) Button1: TButton; Button2: TButton; Label1: TLabel; Edit1: TEdit; Label2: TLabel; Edit2: TEdit; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure FormShow(Sender: TObject); private { Private declarations } public { Public declarations } end; var FrmLogin: TFrmLogin; tentativas:integer; implementation uses uDM, UPrincipal; {$R *.lfm} procedure TFrmLogin.Button1Click(Sender: TObject); begin if (dm.tblUsuario.Locate('USU_NOMBRE',edit1.Text,[])) and (dm.tblUsuario.FieldByName('USU_PASS').AsString = Edit2.Text) then begin FrmPrincipal.ShowModal; FrmLogin.Close; end else begin tentativas := tentativas + 1; if tentativas > 3 then Application.Terminate; ShowMessage('¡Login o contraseña erróneos, ingrese nuevamente!'); Edit1.Clear; Edit2.Clear; Edit1.SetFocus; end; end; procedure TFrmLogin.Button2Click(Sender: TObject); begin application.Terminate; end; procedure TFrmLogin.FormShow(Sender: TObject); begin edit1.SetFocus; end; end.
delphi
unit UUsuario; {$MODE Delphi} interface uses LCLintf, LCLType, LMessages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, DB, MaskEdit, DBCtrls, Grids, DBGrids; type TFrmUsuario = class(TForm) btnModificar: TButton; btnBuscar: TButton; btnEliminar: TButton; btnRegistrar: TButton; btAceptar: TButton; btnCancelar: TButton; Label4: TLabel; DBEdit1: TDBEdit; DataSource2: TDataSource; Label5: TLabel; DBEdit2: TDBEdit; Label1: TLabel; Edit1: TEdit; DBGrid1: TDBGrid; btnSalir: TButton; procedure btnModificarClick(Sender: TObject); procedure btnRegistrarClick(Sender: TObject); procedure btnEliminarClick(Sender: TObject); procedure btAceptarClick(Sender: TObject); procedure btnCancelarClick(Sender: TObject); procedure btnSalirClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var FrmUsuario: TFrmUsuario; implementation uses uDM, UPrincipal; {$R *.lfm} procedure TFrmUsuario.btnModificarClick(Sender: TObject); begin DM.TblUsuario.Edit; Application.MessageBox('Usuario registrado con éxito...','Software',MB_ICONINFORMATION); end; procedure TFrmUsuario.btnRegistrarClick(Sender: TObject); begin dm.tblUsuario.Append; dbedit1.SetFocus; end; procedure TFrmUsuario.btnEliminarClick(Sender: TObject); begin if MessageDlg('¿Está seguro que quiere eliminar este registro?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin dm.tblUsuario.Delete; end else begin dm.tblUsuario.Cancel; end; end; procedure TFrmUsuario.btAceptarClick(Sender: TObject); begin DM.dbSG.Open; DM.TblUsuario.Active:=True; if (DBedit2.Text=edit1.Text) then begin dm.tblUsuario.Post; end else begin ShowMessage('Su contraseña no coincide'); dbedit2.SetFocus; end; DM.TblUsuario.Refresh; DM.TblUsuario.Close; DM.dbSG.Close; DM.TblUsuario.Active:=False end; procedure TFrmUsuario.btnCancelarClick(Sender: TObject); begin dm.tblUsuario.Cancel; end; procedure TFrmUsuario.btnSalirClick(Sender: TObject); begin FrmPrincipal.show; end; end.
Esto anda para un usuario y tiene errores, si alguien tiene unos minutos y puede echarle un vistazo le quedaré agradecido y lo invitaré con una cerveza virtual
La tabla de la base de datos tiene dos campos
USU_NOMBRE
y
USU_PASS
Saludos