login_f.pas

县级供电企业电费核算源码, 在客户处正常运行8年以上, Delphi 5开发,数据库为Interbase/Firebird, 深入使用Procedure和Trigger等, 对入门者具有很好的参考价值

unit Login_F;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DBTables, Db, DBCtrls, Mask, IBDatabase;

type
  TF_Login = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    E_Password: TEdit;
    Bt_Ok: TButton;
    IB_Database: TDatabase;
    Bt_Quit: TButton;
    Tb_Person: TTable;
    Ds_Person: TDataSource;
    DBE_Password: TDBEdit;
    DBLCB_Person: TDBLookupComboBox;
    DBE_Person: TDBEdit;
    Tb_PersonF_PERSON_NO: TStringField;
    Tb_PersonF_PERSON_NAME: TStringField;
    Tb_PersonF_PERSON_PASSWORD: TStringField;
    DBE_Person_No: TDBEdit;
    Label3: TLabel;
    E_DBName: TEdit;
    Bt_SelectDB: TButton;
    OD_DB: TOpenDialog;
    Label4: TLabel;
    E_Server: TEdit;
    Bt_OpenDB: TButton;
    IBX_Database: TIBDatabase;
    IBX_Transaction: TIBTransaction;
    Tb_PersonF_PRIVILEGE: TSmallintField;
    Tb_PersonF_PRIVILEGE_NAME: TStringField;
    procedure Bt_OkClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure E_NameKeyPress(Sender: TObject; var Key: Char);
    procedure E_PasswordKeyPress(Sender: TObject; var Key: Char);
    procedure Bt_QuitClick(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure DBLCB_PersonKeyPress(Sender: TObject; var Key: Char);
    procedure Bt_OkKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Bt_SelectDBClick(Sender: TObject);
    procedure Bt_OkMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Bt_OpenDBClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure E_ServerChange(Sender: TObject);
  private
    { Private declarations }
	procedure Open_DB();
  public
    { Public declarations }
    bQuit: Boolean;
  end;

var
  F_Login: TF_Login;

implementation

uses CommSmdljf, IniFiles, Comm;

Var
    CheckPassword: Boolean;

{$R *.DFM}

procedure TF_Login.Bt_OkClick(Sender: TObject);
begin
	Close();
end;

procedure TF_Login.FormActivate(Sender: TObject);
begin
	bQuit := False;
    E_Password.Text := '';
	CheckPassword := True;
    If(Not IB_Database.Connected) Then//数据库已连接时不再重新打开
    	Open_DB();
end;


procedure TF_Login.E_NameKeyPress(Sender: TObject; var Key: Char);
begin
	If key = #13 then
    	E_Password.SetFocus;

end;

procedure TF_Login.E_PasswordKeyPress(Sender: TObject; var Key: Char);
begin
	If Key = #13 then
    	Bt_OkClick(Sender);
end;


procedure TF_Login.Bt_QuitClick(Sender: TObject);
begin
	bQuit := True;
	Close();
end;

procedure TF_Login.FormDeactivate(Sender: TObject);
begin
	Tb_Person.Close;
end;

procedure TF_Login.DBLCB_PersonKeyPress(Sender: TObject; var Key: Char);
begin
	If Key = #13 then
    	E_Password.SetFocus;
end;



procedure TF_Login.Bt_OkKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
	//按Ctrl+Enter直接进入
	If (ssCtrl in Shift) And (Key = 13) Then
	Begin
    	CheckPassword := False;
        Open_DB();//直接启动网络数据库
    	Close;
    End;
end;

procedure TF_Login.Bt_SelectDBClick(Sender: TObject);
begin
	if OD_DB.Execute() then
    Begin
        If OD_DB.FilterIndex = 2 Then
        	Application.MessageBox('系统暂时不支持存取备份文件,请重新选择!','系统提示',0)
		Else
	    Begin
        	E_DBName.Text := OD_DB.FileName;
            E_Server.Text := '';
		    Open_DB();
	    	if IB_Database.Connected Then
	        	Bt_Ok.SetFocus()
            Else
		    	Application.MessageBox('系统不能正确连接您所选择的数据库!'#10#13#10#13'请确认此数据库在您的机器上, 并且数据库服务器已经运行!','系统提示',0);
        End;
    End;
end;

procedure TF_Login.Open_DB;
Var
	DBName:String;
    ServerName:String;
Begin
	ServerName := Trim(E_Server.Text);
    If (ServerName = '.') Or (ServerName = '本地') Or (ServerName = 'LOCAL') Then
    	ServerName := '';
	if(E_Server.Text = '') Then
		DBName := E_DBName.Text
    Else
    	DBName := ServerName + ':' + E_DBName.Text;
	Bt_Ok.Enabled := False;
    With IB_DataBase do
    Begin
       	If Connected then
        Begin
        	Try//当已经失去连接时,可能关闭不了
	        	Connected := False;
            Except
            	;
            End;
		End;
        Params.Clear;
		Params.Add('USER NAME=SYSDBA');
   		Params.Add('PASSWORD=masterkey');
   		Params.Add('SERVER NAME='+DBName);

        try
            Open;
            Try
                Tb_Person.Open;
                DBLCB_Person.KeyValue := Tb_Person['F_Person_No'];
                DBLCB_Person.SetFocus;
                Bt_Ok.Enabled := True;
            Except
                Application.MessageBox('数据库连接正常，但用户表不能打开, 请与系统管理员联系!','系统提示',0);
            End;
        Except//finally
        	;
        end;
    End;
    If IB_Database.Connected Then//数据库已经连接
    Begin
		IBX_Database.Connected := False;
    	IBX_Database.DatabaseName := DBName;
        IBX_Database.Params.Clear;
		IBX_Database.Params.Add('USER_NAME=SYSDBA');
   		IBX_Database.Params.Add('PASSWORD=masterkey');
        IBX_Database.Open();
        IBX_Transaction.Active := True;
    End;
End;


procedure TF_Login.Bt_OkMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Var
	PressKey:TShiftState;
begin
	//按左Ctrl+mbLEFT直接进入
    PressKey := [ssCtrl, ssShift, ssAlt, ssLeft];
	If PressKey = Shift Then
        CheckPassword := false;
    Open_DB;//直接启动网络数据库
    Close;
end;

procedure TF_Login.Bt_OpenDBClick(Sender: TObject);
begin
    Try
	    Open_DB();//直接启动网络数据库
    Finally
    	if Not IB_Database.Connected Then
	    	Application.MessageBox('系统不能正确连接您所指定(服务器上)的数据库!','系统提示',0);
    End;
end;

procedure TF_Login.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
	If bQuit Then//要求退出
    Begin
    	CanClose := True;
        Exit;
    End;
	If Not CheckPassword Then//不检测密码
    Begin
    	CanClose := True;
        Exit;
    End;
    CanClose := False;
	If DBLCB_Person.Text = '' then
    Begin
    	MessageBox(Handle,'对不起，系统不知道您将用哪一个用户名注册!','注册',0);
		DBLCB_Person.SetFocus;
    End
    Else
	Begin
    	If E_Password.Text = DBE_Password.Text then
    	Begin
        	//退出按钮下次不再可用
    		Bt_Quit.Enabled := False;

            LoginNo := DBE_Person_No.Text;
			LoginName := DBLCB_Person.Text;
    		LoginPassword := E_Password.Text;
            LoginPrivilege := Tb_Person['f_Privilege'];
			CanClose := True;
    	End
    	Else
    	Begin
    		MessageBox(Handle,'对不起，您输入的密码有误,请重新输入','注册',0);
        	E_Password.SetFocus;
			E_Password.Text := '';
    	End;
    End;
end;

procedure TF_Login.FormCreate(Sender: TObject);
begin
	If IB_Database.Connected Or IBX_Database.Connected Then
    	ShowMessage('请关闭F_Login中的数据库连接!');
end;

procedure TF_Login.E_ServerChange(Sender: TObject);
begin
	Bt_SelectDB.Enabled := E_Server.Text = '';
	Bt_OpenDB.Enabled := E_Server.Text <> '';
	E_DBName.Readonly := E_Server.Text = '';
    If IB_Database.Connected Then
    	IB_Database.Close();
end;

end.