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

📄 loginunit.pas

📁 东华休闲山庄洗浴、餐饮、客房管理系统
💻 PAS
字号:
unit LoginUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBClient, MConnect, SConnect, StdCtrls, SUIComboBox,
  SUIEdit, SUIButton, ExtCtrls, WinSkinData, Registry, TlHelp32;

type
  TLoginForm = class(TForm)
    pnl1: TPanel;
    btn2: TsuiButton;
    btn1: TsuiButton;
    lbl1: TLabel;
    lbl2: TLabel;
    suiEdit1: TsuiEdit;
    suiComboBox1: TsuiComboBox;
    lbl3: TLabel;
    Label1: TLabel;
    SocketConnection1: TSocketConnection;
    SkinData1: TSkinData;
    dsQuery: TClientDataSet;
    procedure FormCreate(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure suiComboBox1Select(Sender: TObject);
    procedure suiEdit1KeyPress(Sender: TObject; var Key: Char);
    procedure suiComboBox1KeyPress(Sender: TObject; var Key: Char);
    procedure suiComboBox1DropDown(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    iflogin:Boolean;
    userid,username,password:string;
    function ExecuteSQL(sql:string):boolean;//动态执行SQL语句
    function GetRangStr(FirstRow,FirstCol,LastRow,LastCol:integer):string;//Excel翻译单元格对应的值[例如(A1:A4)]
    procedure KillME(filename:string);//杀死客户端应用程序
    procedure ErrorInformation(errorinfo:string);//记录当前错误信息
    procedure AddCombobox(ComboBox:TsuiComboBox;sql:string);//向TComboBox控件中添加相应数据
  end;

var
  LoginForm: TLoginForm;

implementation

uses MainUnit;

{$R *.dfm}

function TLoginForm.ExecuteSQL(sql:string):boolean;
var
  temp:string;
procedure ControlInformation(info:string);
var
  NewFileName:string;
  txt:textfile;
  currentime:string;
begin
  currentime:=FormatDateTime('yyyymmdd',now);
  NewFileName:=ExtractFilePath(application.ExeName)+'Control';
  if not DirectoryExists(NewFileName) then
    MkDir(NewFileName);
  NewFileName:=NewFileName+'\'+currentime+'.txt';
  assignfile(txt,NewFileName);
  if not FileExists(NewFileName) then
    rewrite(txt)
  else
    append(txt);
  writeln(txt,info);
  closefile(txt);
end;
begin
  result:=false;
  try
    dsQuery.Close;
    dsQuery.CommandText:=sql;
    if pos(uppercase('select'),uppercase(sql))=1 then
      dsQuery.Open
    else
      dsQuery.Execute;
    result:=true;
    ControlInformation(sql);
  except
    on e:exception do
      begin
        temp:='***********************************************'+#13#10;
        temp:=temp+'错误时间:'+datetimetostr(now)+#13#10;
        temp:=temp+'错误信息:'+sql+#13#10;
        temp:=temp+e.Message+#13#10;
        temp:=temp+'***********************************************'+#13#10;
        errorinformation(temp);
      end;
  end;
end;

function TLoginForm.GetRangStr(FirstRow,FirstCol,LastRow,LastCol:integer):string;
var
  iA,iB:integer;
begin
  result:='';
  if (FirstRow<1)or(FirstCol<1)or(LastRow<1)or(LastCol<1) then
    Exit;
  iA:=FirstCol div 26;
  iB:=FirstCol mod 26;
  if iB=0 then
    begin
      iA:=iA-1;
      iB:=26;
    end;
  if iA=0 then
    result:=Chr(Ord('A')+iB-1)+IntToStr(FirstRow)+':'
  else
    result:=Chr(Ord('A')+iA-1)+Chr(Ord('A')+iB-1)+IntToStr(FirstRow)+':';
  iA:=LastCol div 26;
  iB:=LastCol mod 26;
  if iB=0 then
    begin
      iA:=iA-1;
      iB:=26;
    end;
  if iA=0 then
    result:=result+Chr(Ord('A')+iB-1)+IntToStr(LastRow)
  else
    result:=result+Chr(Ord('A')+iA-1)+Chr(Ord('A')+iB-1)+IntToStr(LastRow);
end;

procedure TLoginForm.KillME(filename:string);
var
  FProcessEntry32:TProcessEntry32;
  FSnapshotHandle:THandle;
  ProcessHndle:THandle;
  ProcessID:integer;
  temp:string;
  flag:hwnd;
  Ret:BOOL;
begin
  FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  FProcessEntry32.dwSize:=Sizeof(FProcessEntry32);
  Ret:=Process32First(FSnapshotHandle,FProcessEntry32);
  ProcessID:=FProcessEntry32.th32ProcessID;
  while Ret do
    begin
      temp:=ExtractFileName(FProcessEntry32.szExeFile);
      if temp=filename then
        begin
          flag:=openprocess(process_terminate,false,FProcessEntry32.th32ProcessID);
          terminateprocess(flag,0);
        end;
      Ret:=Process32Next(FSnapshotHandle,FProcessEntry32);
    end;
  CloseHandle(FSnapshotHandle);
  ProcessHndle:=OpenProcess(PROCESS_VM_WRITE,false,ProcessID);
  CloseHandle(ProcessHndle);
end;

procedure TLoginForm.ErrorInformation(errorinfo:string);
var
  NewFileName:string;
  txt:textfile;
begin
  NewFileName:=ExtractFilePath(application.ExeName)+'Error';
  if not DirectoryExists(NewFileName) then
    MkDir(NewFileName);
  NewFileName:=NewFileName+'\ErrorInfo.txt';
  assignfile(txt,NewFileName);
  if not FileExists(NewFileName) then
    rewrite(txt)
  else
    append(txt);
  writeln(txt,errorinfo);
  closefile(txt);
end;

procedure TLoginForm.AddCombobox(ComboBox:TsuiComboBox;sql:string);
begin
  combobox.Items.Clear;
  combobox.Items.BeginUpdate;
  if ExecuteSQL(sql) then
    begin
      dsQuery.First;
      while not dsQuery.Eof do
        begin
          combobox.Items.Add(dsQuery.Fields[0].AsString);
          dsQuery.Next;
        end;
      dsQuery.Close;
    end;
  combobox.Items.EndUpdate;
end;

procedure TLoginForm.FormCreate(Sender: TObject);
var
  temp:olevariant;
begin
  try
    SocketConnection1.Connected:=false;
    SocketConnection1.Address:='127.0.0.1';
    SocketConnection1.Connected:=true;
  except
    on e:exception do
      begin
        showmessage('连接服务器出现异常,请与开发人员联系!');
        killme(ExtractFileName(application.ExeName));
      end;
  end;
  SocketConnection1.AppServer.DBOpen(temp);
  if length(string(temp))>0 then
    begin
      showmessage(string(temp));
      SocketConnection1.Connected:=false;
      killme(ExtractFileName(application.ExeName));
    end;
  SkinData1.SkinFile:=ExtractFilePath(application.ExeName)+'skin.skn';
  SkinData1.Active:=true;
end;

procedure TLoginForm.btn2Click(Sender: TObject);
begin
  close;
end;

procedure TLoginForm.btn1Click(Sender: TObject);
var
  count:integer;
  deptname,deptid:string;
begin
  userid:=suiComboBox1.Text;
  ExecuteSQL('select * from users '+
             'where user_bh='''+suiComboBox1.Text+''' and user_mm='''+suiEdit1.Text+'''');
  count:=dsQuery.RecordCount;
  username:=dsQuery.fieldbyname('user_xm').AsString;
  password:=dsQuery.fieldbyname('user_mm').AsString;
  deptid:=dsQuery.fieldbyname('user_departbm').AsString;
  dsQuery.Close;
  ExecuteSQL('select * from depart where depart_bm='''+deptid+'''');
  deptname:=dsQuery.fieldbyname('depart_mc').AsString;
  dsQuery.Close;
  case count of
    0:begin
        MessageDlg('登录名称不存在或用户密码错误,请重新输入!!',mtConfirmation, [mbYes], 0);
        suiComboBox1.Clear;
        suiEdit1.Clear;
        suiComboBox1.SetFocus;
      end;
    1:begin
        iflogin:=true;
        Visible:=false;
        mainform.Visible:=true;
        if not MainForm.Enabled then
          MainForm.Enabled:=true
        else
          loginform.ExecuteSQL('insert into log '+
                               'values('''+FormatDateTime('yyyy-mm-dd hh:nn:ss',now)+''','''+userid+
                                       ''','''+username+''',''成功登录系统'')');
        mainform.stsbr1.Panels[1].Text:='当前操作员:【'+userid+'】'+username+' 所属部门:'+deptname;
      end;
  end;
end;

procedure TLoginForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
  temp:olevariant;
begin
  try
    if iflogin then
    loginform.ExecuteSQL('insert into log '+
                         'values('''+FormatDateTime('yyyy-mm-dd hh:nn:ss',now)+''','''+userid+
                                 ''','''+username+''',''成功退出系统'')');
    SkinData1.Active:=false;
    SocketConnection1.AppServer.DBClose(temp);
    if length(string(temp))>0 then
      showmessage(string(temp));
    SocketConnection1.Connected:=false;
  except
    SocketConnection1.Connected:=false;
    killme(ExtractFileName(application.ExeName));
  end;
end;

procedure TLoginForm.FormActivate(Sender: TObject);
begin
  iflogin:=False;
  self.suiComboBox1.Clear;
  Self.suiEdit1.Clear;
  suiComboBox1.SetFocus;
end;

procedure TLoginForm.suiComboBox1Select(Sender: TObject);
begin
  suiEdit1.SetFocus;
end;

procedure TLoginForm.suiEdit1KeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then
    btn1.SetFocus;
end;

procedure TLoginForm.suiComboBox1KeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then
    suiEdit1.SetFocus;
end;

procedure TLoginForm.suiComboBox1DropDown(Sender: TObject);
begin
  AddCombobox(suiComboBox1,'select user_bh from users');
end;

end.

⌨️ 快捷键说明

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