VB+SQL书店图书管理系统(任务书+开题报告+论文) 第14页
模块名：CmdNewFenLei_Click
模块原型：Private Sub CmdNewFenLei_Click()
代码：
Private Sub CmdNewFenLei_Click()
On Error GoTo errEnd
If TxtBianHao.Text = "" Then
    MsgBox "请填写图书分类号!", vbOKOnly + vbExclamation, "创建分类"
    TxtBianHao.SetFocus
    Exit Sub
End If
If TxtLeiBie.Text = "" Then
    MsgBox "请填写图书分类名称!", vbOKOnly + vbExclamation, "创建分类"
    TxtLeiBie.SetFocus
    Exit Sub
End If
If checkFenLei(TxtLeiBie.Text) Then
    MsgBox "图书分类名称不唯一，请另选一个！", vbOKOnly + vbExclamation, "创建分类"
    TxtLeiBie.SetFocus
    TxtLeiBie.SelStart = 0
    TxtLeiBie.SelLength = Len(TxtLeiBie.Text)
    Exit Sub
End If
If ComboFuLei.Text <> "" And ComboFuLei.Text <> "选择父类" Then
    If Not checkFenLei(ComboFuLei.Text) Then
        MsgBox "所选父类不存在！请重试！", vbOKOnly + vbExclamation, "选择父类"
        ComboFuLei.SetFocus
        Exit Sub
    End If
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "select [图书分类号] from [图书分类] where [图书分类号]=[所属父类编号] and [图书分类]=""" & ComboFuLei.Text & """"
    Adodc1.Refresh
    Adodc1.Recordset.MoveFirst
    FuLeiBianHao = Adodc1.Recordset!图书分类号
End If
If checkGYSID(TxtBianHao.Text) Then
    MsgBox "图书分类编号不唯一，请另选一个！", vbOKOnly + vbExclamation, "创建分类"
    TxtBianHao.SetFocus
    TxtBianHao.SelStart = 0
    TxtBianHao.SelLength = Len(TxtBianHao.Text)
    Exit Sub
End If
If FuLeiBianHao = "" Then FuLeiBianHao = 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

Exit Sub
errEnd:
    MsgBox "更新数据库失败!", vbOKOnly + vbExclamation, "数据库出错"
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

On Error GoTo errEnd

dbName = App.Path
If Right(dbName, 1) <> "\" Then dbName = dbName + "\"
dbName = dbName + "DataBase\WFSSDataBase.mdb"
STRSQL = "select [用户身份] from [Admin] where [用户ID]=""" & 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
   
    checkUserID = True
    Screen.MousePointer = vbDefault
Else
    '关闭数据库
    userRD.Close
    Set userRD = Nothing
    userDB.Close
    Set userDB = Nothing
   
    Screen.MousePointer = vbDefault
    checkUserID = 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

 << 上一页  [11] [12] [13] [14] [15] [16] 下一页