Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then Adodc1.Recordset.MoveFirst
Adodc1.Recordset!会员等级 = \★★☆☆☆\ Adodc1.Recordset.Update End If End If
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = \会员标准] from [会员政策] where [会员级别]='★★★☆☆'\
Adodc1.Refresh
Adodc1.Recordset.MoveFirst
BiaoZhun = CInt(Adodc1.Recordset!会员标准)
If SUMBook >= BiaoZhun Then
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = \会员表] where [会员卡号]=\
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then Adodc1.Recordset.MoveFirst
Adodc1.Recordset!会员等级 = \★★★☆☆\ Adodc1.Recordset.Update End If End If
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = \会员标准] from [会员政策] where [会员级别]='★★★★☆'\
Adodc1.Refresh
Adodc1.Recordset.MoveFirst
BiaoZhun = CInt(Adodc1.Recordset!会员标准)
If SUMBook >= BiaoZhun Then
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = \会员表] where [会员卡号]=\
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then Adodc1.Recordset.MoveFirst
Adodc1.Recordset!会员等级 = \★★★★☆\ Adodc1.Recordset.Update End If End If
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = \会员标准] from [会员政策] where [会员级别]='★★★★★'\
Adodc1.Refresh
Adodc1.Recordset.MoveFirst
BiaoZhun = CInt(Adodc1.Recordset!会员标准)
If SUMBook >= BiaoZhun Then
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = \会员表] where [会员卡号]=\
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then Adodc1.Recordset.MoveFirst
Adodc1.Recordset!会员等级 = \★★★★★\ Adodc1.Recordset.Update End If End If
CommitTrans
HYShengJi = False
Exit Function errEnd:
Rollback
HYShengJi = True
Screen.MousePointer = vbDefault
MsgBox \检查会员是否应升级时操作失败！\vbExclamation, \图书销售\
CmdOK.Enabled = True End Function
模块名：CmdSellBook_Click
模块原型：Private Sub CmdSellBook_Click() 代码：
Private Sub CmdSellBook_Click() On Error GoTo errEnd Dim QD As Integer
CmdSellBook.Enabled = False
If TxtShuLiang.Text = \
MsgBox \请输入交易的数量!\填写数量\
TxtShuLiang.SetFocus
CmdSellBook.Enabled = True Exit Sub End If
If GetKuCun(TuShuBianHao) <= 0 Or GetKuCun(TuShuBianHao) < TxtShuLiang.Text Then
MsgBox \该类图书库存量不足,请与仓库管理员联系!\vbExclamation, \库存不足\
TxtShuLiang.SetFocus
CmdSellBook.Enabled = True Exit Sub End If
If TxtZheKou.Text = \
MsgBox \请输入交易的实际折扣率!\填写折扣\
TxtZheKou.SetFocus
CmdSellBook.Enabled = True Exit Sub End If
If TxtZheKou.Text <= 0 Or TxtZheKou.Text > 1 Then
MsgBox \实际折扣率填写错误!请在 0 与 1 之间选择.\vbExclamation, \填写折扣\
TxtZheKou.SetFocus
CmdSellBook.Enabled = True Exit Sub End If
If TxtSJJinE.Text = \
MsgBox \请输入交易的实际金额!\填写金额\
TxtSJJinE.SetFocus
CmdSellBook.Enabled = True Exit Sub End If
If TxtMemo.Text = \无\
QD = MsgBox(\确定入帐吗?\确认入帐\If QD = vbCancel Then
CmdSellBook.Enabled = True Exit Sub End If '售书入帐
Screen.MousePointer = 11 BeginTrans
Adodc1.CommandType = adCmdTable Adodc1.RecordSource = \售书记录\Adodc1.Refresh
Adodc1.Recordset.AddNew
Adodc1.Recordset!图书编号 = TuShuBianHao Adodc1.Recordset!数量 = TxtShuLiang.Text Adodc1.Recordset!会员卡号 = HuiYuanKaHao Adodc1.Recordset!实际打折 = TxtZheKou.Text Adodc1.Recordset!实收金额 = TxtSJJinE.Text
Adodc1.Recordset!日期 = Year(Now) & \& Month(Now) & \& Day(Now) & \
Adodc1.Recordset!备注 = TxtMemo.Text Adodc1.Recordset.Update
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = \图书编号]=\TuShuBianHao & \
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then Adodc1.Recordset.MoveFirst
Adodc1.Recordset!库存量 = Adodc1.Recordset!库存量 - TxtShuLiang.Text
Adodc1.Recordset.Update Else
Rollback
Screen.MousePointer = vbDefault
MsgBox \图书资料丢失，请与仓库管理员联系！\vbExclamation, \交易失败\
CmdSellBook.Enabled = True Exit Sub End If
If HYShengJi(HuiYuanKaHao) Then Rollback
CommitTrans
Screen.MousePointer = vbDefault
MsgBox \恭喜您,交易成功!\交易成功\Unload Me
Exit Sub
errEnd:
Rollback
Screen.MousePointer = vbDefault
MsgBox Err.Description, vbOKOnly + vbExclamation, \操作数据库出错 交易失败\
CmdSellBook.Enabled = True End Sub
8.5.3系统模块详解 模块名：checkGYSID
模块原型：Public Function checkGYSID(UID As String) As Boolean 代码：
Public Function checkGYSID(UID As String) As Boolean Dim userDB As Database Dim userRD As Recordset Dim dbName As String Dim STRSQL As String
Screen.MousePointer = 11
On Error GoTo errEnd
dbName = App.Path
If Right(dbName, 1) <> \dbName = dbName + \
STRSQL = \图书分类] from [图书分类] where [图书分类号]=\& UID & \
'打开数据库
Set userDB = DBEngine.Workspaces(0).OpenDatabase(dbName, False, True)
'检索用户,验证密码
Set userRD = userDB.OpenRecordset(STRSQL, dbOpenSnapshot)
If userRD.RecordCount > 0 Then '关闭数据库 userRD.Close
Set userRD = Nothing userDB.Close
Set userDB = Nothing
checkGYSID = True
Screen.MousePointer = vbDefault Else
'关闭数据库 userRD.Close
Set userRD = Nothing userDB.Close
Set userDB = Nothing
Screen.MousePointer = vbDefault checkGYSID = False End If
Exit Function
errEnd:
Screen.MousePointer = vbDefault
MsgBox Err.Description, vbOKOnly + vbExclamation, \创建类别\ Err.Clear '关闭数据库 userRD.Close
Set userRD = Nothing userDB.Close
Set userDB = Nothing End Function
模块名：checkFenLei
模块原型：Public Function checkFenLei(UID As String) As Boolean 代码：
Public Function checkFenLei(UID As String) As Boolean Dim userDB As Database Dim userRD As Recordset Dim dbName As String Dim STRSQL As String
Screen.MousePointer = 11
On Error GoTo errEnd
dbName = App.Path
If Right(dbName, 1) <> \dbName = dbName + \
STRSQL = \图书分类] from [图书分类] where [图书分类]=\UID & \
'打开数据库
Set userDB = DBEngine.Workspaces(0).OpenDatabase(dbName, False, True)
'检索用户,验证密码
Set userRD = userDB.OpenRecordset(STRSQL, dbOpenSnapshot)
If userRD.RecordCount > 0 Then '关闭数据库 userRD.Close
Set userRD = Nothing userDB.Close
Set userDB = Nothing
checkFenLei = True
Screen.MousePointer = vbDefault Else
'关闭数据库 userRD.Close
Set userRD = Nothing userDB.Close
Set userDB = Nothing
Screen.MousePointer = vbDefault checkFenLei = False End If
Exit Function
errEnd:
Screen.MousePointer = vbDefault
MsgBox Err.Description, vbOKOnly + vbExclamation, \创建类别\ Err.Clear '关闭数据库 userRD.Close
Set userRD = Nothing userDB.Close
Set userDB = Nothing End Function
模块名：CmdNewFenLei_Click
模块原型：Private Sub CmdNewFenLei_Click() 代码：
Private Sub CmdNewFenLei_Click() On Error GoTo errEnd
If TxtBianHao.Text = \
MsgBox \请填写图书分类号!\创建分
类\
TxtBianHao.SetFocus Exit Sub End If
If TxtLeiBie.Text = \
MsgBox \请填写图书分类名称!\创建分类\
TxtLeiBie.SetFocus Exit Sub End If
If checkFenLei(TxtLeiBie.Text) Then
MsgBox \图书分类名称不唯一，请另选一个！\vbExclamation, \创建分类\
TxtLeiBie.SetFocus TxtLeiBie.SelStart = 0
TxtLeiBie.SelLength = Len(TxtLeiBie.Text) Exit Sub End If
If ComboFuLei.Text <> \选择父类\ If Not checkFenLei(ComboFuLei.Text) Then MsgBox \所选父类不存在！请重试！\vbOKOnly + vbExclamation, \选择父类\
ComboFuLei.SetFocus Exit Sub End If
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = \[图书分类号] from [图书分类] where [图书分类号]=[所属父类编号] and [图书分类]=\& ComboFuLei.Text & \
Adodc1.Refresh
Adodc1.Recordset.MoveFirst
FuLeiBianHao = Adodc1.Recordset!图书分类号 End If
If checkGYSID(TxtBianHao.Text) Then
MsgBox \图书分类编号不唯一，请另选一个！\vbExclamation, \创建分类\
TxtBianHao.SetFocus
TxtBianHao.SelStart = 0
TxtBianHao.SelLength = Len(TxtBianHao.Text) Exit Sub End If
If FuLeiBianHao = \
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 \创建分类成功！\创建分类\TxtBianHao.Text = \TxtLeiBie.Text = \
ComboFuLei.Text = \选择父类\FuLeiBianHao = \TxtFuLei.Text = \TxtBianHao.SetFocus
Exit Sub errEnd:
MsgBox \更新数据库失败!\数据库出错\
End Sub
模块名：checkUserID
模块原型：Public Function checkUserID(UID As String) As Boolean 代码：
Public Function checkUserID(UID As String) As Boolean Dim userDB As Database Dim userRD As Recordset Dim dbName As String Dim STRSQL As String
Screen.MousePointer = 11