Delphiその15

　おはようございます、童爺です。

　今回はトリを務めます、会員管理画面とパスワード変更ダイアログボックスです。

　それではまず、会員管理画面から。

　管理者でログインすると以下の画面になります。

　管理者でもIDとユーザ名の変更及び退会は出来ない様になっています。

　次にナビゲータで一般ユーザに移ると以下の様にIDやユーザ名の変更及び退会が出来る様になります。

　また、パスワード変更ボタンをクリックすると以下のダイアログボックスが表示されます。

　では、まずは会員管理画面の設計画面です。

　次に、パスワード変更画面の設計画面です。

　以下に、会員管理画面のコードを記述します。

unit UserManagement;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf,
  FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async,
  FireDAC.Phys, FireDAC.Phys.SQLite, FireDAC.Phys.SQLiteDef,
  FireDAC.Stan.ExprFuncs, FireDAC.FMXUI.Wait, FireDAC.Stan.Param, FireDAC.DatS,
  FireDAC.DApt.Intf, FireDAC.DApt, System.Rtti, FMX.Grid.Style, Fmx.Bind.Grid,
  System.Bindings.Outputs, Fmx.Bind.Editors, Data.Bind.Controls,
  Data.Bind.EngExt, Fmx.Bind.DBEngExt, FMX.StdCtrls, Data.Bind.Components,
  Fmx.Bind.Navigator, Data.Bind.Grid, FMX.ScrollBox, FMX.Grid,
  Data.Bind.DBScope, Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client,
  FMX.Controls.Presentation, FMX.Layouts, FMX.ListBox, FMX.DateTimeCtrls,
  FMX.Edit;

type
  TForm_UserMng = class(TForm)
    Layout_Header: TLayout;
    Label_Cation: TLabel;
    Layout_Footer: TLayout;
    FDConnection_Mng: TFDConnection;
    Button_Close: TButton;
    Layout_Navi: TLayout;
    Layout_button: TLayout;
    Button_Delete: TButton;
    Layout_ID: TLayout;
    Label_ID: TLabel;
    Edit_ID: TEdit;
    Layout_UserName: TLayout;
    Label_UserName: TLabel;
    Edit_UserName: TEdit;
    Layout_LastName: TLayout;
    Label_LastName: TLabel;
    Edit_LastName: TEdit;
    Layout_FirstName: TLayout;
    Label_FirstName: TLabel;
    Edit_FirstName: TEdit;
    Layout_Password: TLayout;
    Label_Password: TLabel;
    Layout_Birthday: TLayout;
    Label_Birthday: TLabel;
    DateEdit_Birthday: TDateEdit;
    BindNavigator_Mng: TBindNavigator;
    Layout_Ken: TLayout;
    Label_Ken: TLabel;
    ComboBox_Ken: TComboBox;
    BindingsList_Ken: TBindingsList;
    LinkFillControlToField1: TLinkFillControlToField;
    BindSourceken: TBindSourceDB;
    FDTableken: TFDTable;
    Button_Password: TButton;
    FDTable_member: TFDTable;
    BindSourceDB_member: TBindSourceDB;
    LinkControlToField1: TLinkControlToField;
    LinkControlToField2: TLinkControlToField;
    LinkControlToField3: TLinkControlToField;
    LinkControlToField4: TLinkControlToField;
    LinkPropertyToFieldText: TLinkPropertyToField;
    Button_Append: TButton;
    procedure Button_CloseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button_AppendClick(Sender: TObject);
    procedure Button_PasswordClick(Sender: TObject);
    procedure FDTable_memberAfterScroll(DataSet: TDataSet);
    procedure ComboBox_KenChange(Sender: TObject);
    procedure Button_DeleteClick(Sender: TObject);
  private
    { private 宣言 }
  public
    { public 宣言 }
    UserID: Integer;
    First_run_Flag: Boolean;
    constructor Create(AOwner: TComponent; const Id: Integer); reintroduce;
  end;

var
  Form_UserMng: TForm_UserMng;

implementation

{$R *.fmx}

uses
  MMS_CommonDialog,
  NewUserAppend,
  UserPasswordChange;

constructor TForm_UserMng.Create(AOwner: TComponent; const Id: Integer);
begin
  inherited Create(AOwner);
  UserID := id;
  First_run_flag := True;
end;

procedure TForm_UserMng.Button_CloseClick(Sender: TObject);
begin
  Close;
end;

procedure TForm_UserMng.Button_DeleteClick(Sender: TObject);
begin
  FDTable_member.Delete;
end;

procedure TForm_UserMng.Button_PasswordClick(Sender: TObject);
var
  User_PasswordChg: TForm_PasswordChg;
begin
  USer_PasswordChg := TForm_PasswordChg.Create(self, FDTable_member.FieldByName('id').AsInteger, FDTable_member.FieldByName('password').AsString);
  User_PasswordChg.ShowModal;
  FDTable_member.Refresh;
end;

procedure TForm_UserMng.Button_AppendClick(Sender: TObject);
begin
  Form_NewUserAppend := TForm_NewUserAppend.Create(self);
  Form_NewUserAppend.ShowModal;
  FDTable_member.Refresh;
end;

procedure TForm_UserMng.ComboBox_KenChange(Sender: TObject);
begin
  FDTable_member.Edit;
  FDTable_member.FieldByName('ken').AsInteger := ComboBox_Ken.ItemIndex + 1;
end;

procedure TForm_UserMng.FDTable_memberAfterScroll(DataSet: TDataSet);
var
  id: Integer;
  username: String;
begin
  if First_run_Flag then
  begin
    while FDTable_member.FieldByName('id').AsInteger <> UserID do
    begin
      FDTable_member.Next;
    end;
    First_run_Flag := False;
  end;

  id := DataSet.FieldByName('id').AsInteger;
  username := DataSet.FieldByName('username').AsString;

  if ((id = 1) and (username = 'administrator')) or
     ((id = 2) and (username = 'admin')) or
     ((id = 3) and (username = 'root')) then
  begin
    Edit_ID.Enabled := False;
    Edit_UserName.Enabled := False;
    Button_Delete.Enabled := False;
  end
  else
  begin
    Edit_ID.Enabled := True;
    Edit_UserName.Enabled := True;
    Button_Delete.Enabled := True;
  end;

  ComboBox_Ken.OnChange := nil;
  ComboBox_Ken.ItemIndex := DataSet.FieldByName('ken').AsInteger - 1;
  ComboBox_Ken.OnChange := ComboBox_KenChange;
end;

procedure TForm_UserMng.FormCreate(Sender: TObject);
begin
  FDConnection_Mng.Open();
  FDTableken.Open();
  FDTable_member.Open();
end;

procedure TForm_UserMng.FormDestroy(Sender: TObject);
begin
  FDTable_member.Close;
  FDTableken.Close;
  FDConnection_Mng.Close;
end;

end.

　次に、パスワード変更ダイアログボックスのコードです。

unit UserPasswordChange;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Edit,
  FMX.StdCtrls, FMX.Controls.Presentation, FMX.Layouts, FireDAC.Stan.Intf,
  FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf,
  FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys,
  FireDAC.Phys.SQLite, FireDAC.Phys.SQLiteDef, FireDAC.Stan.ExprFuncs,
  FireDAC.FMXUI.Wait, Data.DB, FireDAC.Comp.Client, FireDAC.Stan.Param,
  FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, FireDAC.Comp.DataSet;

type
  TForm_PasswordChg = class(TForm)
    Layout_Header: TLayout;
    Label_Cation: TLabel;
    Layout_Footer: TLayout;
    Layout_BtnFooter: TLayout;
    Button_Update: TButton;
    Button_Cancel: TButton;
    Layout_NowPassword: TLayout;
    Label_NowPassword: TLabel;
    Edit_NowPassword: TEdit;
    Layout_NewPassword: TLayout;
    Label_NewPassword: TLabel;
    Edit_NewPassword: TEdit;
    Layout_ReNewPassword: TLayout;
    Label_ReNewPassword: TLabel;
    Edit_ReNewPassword: TEdit;
    FDConnection_PasswordChg: TFDConnection;
    FDQuery_Password: TFDQuery;
    procedure Button_UpdateClick(Sender: TObject);
    procedure Button_CancelClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private 宣言 }
    UserID: Integer;
    UserPassword: String;
  public
    { public 宣言 }
    constructor Create(AOwner: TComponent; const id: integer; const Password: String); reintroduce;
  end;

var
  Form_PasswordChg: TForm_PasswordChg;

implementation

{$R *.fmx}

uses
  System.Hash,
  MMS_CommonDialog;

constructor TForm_PasswordChg.Create(AOwner: TComponent; const id: integer; const Password: String);
begin
  inherited Create(AOwner);
  UserID := id;
  UserPassword := password;
end;


procedure TForm_PasswordChg.FormCreate(Sender: TObject);
begin
  FDConnection_PasswordChg.Open();
end;

procedure TForm_PasswordChg.FormDestroy(Sender: TObject);
begin
  FDConnection_PasswordChg.Close;
end;

procedure TForm_PasswordChg.Button_CancelClick(Sender: TObject);
begin
  Close;
end;

procedure TForm_PasswordChg.Button_UpdateClick(Sender: TObject);
var
  MsgDlg: TForm_MsgDlg;
  MD5: THashMD5;
  Password: String;
begin
  MD5 := THashMD5.Create;
  MD5.Update(Edit_NowPassword.Text);
  Password := MD5.HashAsString;
  if Password <> UserPassword then
  begin
    MsgDlg := TForm_MsgDlg.Create(self, '現在のパスワードが違います。');
    MsgDlg.ShowModal;
    exit;
  end;
  if Edit_NewPassword.Text = '' then
  begin
    MsgDlg := TForm_MsgDlg.Create(self, '新しいパスワードを入力してください。');
    MsgDlg.ShowModal;
    exit;
  end;
  if Edit_ReNewPassword.Text = '' then
  begin
    MsgDlg := TForm_MsgDlg.Create(self, '新しいパスワード再入力を入力してください。');
    MsgDlg.ShowModal;
    exit;
  end;
  if Edit_NewPassword.Text <> Edit_ReNewPassword.Text then
  begin
    MsgDlg := TForm_MsgDlg.Create(self, '新しいパスワードが一致しません。');
    MsgDlg.ShowModal;
    exit;
  end;
  MD5.Reset;
  MD5.Update(Edit_NewPassword.Text);
  FDQuery_Password.ParamByName('Input_password').AsString := MD5.HashAsString;

  FDQuery_Password.ParamByName('Input_id').AsInteger := UserID;

  try
    try
      MD5.Reset;
      MD5.Update(Edit_NewPassword.Text);
      FDQuery_Password.ParamByName('Input_password').AsString := MD5.HashAsString;

      FDQuery_Password.ParamByName('Input_id').AsInteger := UserID;

      FDQuery_Password.ExecSQL;
    except
      on e: Exception do
      begin
        FDQuery_Password.Close;
        MsgDlg := TForm_MsgDlg.Create(self, 'Error:' + e.Message);
        MsgDlg.ShowModal;
        raise;
      end;
    end;
  finally
    FDQuery_Password.Close;
  end;
  Close;
end;

end.

　結構変な処理をやっていると思いますが、それぞれちゃんと意味があるので・・・。

　説明は、希望があればします。（ヾ(ﾟДﾟ )ｫｨｫｨ

　ちなみにこれまで紹介してきた画面やダイアログボックスは全て幅が375に統一してあります。

　これは、スマートフォンで表示した際に画面が収まる様に配慮した結果です。

　あと、新規ボタンをクリックした場合は、前回のDelphiその14で説明した新規ユーザ作成画面を呼んでいます。

　恒例ですが、「ここが違う」とか「もっといいやり方がある」と言う方は、コメントなりTwitterに投稿して頂けると有り難いです。

　どんな些細な事でも構いません。（疑問点でもOK）

　出来る限り対応していきたいと思います。

---

　それではまた。

　でわでわ。