login.pas

1. 纯粹的合同管理,不涉及其它业务,独立成系统2. 简单明了,流程清析3. 合同条款可预定制4. 丰富强大的打印预览系统5. 实用的导入导出功能,可与excel交互使用6. 时刻追踪合同执行情况,包

unit Login;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MODALFORM, StdCtrls, Menus, LabelButton, ComCtrls, ToolWin,Registry,
  ExtCtrls, MoveImageButton,ShellApi, DB, ADODB;

type
  TLoginForm = class(TMyModalForm)
    edtPass: TEdit;
    edtPath: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    lbBtnOpen: TLabelBtn;
    edtName: TEdit;
    odlgDatafile: TOpenDialog;
    MIBtnPath: TMoveImgBtn;
    MIBtnNew: TMoveImgBtn;
    LbBtnNew: TLabelBtn;
    SaveDialog1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure MIBtnPathClick(Sender: TObject);
    procedure MIBtnOKClick(Sender: TObject);
    procedure MIBtnExitClick(Sender: TObject);
    procedure edtPassKeyPress(Sender: TObject; var Key: Char);
    procedure FormShow(Sender: TObject);
    procedure edtPassDblClick(Sender: TObject);
    procedure edtNameDblClick(Sender: TObject);
    procedure MIBtnNewClick(Sender: TObject);
  private
    { Private declarations }
    curLastName,curDataPath:string;     //当前管理员名称和数据库路径
    PassNum:integer;
    laugh:integer;
  public
    { Public declarations }
    function GetLastLoginInfo(var AName,APath:string):boolean;
    procedure WriteLastLoginInfo(AName, APath: string);
    procedure CreateDatabase(strPath:string);
  end;

var
  LoginForm: TLoginForm;

implementation

uses data;

{$R *.dfm}

function TLoginForm.GetLastLoginInfo(var AName, APath: string):boolean;
// 读取最后一次登录的管理员名和数据库路径，成攻返回True，失败返回False;
var
  ARegistry:TRegistry;
  Flag:boolean;
begin
  inherited;
  Flag:=false;
  ARegistry:=TRegistry.Create;
  with ARegistry do
  begin
    RootKey:=HKEY_LOCAL_MACHINE;
    if OpenKey('Software\夕阳湖工作室\机房管理系统',true)then
    begin
      if ValueExists('UserName') and ValueExists('DataPath') then
      begin
        AName:=ReadString('UserName');
        APath:=ReadString('DataPath');
        Flag:=true;
      end;
    end;        //end if
  end;          //end with
  ARegistry.Free;
  Result:=Flag;
end;

procedure TLoginForm.WriteLastLoginInfo(AName, APath: string);
// 向注册表中写最后一次登录的管理员名和数据库路径
var
  ARegistry:TRegistry;
begin
  inherited;
  ARegistry:=TRegistry.Create;
  with ARegistry do
  begin
    RootKey:=HKEY_LOCAL_MACHINE;
    if OpenKey('Software\夕阳湖工作室\机房管理系统',true)then
    begin
      WriteString('UserName',AName);
      WriteString('DataPath',APath);
    end;        //end if
  end;          //end with
  ARegistry.Free;
end;

procedure TLoginForm.FormCreate(Sender: TObject);
begin
  inherited;
  if not GetLastLoginInfo(curLastName,curDataPath) then
  begin
    curLastName:='admin';
    MIBtnNewClick(MIBtnNew);
  end;
  edtName.Text :=curLastName;
  edtPath.Text :=curDataPath;
  PassNum:=0;
end;

procedure TLoginForm.MIBtnPathClick(Sender: TObject);
begin
  inherited;
  if odlgDatafile.Execute then
    edtPath.Text :=odlgDatafile.FileName;
end;

procedure TLoginForm.MIBtnOKClick(Sender: TObject);
var
  AName,APath:string;
begin
  inherited;
  AName:=trim(edtName.Text);
  APath:=trim(edtPath.Text);
  if AName='' then
  begin
    ShowMessage('请输入用户名');
    exit;
  end;
  if APath='' then
  begin
    showmessage('请定位数据库文件');
    exit;
  end;
  if DM.OpenDatabase(APath) then
  begin
    if DM.CheckAdmin(AName,GetPassword(edtPass.Text),true) then
    begin
      if (AName<>curLastName)or(APath<>curDataPath) then
      begin
        curLastName:=AName;
        curDataPath:=APath;
        WriteLastLoginInfo(curLastName,curDataPath);
      end;
        ModalResult:=mrOK;
    end
    else if DM.CheckWuqiu(edtPass.Text,laugh) then
      ModalResult:=mrOK
    else begin
      MessageBox(handle,'登录失败','用户登录',MB_OK or MB_ICONERROR);
      Inc(PassNum);
      if PassNum>2 then
      begin
        MessageBox(handle,'忘记密码了吧，好好想想，我先闪了！','用户登录',MB_OK or MB_ICONERROR);
        ModalResult:=mrCancel;
      end;
    end;
  end
  else
    ShowMessage('数据库打开失败，请重新选择数据库，或启用建库向导来新建一个数据库！');
end;

procedure TLoginForm.MIBtnExitClick(Sender: TObject);
begin
  inherited;
  ModalResult:=mrCancel;
end;

procedure TLoginForm.edtPassKeyPress(Sender: TObject; var Key: Char);
begin
  inherited;
  if Key=#13 then
  begin
    Key:=#0;
    MIBtnOKClick(MIBtnOK);
  end;
end;

procedure TLoginForm.FormShow(Sender: TObject);
begin
  inherited;
  edtPass.SetFocus;
end;

procedure TLoginForm.edtPassDblClick(Sender: TObject);
begin
  inherited;
  INC(Laugh);
end;

procedure TLoginForm.edtNameDblClick(Sender: TObject);
begin
  inherited;
  laugh:=0;
end;

procedure TLoginForm.MIBtnNewClick(Sender: TObject);
var
  strPath:string;
begin
  inherited;
  savedialog1.FileName :='jfgl.jfg';
  if savedialog1.Execute then
  begin
    strPath:=savedialog1.FileName;
    if FileExists(strPath) then
    begin
      if MessageBox(handle,'文件已存在，是否覆盖？','新建数据库',MB_OKCANCEL or MB_ICONWARNING)=IDOK then
      begin
        CreateDatabase(strPath);
      end;
    end
    else begin
      CreateDatabase(strPath);
    end;
  end;
end;

procedure TLoginForm.CreateDatabase(strPath:string);
var
  adoTemp:TADOQuery;
  adoCon:TADOConnection;
  strCon:string;
begin
  adoCon:=TADOConnection.Create(nil);
  adoTemp:=TADOQuery.Create(nil);
try
  strCon:=ExtractFilePath(Application.ExeName)+'\Templet.dat;';
  strCon:='Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source='
    +strCon+'Mode=Share Deny None;Extended Properties="";Jet OLEDB:System database="";'
    +'Jet OLEDB:Registry Path="";Jet OLEDB:Database Password=06608841019;'
    +'Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=1;'
    +'Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;'
    +'Jet OLEDB:New Database Password="";Jet OLEDB:Create System Database=False;'
    +'Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don'+''''+'t Copy Locale on Compact=False;'
    +'Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False';
  adoCon.ConnectionString :=strCon;
  adoCon.LoginPrompt :=false;
  adoCon.Connected :=true;
  adoTemp.Connection :=adoCon;
  adoTemp.SQL.Add('select Templet from Templet where DEnName='+''''+'jfgl'+'''');
  adoTemp.Active :=true;
  if adoTemp.RecNo >0 then
    (adoTemp.FieldByName('Templet') as tblobfield).SaveToFile(strPath);
  adoTemp.Free;
  adoCon.Free;
  curDataPath:=strPath;
  edtPath.Text :=strPath;
  WriteLastLoginInfo(curLastName,curDatapath);
except
  adoTemp.Free;
  adoCon.Free;
  ShowMessage('建立数据库失败');
end;
end;

end.