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

📄 login.pas

📁 进销存以及BOM管理,SQl Server数据库程序
💻 PAS
字号:
unit Login;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, jpeg, Inifiles, Base, Grids, DBGridEh,
  ComCtrls, Mask, wwdbedit, Wwdotdot, DB, ADODB;
type
  Tfrmlogin = class(TfrmBase)
    Image1: TImage;
    pclogin: TPageControl;
    Tab1: TTabSheet;
    Tab2: TTabSheet;
    Tab3: TTabSheet;
    Tab4: TTabSheet;
    Label2: TLabel;
    usercode: TEdit;
    Label3: TLabel;
    password: TEdit;
    btnok: TButton;
    btnexit: TButton;
    Bevel1: TBevel;
    DBGridEh1: TDBGridEh;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Bevel2: TBevel;
    Button4: TButton;
    Button5: TButton;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Edit1: TEdit;
    Label4: TLabel;
    Edit2: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    Edit4: TEdit;
    Edit3: TEdit;
    Label7: TLabel;
    Label8: TLabel;
    Edit6: TEdit;
    Edit5: TEdit;
    DBGridEh2: TDBGridEh;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Bevel3: TBevel;
    Button9: TButton;
    Button10: TButton;
    btnStart: TButton;
    Bevel4: TBevel;
    Laccount: TLabel;
    lStart: TLabel;
    dbstart: TwwDBComboDlg;
    dsqmaster: TDataSource;
    rad1: TRadioButton;
    rad2: TRadioButton;
    Label9: TLabel;
    Edit7: TEdit;
    Edit8: TEdit;
    Label10: TLabel;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    Label11: TLabel;
    procedure btnexitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnokClick(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure DBGridEh1GetCellParams(Sender: TObject; Column: TColumnEh;
      AFont: TFont; var Background: TColor; State: TGridDrawState);
    procedure DBGridEh2GetCellParams(Sender: TObject; Column: TColumnEh;
      AFont: TFont; var Background: TColor; State: TGridDrawState);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure rad1Click(Sender: TObject);
    procedure rad2Click(Sender: TObject);
    procedure dbstartCustomDlg(Sender: TObject);
  private
    trytimes:integer;
    procedure loadaccount;
    { Private declarations }
  public
    procedure refenceDatabase;
    { Public declarations }
  end;

var
  frmlogin: Tfrmlogin;

implementation

uses Global,main, Data, createaccount;

{$R *.dfm}

procedure Tfrmlogin.btnexitClick(Sender: TObject);
begin
  inherited;
  ModalResult:=mrCancel;
end;

procedure Tfrmlogin.FormCreate(Sender: TObject);
var
  s:string;
  ini:Tinifile;
  usercodes:string;
begin
  inherited;
  edit1.Text:='';
  edit2.Text:='';
  edit3.Text:='';
  edit4.Text:='';
  edit5.Text:='';
  edit6.Text:='';

  main_ini();
  s:=Extractfilepath(Application.ExeName)+gs_inifileName;

  try
    ini:=Tinifile.Create(s);
    usercodes:=ini.ReadString('Login','Usercode','');
  finally
    ini.Free;
  end;

  caption:=SystemName;
  usercode.Text:=usercodes;

  pclogin.ActivePage:=tab1;
  self.ActiveControl:=PassWord;

end;

procedure Tfrmlogin.btnokClick(Sender: TObject);
begin
  inherited;
  if (AccountName='') or (Datam.adoqmaster.RecordCount=0) then
  begin
      Messagedlg('请先指定一个帐套名称 !',mtWarning,[mbok],0);
      Exit;
  end;

  if (length(trim(usercode.Text))=0) then
  begin
      Messagedlg('用户名称不能为空 !',mtWarning,[mbok],0);
      Exit;
  end;

  if (length(trim(password.Text))=0) then
  begin
      Messagedlg('密码不能为空 !',mtWarning,[mbok],0);
      Exit;
  end;

      inc(trytimes);

      try
        With Datam.adoqmasters do
          begin
            close;
            sql.Clear;
            sql.Add('Use '+AccountName);
            ExecSql;
          end;
       except
        on E:Exception do
          begin
            messagedlg(pchar(AccountName+'数据库不存在或是SQL SERVER 没有启动 ! '),mtError,[mbok],0);
            Exit;
          end;
       end;

       with datam.adoqlogin do
        begin
                close;
                sql.Clear;
                sql.Add('select * from tuser where fcode=:fcode');
                parameters.ParamValues['fcode']:=Trim(usercode.Text);
                open;
        end;

          if uppercase(Trim(datam.adoqlogin.FieldByName('fpwd').AsString))=
                                                  uppercase(Trim(Password.Text)) then
                begin
                      gs_userid:=datam.adoQlogin.fieldbyname('fid').AsInteger;
                      gs_usercode:=datam.adoQlogin.fieldbyname('fcode').AsString;
                      gs_username:=datam.adoQlogin.fieldbyname('fname').AsString;
                      gs_password:=Trim(password.Text);
                      gs_admin:=datam.adoQlogin.fieldbyname('fadmin').AsBoolean;

                      frmmain.StatusBar.Panels[0].Text:=SystemName;
                      frmmain.StatusBar.Panels[1].Text:='当前用户 : '+gs_username;
                      frmmain.StatusBar.Panels[2].Text:='当前使用帐套 : '+AccountName;

                      p_writeMainini('login','UserCode',gs_UserCode);

                      gs_ISadoconnect(Createadoconn(AccountName));

                      modalResult:=mrOK;

                end
                else
                begin
                       messagedlg('当前密码错误 , 请输入正确的用户名 ! ',mtError,[mbok],0);
                       password.Text:='';
                       password.SetFocus();
                          if trytimes>=3 then
                                begin
                                        messagedlg('您不是合法用户 , 请立即退出 !  ',mtError,[mbok],0);
                                        btnexitclick(self);
                                end;
                end;
end;


procedure Tfrmlogin.Button4Click(Sender: TObject);
var
s:string;
ini:Tinifile;
begin
s:=ExtractFilePath(application.ExeName);
if s[length(s)]<>'\' then
s:=S+'\'+'Databasetset.ini'
else
s:=s+'Databaseset.ini';
try
ini:=Tinifile.Create(s);
ini.WriteString('Login','UserName',edit1.Text);
ini.WriteString('Login','PassWord',edit2.Text);
ini.WriteString('Login','Servername',edit3.Text);
ini.WriteString('Login','HostIP',edit4.Text);
ini.WriteString('Login','DatabaseName',edit5.Text);
ini.WriteString('Login','SystemName',edit6.Text);
finally
ini.Free;
end;
application.MessageBox(pchar('数据库连接设定完成,请重新启动 ! '),'东创卓越',
                            mb_ok+mb_iconinformation+mb_applmodal);
application.Terminate;
end;

procedure Tfrmlogin.Button5Click(Sender: TObject);
begin
  inherited;
  edit1.Text:='';
  edit2.Text:='';
  edit3.Text:='';
  edit4.Text:='';
  edit5.Text:='';
  edit6.Text:='';
  pclogin.ActivePage:=tab1;
end;

procedure Tfrmlogin.Button1Click(Sender: TObject);
begin
  inherited;
  pclogin.ActivePage:=tab2;
end;

procedure Tfrmlogin.Button9Click(Sender: TObject);
begin
  inherited;
  pclogin.ActivePage:=Tab1;
end;

procedure Tfrmlogin.FormShow(Sender: TObject);
begin
  inherited;
  image1.Picture.LoadFromFile(Extractfilepath(Application.ExeName)+'picture\system\Hxtitle.jpg');
  datam:=Tdatam.Create(application);
  refenceDatabase;
end;

procedure Tfrmlogin.Button2Click(Sender: TObject);
begin
  inherited;
  loadaccount;
  pclogin.ActivePage:=Tab3;
end;

procedure Tfrmlogin.Button3Click(Sender: TObject);
begin
  inherited;
  if (AccountName='') or (datam.adoqmaster.RecordCount=0) then
    begin
      messagedlg('请选择一个帐套 ! ',mtError,[mbok],0);
      Exit;
    end;
  pclogin.ActivePage:=Tab4;
  rad1.Checked:=True;
  rad2.Checked:=False;

  laccount.Caption:='对'+Trim(AccountName)+'进行如下操作:';
  lstart.Caption:='备份文件名';
  btnstart.Caption:='开始备份';
  edit8.SetFocus;
end;

procedure Tfrmlogin.loadaccount;
begin
  with datam.adoqmasters do
    begin
      close;
      sql.Clear;
      sql.Add('use Master ');
      sql.add('if not exists (select * from master..sysobjects where id = object_id('+'''Master..#creativejxc'''+'))');
      sql.Add('CREATE TABLE creativejxc(fid int identity(1,1) not null,accountname nvarchar(30),databasename nvarchar(20),remark nvarchar(60))');
      ExecSQL;
    end;

    refenceDatabase;
end;

procedure Tfrmlogin.Button6Click(Sender: TObject);
begin
  inherited;
  if not assigned(frmcreateaccount) then
    frmcreateaccount:=Tfrmcreateaccount.Create(application);
    frmcreateaccount.ShowModal;
end;

procedure Tfrmlogin.DBGridEh1GetCellParams(Sender: TObject;
  Column: TColumnEh; AFont: TFont; var Background: TColor;
  State: TGridDrawState);
begin
  inherited;
  if DBGridEh1.SumList.RecNo mod 2=1 then
    BackGround:=$00EAEFED
    else
    BackGround:=clWhite;
end;

procedure Tfrmlogin.DBGridEh2GetCellParams(Sender: TObject;
  Column: TColumnEh; AFont: TFont; var Background: TColor;
  State: TGridDrawState);
begin
  inherited;
  if DBGridEh2.SumList.RecNo mod 2=1 then
    BackGround:=$00EAEFED
    else
    BackGround:=clWhite;
end;

procedure Tfrmlogin.Button7Click(Sender: TObject);
begin
  inherited;
  if messagedlg(pchar('您是否确认删除帐套'+AccountName),mtwarning,[mbok,mbcancel],0)=mrcancel then
    Exit;
  try
    Screen.Cursor :=crSqlWait;
    with datam.adoqmasters do
      begin
        close;
        sql.Clear;
        sql.Add('Use Master ');
        sql.Add('drop database '+AccountName+' select 1');
        ExecSql;
      end;

    with Datam.adoqmasters do
      begin
        close;
        sql.Clear;
        sql.Add('Use Master ');
        sql.Add('Delete from [Master]..creativejxc where databasename='+quotedstr(AccountName));
        ExecSql;
      end;
  except
    on E:exception do
      begin
        Screen.Cursor :=crDefault;
        messagedlg('数据库正在使用中,不能删除 ! '+#10#13+E.Message,mtError,[mbok],0);
        Abort;
      end;
  end;

  application.MessageBox(pchar('数据库'+Trim(AccountName)+'删除成功 ! '),'东创卓越',MB_OK+MB_iconWarning);
  refenceDatabase;
  Screen.Cursor :=crDefault;
end;

procedure Tfrmlogin.refenceDatabase;
begin
  try
     with datam.adoqmaster do
      begin
        close;
        sql.Clear;
        sql.Add('Use Master');
        sql.add(' Select * from [Master]..creativejxc order by fid');
        open;
      end;
  except
    Abort;
  end;
end;

procedure Tfrmlogin.Button8Click(Sender: TObject);
begin
  inherited;
  Application.MessageBox('检验完成!','东创卓越',MB_OK+MB_iconWarning);
  Abort;
end;

procedure Tfrmlogin.btnStartClick(Sender: TObject);
var
s:string;
ini:Tinifile;
eadoquery:Tadoquery;
begin
  inherited;
  if edit7.Text = '' then
  begin
    messagedlg('数据库连接用户不能为空 ! ',mtError,[mbok],0);
    exit;
  end;

  if edit8.Text = '' then
    begin
      messagedlg('数据库连接密码不能为空 ! ',mtError,[mbok],0);
      exit;
    end;

  if dbstart.Text = '' then
    begin
      messagedlg('操件文件名不能为空 ! ',mtError,[mbok],0);
      exit;
    end;

s:=ExtractFilePath(application.ExeName);
if s[length(s)]<>'\' then
s:=S+'\'+'Databasetset.ini'
else
s:=s+'Databaseset.ini';
try
   ini:=Tinifile.Create(s);
   if (Trim(ini.ReadString('Login','PassWord',''))<>Trim(edit8.Text)) or
        (Trim(ini.ReadString('Login','UserName',''))<>Trim(edit7.Text)) then
    begin
      messagedlg('数据库用户或密码不正确,不能备份或是还原数据库 ! ',mterror,[mbok],0);
      exit;
    end;
finally
  ini.Free;
end;

try
  Screen.Cursor :=crSqlWait;
  try
    eadoquery:=Tadoquery.Create(nil);
    eadoquery.Connection:=Datam.AdoConnection;
    eadoquery.CursorType:=ctStatic;
    eadoquery.LockType:=ltBatchOptimistic;
    if rad1.Checked then
      begin
        with eadoquery do
          begin
            close;
            sql.Clear;
            sql.Add('BACKUP DATABASE '+Trim(AccountName)+' TO DISK ='+''''+dbstart.Text+''''+'  with init');
            p_WriteMainINI('BackupDatabase','BackUP',sql.Text );
            Execsql;
          end;
      messagedlg(pchar('备份数据库'+AccountName+'成功 ! '),mtWarning,[mbok],0);
      end
      else
      begin
        with eadoquery do
          begin
            close;
            sql.Clear;
             sql.add('use Master ALTER DATABASE '+Trim(AccountName)+' set offline with rollback immediate ');
             sql.add(' RESTORE DATABASE '+Trim(AccountName)+' FROM DISK ='+quotedstr(dbstart.Text));
             sql.add(' with file=1,replace ');
             sql.add(' alter database '+AccountName+' set online with rollback immediate ');
             sql.Add(' Use '+AccountName);
            p_WriteMainINI('BackupDatabase','BackUP',sql.Text );
            Execsql;
          end;
      messagedlg(pchar('还原数据库'+AccountName+'成功 ! '),mtWarning,[mbok],0);
      end;
  finally
    eadoquery.free;
  end;
except
  on E:exception do
    begin
      screen.Cursor:=crDefault;
      messagedlg('操件文件名不正确,您的操件即将终止! '+#10#13+E.Message,mtError,[mbok],0);
      abort;
    end;
end;
edit7.Text:='';
edit8.Text:='';
screen.Cursor:=crDefault;

end;

procedure Tfrmlogin.rad1Click(Sender: TObject);
begin
  inherited;
  lstart.Caption:='备份文件名';
  btnstart.Caption:='开始备份';
  dbstart.SetFocus;
end;

procedure Tfrmlogin.rad2Click(Sender: TObject);
begin
  inherited;
  lstart.Caption:='还原文件名';
  btnstart.Caption:='开始还原';
  dbstart.SetFocus;
end;

procedure Tfrmlogin.dbstartCustomDlg(Sender: TObject);
begin
  inherited;
  if rad1.Checked then
    begin
      savedialog1.Options:=[ofFileMustExist];
      if savedialog1.Execute then
        dbstart.Text:=savedialog1.FileName;
    end
    else
    begin
       opendialog1.Options:=[ofFileMustExist];
       if opendialog1.Execute then
        dbstart.Text:=opendialog1.FileName; 
    end;
end;

end.

⌨️ 快捷键说明

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