Listar Roles y asignar Roles

[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 Noteví]

[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.