frmguestmain.frm

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

      Begin VB.Menu MGH_line 
         Caption         =   "-"
      End
      Begin VB.Menu MGuestH_lianJi 
         Caption         =   "联机帮助"
      End
   End
End
Attribute VB_Name = "FrmGuestMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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
Public Sub searchBook(keyWords As String, fenLei As String)
Dim strSQL As String
SSTabGuest.Tab = 1
If keyWords = "" Then
    MsgBox "请输入检索的关键词！", vbOKOnly + vbExclamation, "图书检索"
    TxtKeyWords_Click
    Exit Sub
End If
If fenLei = "" Or fenLei = "选择分类" Then
    MsgBox "请输入检索的依据！", vbOKOnly + vbExclamation, "图书检索"
    ComboLeiBie.SetFocus
    Exit Sub
End If
On Error GoTo errEnd

strSQL = "select * from [读者查询] where [" & fenLei & "] like '%" & keyWords & "%'"

Adodc1.CommandType = adCmdText
Adodc1.RecordSource = strSQL
Adodc1.Refresh
Set DataGrid2.DataSource = Adodc1
DataGrid2.Refresh

If Adodc1.Recordset.RecordCount = 0 Then
    MsgBox "没有找到你要的相关记录!", vbOKOnly + vbInformation, "图书检索"
End If
LabResult.Caption = "共找到 " & Adodc1.Recordset.RecordCount & " 条相关记录"
Exit Sub

errEnd:
    MsgBox Err.Description, vbOKOnly + vbExclamation, "检索错误"
End Sub

Private Sub CmdRegMe_Click()
Dim reDL As Integer
On Error GoTo errEnd

If TxtCard.Text = "" Then
    MsgBox "请填写你所选择的会员卡号！", vbOKOnly + vbExclamation, "会员注册"
    TxtCard.SetFocus
    Exit Sub
End If
If TxtUName.Text = "" Then
    MsgBox "请填写你的姓名！", vbOKOnly + vbExclamation, "会员注册"
    TxtUName.SetFocus
    Exit Sub
End If
If TxtUDanWei.Text = "" Then
    MsgBox "请填写你所在单位！", vbOKOnly + vbExclamation, "会员注册"
    TxtUDanWei.SetFocus
    Exit Sub
End If
If TxtUDiZhi.Text = "" Then
    MsgBox "请填写你的地址！", vbOKOnly + vbExclamation, "会员注册"
    TxtUDiZhi.SetFocus
    Exit Sub
End If
If TxtUMail.Text = "" Then TxtUMail.Text = "无"
If TxtUDianHua.Text = "" Then TxtUDianHua.Text = "无"
If TxtUMemo.Text = "" Then TxtUMemo.Text = "无"

If checkUserID(TxtCard.Text) Then
    MsgBox "这个会员卡号已经被注册！请另选一个！", vbOKOnly + vbExclamation, "会员注册"
    TxtCard.SelStart = 0
    TxtCard.SelLength = Len(TxtCard.Text)
    TxtCard.SetFocus
    Exit Sub
End If

BeginTrans

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

Adodc1.Recordset.AddNew
Adodc1.Recordset!会员卡号 = TxtCard.Text
Adodc1.Recordset!会员等级 = "☆☆☆☆☆"
Adodc1.Recordset!姓名 = TxtUName.Text
If OptionMan.Value Then
    Adodc1.Recordset!性别 = "男"
Else
    Adodc1.Recordset!性别 = "女"
End If
Adodc1.Recordset!地址 = TxtUDiZhi.Text
Adodc1.Recordset!单位 = TxtUDanWei.Text
Adodc1.Recordset!电子邮件 = TxtUMail.Text
Adodc1.Recordset!电话 = TxtUDianHua.Text
Adodc1.Recordset!人生格言 = TxtUMemo.Text
Adodc1.Recordset!注册日期 = Now()
Adodc1.Recordset.Update

Adodc1.CommandType = adCmdTable
Adodc1.RecordSource = "Admin"
Adodc1.Refresh

Adodc1.Recordset.AddNew
Adodc1.Recordset!用户ID = TxtCard.Text
Adodc1.Recordset!用户密码 = TxtCard.Text
Adodc1.Recordset!用户身份 = "会员"
Adodc1.Recordset.Update

CommitTrans

reDL = MsgBox("恭喜你，注册成功！" & vbCrLf & "你的帐号和密码就是你填写的会员卡号！" & vbCrLf & "请立即登陆，更改密码！现在登陆吗？", vbYesNo + vbQuestion, "注册成功")
If reDL = vbYes Then
    Load FrmLogIn
    FrmLogIn.Show

    Unload FrmGuestMain

    Unload FrmMain
    UserShenFen = ""
    logOK = False
Else
    CmdRegMe.Enabled = False
End If

Exit Sub

errEnd:
    Rollback
    MsgBox "注册失败，请与书店人员联系！", vbOKOnly + vbExclamation, "注册失败"
End Sub

Private Sub CmdReset_Click()
TxtName.Text = ""
TxtDanWei.Text = ""
TxtDiZhi.Text = ""
TxtEmail.Text = ""
TxtInfo.Text = ""
End Sub

Private Sub CmdSearch_Click()
Dim strSQL As String
If TxtKeyWords.Text = "" Or TxtKeyWords.Text = "关键词" Then
    MsgBox "请输入检索的关键词！", vbOKOnly + vbExclamation, "图书检索"
    TxtKeyWords_Click
    Exit Sub
End If
If ComboLeiBie.Text = "" Or ComboLeiBie.Text = "选择分类" Then
    MsgBox "请输入检索的依据！", vbOKOnly + vbExclamation, "图书检索"
    ComboLeiBie.SetFocus
    Exit Sub
End If
On Error GoTo errEnd

strSQL = "select * from [读者查询] where [" & ComboLeiBie.Text & "] like '%" & TxtKeyWords.Text & "%'"

Adodc1.CommandType = adCmdText
Adodc1.RecordSource = strSQL
Adodc1.Refresh
Set DataGrid2.DataSource = Adodc1
DataGrid2.Refresh
If Adodc1.Recordset.RecordCount = 0 Then
    MsgBox "没有找到你要的相关记录!", vbOKOnly + vbInformation, "图书检索"
End If
LabResult.Caption = "共找到 " & Adodc1.Recordset.RecordCount & " 条相关记录"
Exit Sub

errEnd:
    MsgBox Err.Description, vbOKOnly + vbExclamation, "检索错误"
End Sub

Private Sub CmdSubmit_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
    MsgBox "请填写反馈信息!", vbOKOnly + vbExclamation, "信息反馈"
    TxtInfo.SetFocus
    Exit Sub
End If

Adodc1.Recordset.AddNew
Adodc1.Recordset!姓名 = TxtName.Text
Adodc1.Recordset!身份 = UserShenFen
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, "信息反馈"
Call CmdReset_Click

Exit Sub

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

Private Sub ComboDengJi_Click()
If ComboDengJi.Text <> "请选择会员级别" Then
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "select * from [会员政策] where [会员级别]=""" & ComboDengJi.Text & """"
    Adodc1.Refresh
    
    If Adodc1.Recordset.RecordCount > 0 Then
        Adodc1.Recordset.MoveFirst
        ComboJinE.Clear
        ComboJinE.Text = Adodc1.Recordset!会员标准 & ""
        ComboJinE.AddItem Adodc1.Recordset!会员标准 & ""
        ComboDaZhe.Clear
        ComboDaZhe.Text = Adodc1.Recordset!打折 & ""
        ComboDaZhe.AddItem Adodc1.Recordset!打折 & ""
        TxtLiPin.Text = Adodc1.Recordset!赠送礼品 & ""
        TxtQT.Text = Adodc1.Recordset!备注 & ""
    Else
        MsgBox "数据丢失！请与程序员联系！", vbOKOnly + vbExclamation, "数据库错误"
    End If
End If
End Sub

Private Sub Form_Activate()
Call Form_Resize
Adodc1.CommandType = adCmdTable
Adodc1.RecordSource = "读者查询"

Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
DataGrid1.Refresh
End Sub

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

On Error GoTo errEnd

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

SSTabGuest.Tab = 0
FrmMain.FrmMainSBar.Panels(1).Text = "就绪"
Exit Sub

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

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next
End Sub

Private Sub Form_Resize()
If Me.WindowState <> 2 Then
    Me.WindowState = 2
End If

SSTabGuest.Left = 0
SSTabGuest.Top = Toolbar1.Height
SSTabGuest.Width = Me.ScaleWidth
SSTabGuest.Height = Me.ScaleHeight - Toolbar1.Height

If SSTabGuest.Tab = 0 Then
    DataGrid1.Left = 100
    DataGrid1.Top = 450
    DataGrid1.Width = Me.ScaleWidth - 230
    DataGrid1.Height = Me.ScaleHeight - Toolbar1.Height - 550
ElseIf SSTabGuest.Tab = 1 Then
    DataGrid2.Left = 100
    DataGrid2.Top = 560 + ComboLeiBie.Height
    DataGrid2.Width = Me.ScaleWidth - 230
    DataGrid2.Height = Me.ScaleHeight - Toolbar1.Height - 660 - ComboLeiBie.Height
ElseIf SSTabGuest.Tab = 2 Then
    Frame1.Left = 100
    Frame1.Top = 450
    Frame1.Width = SSTabGuest.Width \ 2 - 200
    Frame1.Height = SSTabGuest.Height - 550
    
    TxtUName.Width = Frame1.Width - 2000
    TxtCard.Width = TxtUName.Width
    TxtUDiZhi.Width = Frame1.Width - 1480
    TxtUDanWei.Width = TxtUDiZhi.Width
    TxtUMail.Width = TxtUDiZhi.Width
    TxtUDianHua.Width = TxtUDiZhi.Width
    TxtUMemo.Width = TxtUDiZhi.Width
    If FrmMain.WindowState = 2 Then
        TxtUMemo.Height = Frame1.Height \ 3 + 400
    ElseIf FrmMain.WindowState = 0 Then
        TxtUMemo.Height = Frame1.Height \ 4
    End If
    CmdRegMe.Left = TxtUMemo.Left
    CmdRegMe.Top = TxtUMemo.Top + TxtUMemo.Height + 120
    
    Frame2.Left = 200 + Frame1.Width
    Frame2.Top = 450
    Frame2.Width = SSTabGuest.Width \ 2 - 200
    Frame2.Height = SSTabGuest.Height - 550
    
    TxtLiPin.Width = Frame2.Width - 1380
    TxtQT.Width = TxtLiPin.Width
    If FrmMain.WindowState = 2 Then
        TxtQT.Height = Frame2.Height \ 2 + 200
    ElseIf FrmMain.WindowState = 0 Then
        TxtQT.Height = Frame2.Height \ 3 + 600
        ComboDengJi.Width = TxtLiPin.Width
    End If