tion
模块名:checkFenLei
模块原型:PublicFunctioncheckFenLei(UIDAsString)AsBoolean
代码:
PublicFunctioncheckFenLei(UIDAsString)AsBoolean
DimuserDBAsDatabase
DimuserRDAsRecordset
DimdbNameAsString
DimSTRSQLAsString
Screen.MousePointer=11
GoToerrEnd
dbName=App.Path
IfRight(dbName,1)<>"\"ThendbName=dbName+"\"
dbName=dbName+"DataBase\WFSSDataBase.mdb"
STRSQL="select[图书分类]from[图书分类]where[图书分类]="""&UID&""""
'打开数据库
SetuserDB=DBEngine.Workspaces(0).OpenDatabase(dbName,False,True)
'检索用户,验证密码
SetuserRD=userDB.OpenRecordset(STRSQL,dbOpenSnapshot)
IfuserRD.RecordCount>0Then
'关闭数据库
userRD.Close
SetuserRD=Nothing
userDB.Close
SetuserDB=Nothing
checkFenLei=True
Screen.MousePointer=vbDefault
Else
'关闭数据库
userRD.Close
SetuserRD=Nothing
userDB.Close
SetuserDB=Nothing
Screen.MousePointer=vbDefault
checkFenLei=False
EndIf
ExitFunction
errEnd:
Screen.MousePointer=vbDefault
MsgBoxErr.Description,vbOKOnly+vbExclamation,"创建类别"
Err.Clear
'关闭数据库
userRD.Close
SetuserRD=Nothing
userDB.Close
SetuserDB=Nothing
EndFunction
模块名:CmdNewFenLei_Click
模块原型:PrivateSubCmdNewFenLei_Click()
代码:
PrivateSubCmdNewFenLei_Click()
GoToerrEnd
IfTxtBianHao.Text=""Then
MsgBox"请填写图书分类号!",vbOKOnly+vbExclamation,"创建分类"
TxtBianHao.SetFocus
ExitSub
EndIf
IfTxtLeiBie.Text=""Then
MsgBox"请填写图书分类名称!",vbOKOnly+vbExclamation,"创建分类"
TxtLeiBie.SetFocus
ExitSub
EndIf
IfcheckFenLei(TxtLeiBie.Text)Then
MsgBox"图书分类名称不唯一,请另选一个!",vbOKOnly+vbExclamation,"创建分类"
TxtLeiBie.SetFocus
TxtLeiBie.SelStart=0
TxtLeiBie.SelLength=Len(TxtLeiBie.Text)
ExitSub
EndIf
IfComboFuLei.Text<>""AndComboFuLei.Text<>"选择父类"Then
IfNotcheckFenLei(ComboFuLei.Text)Then
MsgBox"所选父类不存在!请重试!",vbOKOnly+vbExclamation,"选择父类"
ComboFuLei.SetFocus
ExitSub
EndIf
Adodc1.CommandType=adCmdText
Adodc1.RecordSource="select[图书分类号]from[图书分类]where[图书分类号]=[所属父类编号]and[图书分类]="""&ComboFuLei.Text&""""
Adodc1.Refresh
Adodc1.Recordset.MoveFirst
FuLeiBianHao=Adodc1.Recordset!图书分类号
EndIf
IfcheckGYSID(TxtBianHao.Text)Then
MsgBox"图书分类编号不唯一,请另选一个!",vbOKOnly+vbExclamation,"创建分类"
TxtBianHao.SetFocus
TxtBianHao.SelStart=0
TxtBianHao.SelLength=Len(TxtBianHao.Text)
ExitSub
EndIf
IfFuLeiBianHao=""ThenFuLeiBianHao=TxtBianHao.Text
Adodc1.CommandType=adCmdTable
Adodc1.RecordSource="图书分类"
Adodc1.Refresh
Adodc1.Recordset.AddNew
Adodc1.Recordset!图书分类号=TxtBianHao.Text
Adodc1.Recordset!图书分类=TxtLeiBie.Text
Adodc1.Recordset!所属父类编号=FuLeiBianHao
Adodc1.Recordset.Update
MsgBox"创建分类成功!",vbOKOnly+vbInformation,"创建分类"
TxtBianHao.Text=""
TxtLeiBie.Text=""
ComboFuLei.Text="选择父类"
FuLeiBianHao=""
TxtFuLei.Text=""
TxtBianHao.SetFocus
ExitSub
errEnd:
MsgBox"更新数据库失败!",vbOKOnly+vbExclamation,"数据库出错"
EndSub
模块名:checkUserID
模块原型:PublicFunctioncheckUserID(UIDAsString)AsBoolean
代码:
PublicFunctioncheckUserID(UIDAsString)AsBoolean
DimuserDBAsDatabase
DimuserRDAsRecordset
DimdbNameAsString
DimSTRSQLAsString
Screen.MousePointer=11
GoToerrEnd
dbName=App.Path
IfRight(dbName,1)<>"\"ThendbName=dbName+"\"
dbName=dbName+"DataBase\WFSSDataBase.mdb"
STRSQL="select[用户身份]from[Admin]where[用户ID]="""&UID&""""
'打开数据库
SetuserDB=DBEngine.Workspaces(0).OpenDatabase(dbName,False,True)
'检索用户,验证密码
SetuserRD=userDB.OpenRecordset(STRSQL,dbOpenSnapshot)
IfuserRD.RecordCount>0Then
'关闭数据库
userRD.Close
SetuserRD=Nothing
userDB.Close
SetuserDB=Nothing
checkUserID=True
Screen.MousePointer=vbDefault
Else
'关闭数据库
userRD.Close
SetuserRD=Nothing
userDB.Close
SetuserDB=Nothing
Screen.MousePointer=vbDefault
checkUserID=False
EndIf
ExitFunction
errEnd:
Screen.MousePointer=vbDefault
MsgBoxErr.Description,vbOKOnly+vbExclamation,"修改密码"
Err.Clear
'关闭数据库
userRD.Close
SetuserRD=Nothing
userDB.Close
SetuserDB=Nothing
EndFunction
模块名:CmdChgPass_Click
模块原型:PrivateSubCmdChgPass_Click()
代码:
PrivateSubCmdChgPass_Click()
GoToerrEnd
IfTxtUserID.Text=""Then
MsgBox"请输入你的帐号!",vbOKOnly+vbExclamation,"更改密码"
TxtUserID.SetFocus
ExitSub
EndIf
IfTxtPasswd.Text=""Then
MsgBox"请输入你的旧密码!",vbOKOnly+vbExclamation,"更改密码"
TxtPasswd.SetFocus
ExitSub
EndIf
IfTxtNewPasswd.Text=""Then
MsgBox"请输入你的新密码!",vbOKOnly+vbExclamation,"更改密码"
TxtNewPasswd.SetFocus
ExitSub
EndIf
IfTxtNewPasswd.Text<>TxtNewPasswdC.TextThen
MsgBox"密码输入不一致,请重试!",vbOKOnly+vbExclamation,"更改密码"
TxtPasswd.Text=""
TxtNewPasswd.Text=""
TxtNewPasswdC.Text=""
TxtPasswd.SetFocus
ExitSub
EndIf
IfcheckUserID(TxtUserID.Text)Then
Adodc1.CommandType=adCmdText
Adodc1.RecordSource="select*from[Admin]where[用户密码]="""&TxtPasswd.Text&"""and[用户ID]="""&TxtUserID.Text&""""
Adodc1.Refresh
IfAdodc1.Recordset.RecordCount>0Then
Adodc1.Recordset.MoveFirst
Adodc1.Recordset!用户密码=TxtNewPasswd.Text
Adodc1.Recordset.Update
Else
MsgBox"用户密码验证错误!你无权修改密码!",vbOKOnly+vbExclamation,"密码错误"
TxtPasswd.Text=""
TxtNewPasswd.Text=""
TxtNewPasswdC.Text=""
ExitSub
EndIf
MsgBox"用户密码修改成功!请牢记!",vbOKOnly+vbInformation,"更改密码"
TxtPasswd.Text=""
TxtNewPasswd.Text=""
TxtNewPasswdC.Text=""
Else
MsgBox"该用户不存在!无法修改密码!",vbOKOnly+vbExclamation,"更改密码"
TxtPasswd.Text=""
TxtNewPasswd.Text=""
TxtNewPasswdC.Text=""
EndIf
ExitSub
errEnd:
MsgBoxErr.Description&vbCrLf&"更改密码失败!",vbOKOnly+vbExclamation,"操作数据库出错"
EndSub
模块名:CmdRegMe_Click
模块原型:PrivateSubCmdRegMe_Click()
代码:
PrivateSubCmdRegMe_Click()
GoToerrEnd
IfTxtCard.Text=""Then
MsgBox"请填写员工帐号!",vbOKOnly+vbExclamation,"创建员工帐号"
TxtCard.SetFocus
ExitSub
EndIf
IfTxtUName.Text=""T
上一篇:
vb图书管理系统(文档+源代码)(论文和程序)
下一篇:
临床前药物安全性评价中毒性病理学新技术的应用