📄 loginunit.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 + -