⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 loginfrm.pas

📁 这是一个本人初定的小制作
💻 PAS
字号:
unit LoginFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MainDM, CommonFunc, uConfigMgr;

type
  TFormLogin = class(TForm)
    EdtPassword: TEdit;
    BtnOK: TButton;
    Label1: TLabel;
    Label2: TLabel;
    BtnCancel: TButton;
    EdtUserName: TEdit;
    Label3: TLabel;
    EdtServerName: TEdit;
    Label4: TLabel;
    EdtDatabase: TEdit;
    BtnAdvance: TButton;
    procedure BtnOKClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BtnCancelClick(Sender: TObject);
    procedure EdtPasswordKeyPress(Sender: TObject; var Key: Char);
    procedure BtnAdvanceClick(Sender: TObject);
    procedure EdtServerNameChange(Sender: TObject);
  private
    { Private declarations }
    FIsLegal: boolean;
    FUserName: string;
    FUserRealName: string;
    FUserPermission: string;
    FIsConnectChange: boolean;
  public
    { Public declarations }
    function IsLegal: boolean;
    function GetUserName: string;
    function GetUserRealName: string;
    function GetUserPermission: string;
  end;

var
  FormLogin: TFormLogin;

implementation

{$R *.dfm}

function TFormLogin.IsLegal: boolean;
begin
  result := FIsLegal;//to do
end;

function TFormLogin.GetUserName: string;
begin
  result := FUserName;
end;

function TFormLogin.GetUserRealName: string;
begin
  result := FUserRealName;
end;

function TFormLogin.GetUserPermission: string;
begin
  result := FUserPermission;
end;


procedure TFormLogin.BtnOKClick(Sender: TObject);
var
  LUserName, LInputPsw, LRealPsw: string;
  LServerName, LDataBase: string;
  LConfigMgr: TConfigMgr;
begin
  FIsLegal := false;
  CheckInput(EdtUserName);
  LUserName := Trim(EdtUserName.Text);
  LInputPsw := Trim(EdtPassword.Text);
  if FIsConnectChange then
  begin
    LServerName := Trim(EdtServerName.Text);
    LDataBase := Trim(EdtDataBase.Text);
    DMMain.ADOConnectionMain.Close;
    DMMain.ADOConnectionMain.ConnectionString
      := 'Provider=SQLOLEDB.1;Integrated Security=SSPI;' +
        'Persist Security Info=False;' +
        'Initial Catalog=' + LDataBase+';Data Source=' +
         LServerName + ';Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=SINCOYANG;Use Encryption for Data=False;Tag with column collation when possible=False';
    DMMain.ADOConnectionMain.DefaultDatabase := LDataBase;
    try
      DMMain.ADOConnectionMain.Open;
      LConfigMgr := TConfigMgr.Create;
      LConfigMgr.ServerName := Trim(EdtServerName.Text);
      LConfigMgr.DataBase := Trim(EdtDatabase.Text);
    except
      LCShowMessage('您指定的服务器无法连通!');
    end;
  end;
  if DMMain.ADOTOperator.Active = false then
    DMMain.ADOTOperator.Open;
  if DMMain.ADOTOperator.Locate('UserName', LUserName, []) then
  begin
    LRealPsw := DMMain.ADOTOperator.FieldByName('Password').AsString;
    if LRealPsw <> LInputPsw then
    begin
      LCShowMessage('密码错误!');
      EdtPassword.SelectAll;
      EdtPassword.SetFocus;
      Exit;
    end;
    FUserRealName := DMMain.ADOTOperator.FieldByName('UserRealName').AsString;
    FUserPermission := DMMain.ADOTOperator.FieldByName('Permission').AsString;
    FUserName := LUserName;
    FIsLegal := true;
    ModalResult := mrOk;
  end
  else
  begin
    LCShowMessage('用户名不存在!');
    EdtUserName.SetFocus;
  end;
end;

procedure TFormLogin.FormCreate(Sender: TObject);
begin

  FIsConnectChange := false;
end;

procedure TFormLogin.BtnCancelClick(Sender: TObject);
begin
  FIsLegal := false;
  ModalResult := mrCancel;
end;

procedure TFormLogin.EdtPasswordKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    BtnOKClick(BtnOK);
end;

procedure TFormLogin.BtnAdvanceClick(Sender: TObject);
var
  LConfigMgr: TConfigMgr;
begin
  LConfigMgr := TConfigMgr.Create;
  if (Sender as TButton).Caption = '高级(&A)>>' then
  begin
    (Sender as TButton).Caption := '高级(&A)<<';
    self.Height := 263;
    EdtServerName.Text := LConfigMgr.ServerName;
    EdtDataBase.Text := LConfigMgr.DataBase;
  end
  else
  begin
    (Sender as TButton).Caption := '高级(&A)>>';
    self.Height := 176;
    LConfigMgr.ServerName := EdtServerName.Text;
    LConfigMgr.DataBase := EdtDataBase.Text;
  end;
  FreeAndNil(LConfigMgr);
end;

procedure TFormLogin.EdtServerNameChange(Sender: TObject);
begin
  FIsConnectChange := true;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -