frmhymemo.frm

一个适用于书店的图书管理信息系统

End
Attribute VB_Name = "FrmHYMemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim userYGname As String
Public Function checkBook(bianHao As String) As Boolean
On Error GoTo errEnd

Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select * from [售书记录] where [会员卡号]=""" & bianHao & """"
Adodc1.Refresh
    
If Adodc1.Recordset.RecordCount > 0 Then
    checkBook = True
Else
    checkBook = False
End If

Exit Function
errEnd:
    MsgBox "检索失败！" & Err.Description, vbOKOnly + vbExclamation, "检索错误"
    checkBook = False
End Function

Private Sub CmdClose_Click()
Unload Me
End Sub

Private Sub CmdDelete_Click()
Dim retMsg As Integer
Dim strSQL As String

On Error GoTo errEnd

If userYGname = "Guest" Then
    MsgBox "该帐号是游客帐号，不能删除！", vbOKOnly + vbExclamation, "不可删除"
    Exit Sub
End If

If checkBook(userYGname) Then
    MsgBox "该会员有购书记录，不可以删除！", vbOKOnly + vbExclamation, "不可删除"
    Adodc1.CommandType = adCmdTable
    Adodc1.RecordSource = "会员表"
    Adodc1.Refresh
    Call Form_Activate
    Exit Sub
End If

retMsg = MsgBox("你确定要删除该会员帐号吗？", vbYesNo + vbQuestion, "信息管理")
If retMsg = vbYes Then
    
    BeginTrans
    
    strSQL = "select * from [Admin] where [用户ID]=""" & userYGname & """"
    
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = strSQL
    Adodc1.Refresh
    
    If Adodc1.Recordset.RecordCount > 0 Then
        Adodc1.Recordset.MoveFirst
        Adodc1.Recordset.Delete
    Else
        Rollback
        MsgBox "会员帐号不存在！无法删除！", vbOKOnly + vbExclamation, "删除帐号"
    End If
    
    strSQL = "select * from [会员表] where [会员卡号]=""" & userYGname & """"
    
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = strSQL
    Adodc1.Refresh
    
    If Adodc1.Recordset.RecordCount > 0 Then
        Adodc1.Recordset.MoveFirst
        Adodc1.Recordset.Delete
        CommitTrans
    Else
        Rollback
        MsgBox "会员帐号不存在！无法删除！", vbOKOnly + vbExclamation, "删除帐号"
    End If
End If

    Adodc1.CommandType = adCmdTable
    Adodc1.RecordSource = "会员表"
    Adodc1.Refresh
    Call Form_Activate

Exit Sub

errEnd:
    MsgBox Err.Description, vbOKOnly + vbExclamation, "数据库错误"
End Sub

Private Sub CmdFirst_Click()
Dim SexManValue As String

Adodc1.Recordset.MoveFirst
CmdUp.Enabled = False
CmdFirst.Enabled = False
CmdNext.Enabled = True
CmdLast.Enabled = True

userYGname = Adodc1.Recordset!会员卡号
TxtShenFen.Text = Adodc1.Recordset!会员等级 & ""
SexManValue = Adodc1.Recordset!性别 & ""
TxtName.Text = Adodc1.Recordset!姓名 & ""
TxtDanWei.Text = Adodc1.Recordset!单位 & ""
TxtDianHua.Text = Adodc1.Recordset!电话 & ""
TxtDiZhi.Text = Adodc1.Recordset!地址 & ""
TxtEmail.Text = Adodc1.Recordset!电子邮件 & ""
TxtInfo.Text = Adodc1.Recordset!人生格言 & ""
TxtRQ.Text = Adodc1.Recordset!注册日期 & ""

If SexManValue = "男" Then
    SexMan.Value = True
Else
    SexFemail.Value = True
End If

End Sub

Private Sub CmdLast_Click()
Dim SexManValue As String

Adodc1.Recordset.MoveLast
CmdNext.Enabled = False
CmdLast.Enabled = False
CmdUp.Enabled = True
CmdFirst.Enabled = True

userYGname = Adodc1.Recordset!会员卡号
TxtShenFen.Text = Adodc1.Recordset!会员等级 & ""
SexManValue = Adodc1.Recordset!性别 & ""
TxtName.Text = Adodc1.Recordset!姓名 & ""
TxtDanWei.Text = Adodc1.Recordset!单位 & ""
TxtDianHua.Text = Adodc1.Recordset!电话 & ""
TxtDiZhi.Text = Adodc1.Recordset!地址 & ""
TxtEmail.Text = Adodc1.Recordset!电子邮件 & ""
TxtInfo.Text = Adodc1.Recordset!人生格言 & ""
TxtRQ.Text = Adodc1.Recordset!注册日期 & ""

If SexManValue = "男" Then
    SexMan.Value = True
Else
    SexFemail.Value = True
End If

End Sub

Private Sub CmdNew_Click()
Unload Me
Load FrmRegMe
FrmRegMe.Show vbModal
End Sub

Private Sub CmdNext_Click()
Dim SexManValue As String

If Adodc1.Recordset.EOF Then Exit Sub

Adodc1.Recordset.MoveNext

If Adodc1.Recordset.EOF Then
    Call CmdLast_Click
    Exit Sub
End If
CmdUp.Enabled = True
CmdFirst.Enabled = True

userYGname = Adodc1.Recordset!会员卡号
TxtShenFen.Text = Adodc1.Recordset!会员等级 & ""
SexManValue = Adodc1.Recordset!性别 & ""
TxtName.Text = Adodc1.Recordset!姓名 & ""
TxtDanWei.Text = Adodc1.Recordset!单位 & ""
TxtDianHua.Text = Adodc1.Recordset!电话 & ""
TxtDiZhi.Text = Adodc1.Recordset!地址 & ""
TxtEmail.Text = Adodc1.Recordset!电子邮件 & ""
TxtInfo.Text = Adodc1.Recordset!人生格言 & ""
TxtRQ.Text = Adodc1.Recordset!注册日期 & ""

If SexManValue = "男" Then
    SexMan.Value = True
Else
    SexFemail.Value = True
End If

End Sub

Private Sub CmdUp_Click()
Dim SexManValue As String

If Adodc1.Recordset.BOF Then Exit Sub

Adodc1.Recordset.MovePrevious

If Adodc1.Recordset.BOF Then
    Call CmdFirst_Click
    Exit Sub
End If
CmdNext.Enabled = True
CmdLast.Enabled = True

userYGname = Adodc1.Recordset!会员卡号
TxtShenFen.Text = Adodc1.Recordset!会员等级 & ""
SexManValue = Adodc1.Recordset!性别 & ""
TxtName.Text = Adodc1.Recordset!姓名 & ""
TxtDanWei.Text = Adodc1.Recordset!单位 & ""
TxtDianHua.Text = Adodc1.Recordset!电话 & ""
TxtDiZhi.Text = Adodc1.Recordset!地址 & ""
TxtEmail.Text = Adodc1.Recordset!电子邮件 & ""
TxtInfo.Text = Adodc1.Recordset!人生格言 & ""
TxtRQ.Text = Adodc1.Recordset!注册日期 & ""

If SexManValue = "男" Then
    SexMan.Value = True
Else
    SexFemail.Value = True
End If

End Sub

Private Sub CmdUpdate_Click()
On Error GoTo errEnd

If TxtName.Text = "" Then
    MsgBox "请输入会员的姓名!", vbOKOnly + vbExclamation, "会员信息"
    TxtName.SetFocus
    Exit Sub
End If
If TxtDanWei.Text = "" Then
    TxtDanWei.Text = "未知"
End If
If TxtDiZhi.Text = "" Then
    TxtDiZhi.Text = "未知"
End If
If TxtEmail.Text = "" Then
    TxtEmail.Text = "未知"
End If
If TxtInfo.Text = "" Then TxtInfo.Text = "无"

Adodc1.Recordset!姓名 = TxtName.Text
If SexMan.Value Then
    Adodc1.Recordset!性别 = "男"
Else
    Adodc1.Recordset!性别 = "女"
End If
Adodc1.Recordset!单位 = TxtDanWei.Text
Adodc1.Recordset!地址 = TxtDiZhi.Text
Adodc1.Recordset!电子邮件 = TxtEmail.Text
Adodc1.Recordset!人生格言 = TxtInfo.Text
Adodc1.Recordset!注册日期 = Now
Adodc1.Recordset.Update

MsgBox "当前记录修改成功！", vbOKOnly + vbInformation, "会员信息"
Exit Sub

errEnd:
    MsgBox Err.Description, vbOKOnly + vbExclamation, "数据库错误"
End Sub

Private Sub Form_Activate()
If Adodc1.Recordset.RecordCount > 0 Then
    Call CmdFirst_Click
Else
    MsgBox "当前没有会员信息！", vbOKOnly + vbInformation, "会员信息"
    Call CmdNew_Click
End If
If UserShenFen = "仓库管理员" Then
    CmdNew.Enabled = False
    CmdUpdate.Enabled = False
    CmdDelete.Enabled = False
End If
End Sub

Private Sub Form_Load()
Dim dbName As String
Dim connSTR As String

On Error GoTo errEnd

ChDir App.Path
dbName = App.Path
If Right(dbName, 1) <> "\" Then dbName = dbName + "\"
dbName = dbName + "DataBase\WFSSDataBase.mdb"

connSTR = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbName & ";Persist Security Info=False"
Adodc1.ConnectionString = connSTR

Adodc1.CommandType = adCmdTable
Adodc1.RecordSource = "会员表"
Adodc1.Refresh

Exit Sub

errEnd:
    MsgBox "连接数据库失败!", vbOKOnly + vbExclamation, "打开数据库出错"
    End
End Sub