Criando usuário no Firebird

{
  Delfos Sistemas 2008
  www.delfosistemas.com
  suporte@delfosistemas.com

  Unit: DelfosUsuarios.pas
  Data: 28/04/2008
  Enio Rodrigo Marconcini <eniorm@gmail.com>
  www.Enio.Pro.Br

  Descrição: Manipulação de usuários do Firebird para aplicações Delfos
  Necessita: Mercury Data Objects - www.mdolib.com


  COMO USAR

  Adicione a unit ao seu projeto.


  Exemplo de uso:

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  Usuario : TDelfosUsuarios;
begin
  Usuario := TDelfosUsuarios.Create;
  Usuario.Connect; // conecta automaticamente em 127.0.0.1 com SYSDBA e masterkey
  // ou Usuario.Connect(´192.168.0.1´,´NomeUsuario´,´senha´);
  if (Usuario.Connected) then
    ShowMessage(Usuario.GetListUserNames.Text);
  FreeAndNil(Usuario); // ou Usuario.Free;
end;

}

unit DelfosUsuarios;

interface

uses 
  Classes, SysUtils, Forms, Controls, MDOServices;

const
  fbUsername = ´SYSDBA´;
  fbPassword = ´masterkey´;
  fbLocalHost = ´127.0.0.1´;

type
  TDelfosUsuarios = class
    protected
      Servico : TMDOSecurityService;
    public
      constructor Create;
      destructor Destroy; override;

      // conecta ao servidor, se omitir os parâmetros, usará as constantes default
      // returna true se nao ocorrer erro na conexão
      function Connect(Server : String = fbLocalHost; Username : String = fbUsername; Password : String = fbPassword) : Boolean;

      // retorna true caso estiver conectado
      function Connected : Boolean;

      // retorna um StringList com o nome dos usuários cadastrados no server
      function GetListUserNames : TStringList;

      // recebe como argumento um nome de usuário
      // retorna true caso esse usuário existir
      function UserExists(Username : String) : Boolean;

      // cria um usuário no server; o login e senha devem ser passados como argumento
      // retorna true caso seja criado com sucesso
      function CreateUser(Username, Password : String) : Boolean;

      // troca a senha do usuário; o argumento username indica o usuário
      // e o argumento password indica a nova senha
      // retorna true caso seja trocada a senha com sucesso
      function ChangePassword(Username, Password : String) : Boolean;

      // exclui o usuário cujo login é passado como argumento
      // retorna true caso for excluído com sucesso
      function DeleteUser(Username : String) : Boolean;

      // encerra a conexão com o banco; é usado no método Destroy, porém é
      // implementado como public, caso seja necessário desconectar de um server
      // e conectar noutro, ou como outro usuário.
      procedure Disconnect;
  end;

implementation

{ TDelfosUsuarios }

constructor TDelfosUsuarios.Create;
begin
  inherited Create;
  Servico := TMDOSecurityService.Create(Nil);
end;

destructor TDelfosUsuarios.Destroy;
begin
  Disconnect;
  FreeAndNil(Servico);
  inherited Destroy;
end;

function TDelfosUsuarios.Connect(Server : String = fbLocalHost; Username : String = fbUsername; Password : String = fbPassword) : Boolean;
begin
  Result := False;
  try
    Screen.Cursor := crSQLWait;
    if Assigned(Servico) and not Connected then
      try
        Servico.LoginPrompt := False;
        Servico.Params.Add(´user_name=´ + Username);
        Servico.Params.Add(´password=´ + Password);
        Servico.ServerName := Server;
        Servico.UserName := Username;
        Servico.Password := Password;
        Servico.Active := True;
        Result := True;
      except
        Result := False;
      end;
  finally
    Screen.Cursor := crDefault;
  end;
end;

function TDelfosUsuarios.Connected: Boolean;
begin
  Result := False;
  if Assigned(Servico) then
    Result := Servico.Active;
end;

procedure TDelfosUsuarios.Disconnect;
begin
  if Assigned(Servico) and Connected then
    Servico.Active := False;
end;

function TDelfosUsuarios.CreateUser(Username, Password: String): Boolean;
begin
  Result := False;
  if Assigned(Servico) and Connected and not UserExists(Username) then
    try
      Screen.Cursor := crSQLWait;
      try
        Servico.UserName := Username;
        Servico.Password := Password;
        Servico.AddUser;
        while Servico.IsServiceRunning do;
        Result := True;
      except
        Result := False;
      end;
    finally
      Screen.Cursor := crDefault;
    end;
end;

function TDelfosUsuarios.GetListUserNames: TStringList;
var
  I : SmallInt;
begin
  Result := Nil;
  if Assigned(Servico) and Connected then
    try
      Screen.Cursor := crSQLWait;
      Result := TStringList.Create;
      Servico.DisplayUsers;
      for I := 0 to Servico.UserInfoCount - 1 do
        Result.Add(Servico.UserInfo[I].UserName);
    finally
      Screen.Cursor := crDefault;
    end;
end;

function TDelfosUsuarios.UserExists(Username: String): Boolean;
begin
  Result := False;
  if Assigned(Servico) and Connected then
    try
      Screen.Cursor := crSQLWait;
      Servico.DisplayUser(Username);
      Result := Servico.UserInfoCount > 0;
    finally
      Screen.Cursor := crDefault;
    end;   
end;

function TDelfosUsuarios.ChangePassword(Username, Password: String): Boolean;
begin
  Result := False;
  if Assigned(Servico) and Connected and UserExists(Username) then
    try
      Screen.Cursor := crSQLWait;
      try
        Servico.UserName := Username;
        Servico.Password := Password;
        Servico.ModifyUser;
        while Servico.IsServiceRunning do;
        Result := True;
      except
        Result := False;
      end;
    finally
      Screen.Cursor := crDefault;
    end;
end;

function TDelfosUsuarios.DeleteUser(Username: String): Boolean;
begin
  Result := False;
  if Assigned(Servico) and Connected and UserExists(Username) then
    try
      Screen.Cursor := crSQLWait;
      try
        Servico.UserName := Username;
        Servico.DeleteUser;
        while Servico.IsServiceRunning do;
        Result := True;
      except
        Result := False;
      end;
    finally
      Screen.Cursor := crDefault;
    end;
end;

end.