Listar Roles y asignar Roles

[santiago14]

Buenas, estoy tratando de Listar los Roles que tengo en una BBDD.
También quiero poder tener una lista de usuarios y asociarlos con los roles que yo quiera.

Estoy usando FireDAC y Delphi XE5.
La idea es bastante simple:un formulario, dos grillas (Usuarios y Roles), seleccionar un registro de cada lado y con un click hacer la asociación. Al final, me tendría que decir con un cartelito que lo hice de manera exitosa.

Estoy usando TFDIBSecurity de FireDAC para las operaciones con los usuarios. Ya he logrado listarlos, agregarlos, modificarlos y eliminarlos. No puedo hacer lo mismo con los Roles de mi BBDD.

¿Cómo se hace esto? ¿Necesito otro componente de FireDAC o es con ese mismo?

Bueno, espero haber sido claro.

Gracias.

[Casimiro Notevi]

¿Qué base de datos?

[jhonny]

¡Caramba!, por mi parte no encontré esta opción en el FDIBSecurity, ni otro componente que ayude con esto...

Sin embargo y aunque no has especificado la base de datos que usas, supongo que ha de ser Interbase o FireBird, ya que el componente que mencionas funciona con estos 2 motores...

Si fuese Firebird por ejemplo, utilizaría las tablas del sistemas... esta simple consulta te devolvería el listado de los roles asociados para una base de datos y podrías hacer con dicho listado lo que comentas, asociando posteriormente el nombre del ROL a la propiedad ARoleName del componente que estás usando.

Código SQL [-]
select RDB$ROLE_NAME, RDB$DESCRIPTION from
RDB$ROLES

[Casimiro Notevi]

Empezado por jhonny

¡... aunque no has especificado la base de datos que usas, supongo que ha de ser Interbase o FireBird ...

Seguro que es firebird, porque nos conocemos, pero los demás no lo saben

[santiago14]

Jajajajja, Sí, perdón.
Es Firebird 2.5

[ecfisa]

Hola.

Coincido con jhonny en el modo de obtener el listado y en no conocer un componente que maneje roles.

Debe haber mas material pero ahora recuerdo este: GRANT desde Delphi, no creo que las cosas difieran mucho en FireDAC, tal vez puedas sacar algo de provecho.

Saludos

[santiago14]

Bueno, después de luchar y luchar contra la corriente logré hacerlo.
Una ventana donde puedo dar de alta, baja y modificar los datos del Usuario. Desde Delphi.
Otra ventana donde puedo asignar los Roles a esos Usuarios, y quitarlos si es necesario.

Pongo a disposición el código, y una imagen (si se me permite) que grafica lo que digo. Mil gracias a todos los que ayudaron con sus comentarios y aportes.

Código Delphi [-]
//Los procedures necesarios para hacer las cosas
procedure Roles(qryRoles:TFDQuery);
begin
  with qryRoles do
  begin
    Close;
    sql.Clear;
    sql.Add('Select r.rdb$role_name ');
    sql.Add('From rdb$roles r');
    try
      Open();
    except
      raise;
    end;
  end;
end;

procedure UsuariosxRoles(qryUsuariosxRoles:TFDQuery);
begin
  with qryUsuariosxRoles do
  begin
    close;
    sql.clear;
    sql.add('Select r.rdb$user, r.RDB$RELATION_NAME as grupos ');
    sql.Add('From RDB$USER_PRIVILEGES r ');
    sql.Add('Where r.RDB$PRIVILEGE = ''M'' ');
    sql.Add('Order by 1 asc, 2 asc ');
    try
      //messagedlg(consulta.sql.text,mtinformation,[mbok],0);
      Open;
    except
      raise;
    end; //del try
  end; //del with
end;

procedure PermitirRol(usuario:string; rol:string; grantOption:boolean;
  qRoles:TFDQuery);
{Para usuarios de cualquier grupo, si es altagerencia tiene el admin option}
var
  sentencia:string;
begin
  sentencia := 'Grant ' + rol + ' to ' + usuario;
  if grantOption then
    sentencia := sentencia + ' with admin option';
  with qRoles do
  begin
    close;
    sql.Clear;
    sql.add(sentencia);
    try
      ExecSQL;
    except
      raise;
    end;
  end; //del with
end;

procedure QuitarRol(usuario:string; rol:string; qRoles:TFDQuery);
var
  sentencia:string;
begin
  sentencia := 'Revoke ' + rol + ' from ' + usuario;
  with qRoles do
  begin
    close;
    sql.Clear;
    sql.add(sentencia);
    try
      ExecSQL;
    except
      raise;
    end;
  end; //del with
end;


//El Form
procedure TfrmRolesxUsuarios.btnGrantedClick(Sender: TObject);
var
  NombreUsuario, NombreRol:string;
begin
  if (memUsuarios.RecNo > 0) and (grdRoles.SelectedRow >= 0)
    and (IDYES = Application.MessageBox('¿Confirma nueva Relación?.',
      PWideChar(Self.Caption), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2)) then
  begin
    NombreUsuario:=memUsuarios.FieldByName('UserName').AsString;
    NombreRol:=grdRoles.CellByName['clRoles', grdRoles.SelectedRow].AsString;
    with DataModule1 do
    begin
      terminarTransaccion;
      transaccion.StartTransaction;
      try
        PermitirRol(NombreUsuario, NombreRol, False, qRoles);
      //Los usuarios x roles
        UsuariosxRoles(qRoles);
        transaccion.CommitRetaining;
        LimpiarNextGrid(grdUsuariosxRoles);
        CargarNextGrid(grdUsuariosxRoles, qRoles);
        transaccion.Commit;
      except
        on e:Exception do
        begin
          terminarTransaccion;
          mErrores(e, 'Operación solicitada falló...', self.Caption);
        end;
      end;
    end;
  end
  else
  begin
    Application.MessageBox('Debe seleccionar un Usuario y un Rol',
      PWideChar(self.Caption), MB_OK + MB_ICONERROR);
  end;
end;

procedure TfrmRolesxUsuarios.btnRevokeClick(Sender: TObject);
var
  NombreUsuario, NombreRol:string;
begin
  if (grdUsuariosxRoles.SelectedRow >= 0)
    and (IDYES = Application.MessageBox('¿Confirma eliminación de la Relación?.'
      + #13#10 + 'Esta operación no podrá deshacerse.',
      PWideChar(Self.Caption), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2)) then
  begin
    NombreUsuario:=grdUsuariosxRoles.CellByName['clUsuarioRxU', grdUsuariosxRoles.SelectedRow].AsString;
    NombreRol:=grdUsuariosxRoles.CellByName['clRolRxU', grdUsuariosxRoles.SelectedRow].AsString;
    with DataModule1 do
    begin
      terminarTransaccion;
      transaccion.StartTransaction;
      try
        QuitarRol(NombreUsuario, NombreRol, qRoles);
      //Los usuarios x roles
        UsuariosxRoles(qRoles);
        transaccion.CommitRetaining;
        LimpiarNextGrid(grdUsuariosxRoles);
        CargarNextGrid(grdUsuariosxRoles, qRoles);
        transaccion.Commit;
      except
        on e:Exception do
        begin
          terminarTransaccion;
          mErrores(e, 'Operación solicitada falló...', self.Caption);
        end;
      end;
    end;
  end
  else
  begin
    Application.MessageBox('Debe seleccionar un registro de la grilla (Usuario x Rol)',
      PWideChar(self.Caption), MB_OK + MB_ICONERROR);
  end;
end;

procedure TfrmRolesxUsuarios.btnSalirClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmRolesxUsuarios.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;

procedure TfrmRolesxUsuarios.Usuarios(SecurityServices:TFDIBSecurity);
begin
  //grupo:=AnsiupperCase(trim(txtGrupo.Text));
  with memUsuarios do
  begin
  //Los filtros de búsqueda
    Filtered := False;
    Filter := 'UserName <> ' + QuotedStr('SYSDBA');
      //+ 'AND UserName LIKE ' + QuotedStr('%' + nombre + '%');
    Filtered := True;
    try
      SecurityServices.DisplayUsers;
      memUsuarios.AttachTable(SecurityServices.Users, nil);
      memUsuarios.Open;
//      grdUsuarios.Columns[1].Visible:=False; //Password
//      grdUsuarios.Columns[2].Visible:=False; //FirstName
//      grdUsuarios.Columns[3].Visible:=False; //MiddleName
//      grdUsuarios.Columns[4].Visible:=False; //LastName
//      grdUsuarios.Columns[5].Visible:=False; //UserID
//      grdUsuarios.Columns[6].Visible:=False; //GroupID
//      grdUsuarios.Columns[7].Visible:=False; //GroupName
//      grdUsuarios.Columns[8].Visible:=False; //RoleName
    except
      raise;
    end;
  end;
end;

procedure TfrmRolesxUsuarios.FormShow(Sender: TObject);
begin
  with DataModule1 do
  begin
    terminarTransaccion;
    transaccion.StartTransaction;
    try
    //Los usuarios
      Usuarios(security_services);
    //Los roles
      Roles(qRoles);
      LimpiarNextGrid(grdRoles);
      CargarNextGrid(grdRoles, qRoles);
    //Los usuarios x roles
      UsuariosxRoles(qRoles);
      LimpiarNextGrid(grdUsuariosxRoles);
      CargarNextGrid(grdUsuariosxRoles, qRoles);
      transaccion.Commit;
    except
      on e:Exception do
      begin
        terminarTransaccion;
        mErrores(e, 'No se pudieron recuperar los Usuarios.', 'Gestión de Usuarios.');
      end;
    end;
  end;
end;

Herramientas:

DelphiXE5
Firebird 2.5
FireDAC

Mañana agrego un Post con la gestión ABM de los usuarios.
Gracias de nuevo.

[Casimiro Notevi]

[santiago14]

Buen día. Termino la cuestión...

Código Delphi [-]
procedure TfrmABMAgentes.btnElimUsuarioClick(Sender: TObject);
var
  MiUsuario:string;
begin
  //showmessage(IntToSTr(tblUsuarios.RecNo));
  with DataModule1 do
  begin
  //Eliminación del usuario
    if tblUsuarios.RecNo > 0 then
    begin
      MiUsuario:=tblUsuarios.FieldByName('UserName').AsString;
      //showmessage(MiUsuario);
      if idYes = Application.MessageBox(PWideChar('¿Confirma eliminación de Usuario?'
        + #13#10 + 'Esta operación NO PODRÁ DESHACERSE.'
        + #13#10 + 'Usuario: ' + MiUsuario), 'Gestión de usuarios,',
        MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) then
      begin
        terminarTransaccion;
        transaccion.StartTransaction;
        try
        //Si es vendedor, la desactivamos
          CambiarEstadoVendedor(MiUsuario, 'INACTIVO', qUsuarios);
        //Eliminamos el usuario de la BD.
          security_services.AUserName:=MiUsuario;
          security_services.DeleteUser;
          transaccion.Commit;
          Application.MessageBox('Eliminación de usuario terminada.',
            PWideChar(self.Caption), MB_OK + MB_ICONINFORMATION);
          tblUsuarios.Refresh;
        except
          on e:Exception do
          begin
            terminarTransaccion;
            mErrores(e, 'Imposible eliminar usuario seleccionado.', self.Caption);
          end;
        end;
      end; //del segundo if
    end
    else
    begin
      Application.MessageBox('Debe seleccionar un Usuario,',
        PWideChar(self.Caption), MB_OK + MB_ICONERROR);
    end;
  end; //del with
end;

procedure TfrmABMAgentes.btnNuevoUsuarioClick(Sender: TObject);
begin
  ventana_modal(TfrmNuevoUsuario);
end;

procedure TfrmABMAgentes.btnBuscarUsuariosClick(Sender: TObject);
var
  nombre,
  grupo: string;
begin
  nombre:=AnsiupperCase(trim(txtUsuario.Text));
  //grupo:=AnsiupperCase(trim(txtGrupo.Text));
  with tblUsuarios, DataModule1 do
  begin
  //Los filtros de búsqueda
    Filtered := False;
    Filter := 'UserName <> ' + QuotedStr('SYSDBA')
      + 'AND UserName LIKE ' + QuotedStr('%' + nombre + '%');
    Filtered := True;
    terminarTransaccion;
    transaccion.StartTransaction;
    try
      security_services.DisplayUsers;
      tblUsuarios.AttachTable(security_services.Users, nil);
      tblUsuarios.Open;
      grdUsuarios.Columns[1].Visible:=False; //Password
      grdUsuarios.Columns[5].Visible:=False; //UserID
      grdUsuarios.Columns[6].Visible:=False; //GroupID
      grdUsuarios.Columns[7].Visible:=False; //GroupName
      grdUsuarios.Columns[8].Visible:=False; //RoleName
      transaccion.Commit;
    except
      on e:Exception do
      begin
        terminarTransaccion;
        mErrores(e, 'No se pudieron recuperar los Usuarios.', 'Gestión de Usuarios.');
      end;
    end;
  end;
end;

procedure TfrmABMAgentes.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;


procedure TfrmABMAgentes.BtnSalirClick(Sender: TObject);
begin
  Close;
end;

Es bastante simple.
Una pequeña contribución con este Foro que siempre me ha sacado de mas de un incendio.

Gracias.

[santiago14]

Buenas de nuevo
Les cuento.
Hice una modificación de los datos de un Usuario, puse en su MiddleName la palabra "Ramón" y me dio un error. Al poner "Ramon" (Nótese la falta del acento), pasó sin drama.
Cuando ponemos texto con caracteres "extraños" (acentos y demás) no pasa; pero cuando van sin ellos, no tiene drama.

¿Comentarios? Gracias.