图书管理系统 源程序代码.doc
1：登录窗口代码：Option ExplicitDim X As Integer '保存密码输入错误次数Public tempname As StringPrivate Sub cmdOK_Click() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim strcon As String Dim sql As String Set cn = CreateObject("adodb.connection") Set rs = CreateObject("adodb.recordset") strcon = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=图书销售系统" cn.Open strcon '游客登录 If Combo1.Text = "游客" Then 主窗体.tsgl.Visible = False 主窗体.yhgl.Visible = False 主窗体.gwtd.Visible = False 主窗体.kuc.Visible = False 主窗体.glyzc.Visible = False 主窗体.tshj.Enabled = True 主窗体.Toolbar1.Buttons(1).Visible = False 主窗体.Toolbar1.Buttons(2).Visible = False 主窗体.Toolbar1.Buttons(3).Visible = False 主窗体.Toolbar1.Buttons(4).Visible = False 主窗体.Toolbar1.Buttons(5).Visible = False Unload Me 主窗体.Show Exit Sub End If'非游客用户登录If Trim(Text1.Text) = "" Or Trim(Text2.Text) = "" Then '判断user_ID不能为空 MsgBox "用户登录信息未完整填写，请重新输入！" Text1.SetFocusElse If Combo1.Text = "请选择权限" Then '判断登录权限不能为空 MsgBox "请选择权限", vbOKOnly + vbExclamation, "警告" Combo1.SetFocus Exit Sub ElseIf Combo1.Text = "管理员" Then '管理员登录 userleibie = "管理员" username = Text1.Text sql = "select * from 管理员 where user_ID='" & Trim(Text1.Text) & "'" '由管理员表中查询是否存在 rs.Open sql, cn, adOpenKeyset, adLockPessimistic If rs.EOF = True Then MsgBox "没有这个用户,请重输入！", vbOKOnly + vbExclamation, "警告" Text1.Text = "" Text2.Text = "" Text1.SetFocus Exit Sub Else '主窗体管理员权限开放 主窗体.tsgl.Enabled = True 主窗体.yhgl.Enabled = True 主窗体.tshj.Enabled = True 主窗体.gwtd.Visible = False 主窗体.kuc.Visible = True 主窗体.exit.Enabled = True 主窗体.Toolbar1.Enabled = True 主窗体.Toolbar1.Buttons(4).Visible = False End If ElseIf Combo1.Text = "普通用户" Then '普通用户登录 userleibie = "普通用户" username = Text1.Text sql = "select * from 普通用户 where user_ID='" & Trim(Text1.Text) & "'" rs.Open sql, cn, adOpenKeyset, adLockPessimistic If rs.EOF = True Then MsgBox "没有这个用户,请重输入！", vbOKOnly + vbExclamation, "警告" Text1.Text = "" Text2.Text = "" Text1.SetFocus Exit Sub Else '主窗体普通用户权限开放 主窗体.tsgl.Visible = False 主窗体.glygl.Visible = False 主窗体.kuc.Visible = False 主窗体.glyzc.Visible = False 主窗体.Toolbar1.Buttons(1).Visible = False 主窗体.Toolbar1.Buttons(2).Visible = False 主窗体.Toolbar1.Buttons(5).Visible = False End If End IfEnd If'为非游客登录提供密码认证If Trim(rs.Fields("mima") = Trim(Text2.Text) Then' tempname = Trim$(rs.Fields("真实姓名")' usereal = tempname 主窗体.Show Unload MeElse If X = 2 Then MsgBox "密码输入超过三次,请联系管理员！", vbOKOnly + vbExclamation, "警告" Unload Me Exit Sub End If MsgBox "密码不正确,请重输入！", vbOKOnly + vbExclamation, "警告" Text2.SetFocus Text2.Text = "" X = X + 1 '密码输入错误次数统计End If'End IfEnd SubPrivate Sub cmdCancle_Click() Unload MeEnd SubPrivate Sub Command1_Click()'userzhuce.Combo1.AddItem "普通用户"用户注册.ShowEnd SubPrivate Sub Form_Load()X = 0End Sub2：个人历史消费记录Dim rs_find As New ADODB.RecordsetPrivate Sub Command2_Click()Unload MeEnd SubPrivate Sub Form_Load() Dim cn As ADODB.Connection Dim strcon As String Dim sql As String Set cn = CreateObject("adodb.connection") Set rs_find = CreateObject("adodb.recordset") strcon = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=图书销售系统" cn.Open strcon sql = "select * from lishi where 用户名 = '" & Trim(username) & "'" rs_find.CursorLocation = adUseClient rs_find.Open sql, cn, adOpenKeyset, adLockPessimistic If rs_find.EOF Then MsgBox "你还没有消费记录,那么赶紧消费吧!"Else DataGrid1.AllowAddNew = False DataGrid1.AllowDelete = False DataGrid1.AllowUpdate = False Set DataGrid1.DataSource = rs_find Exit Sub ' 很重要,要与上句合用,不然,显示不出来 End If rs_find.Close End SubPrivate Sub Form_Unload(Cancel As Integer) Set DataGrid1.DataSource = Nothing' rs_find.CloseEnd Sub3：购物车Option ExplicitDim rs As ADODB.RecordsetPrivate Sub Command1_Click()Dim cn As ADODB.Connection Dim strcon As String Dim yi, er, san, si, wu, liu As String Dim qi, n As Integer Dim sql, sqq, sqs, ssq As String Set cn = CreateObject("adodb.connection") Set rs = CreateObject("adodb.recordset") strcon = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=图书销售系统" cn.Open strcon yi = Trim(DataGrid1.Columns(0).CellValue(DataGrid1.Bookmark) er = Trim(DataGrid1.Columns(1).CellValue(DataGrid1.Bookmark) san = Trim(DataGrid1.Columns(2).CellValue(DataGrid1.Bookmark) si = Trim(DataGrid1.Columns(3).CellValue(DataGrid1.Bookmark) wu = Trim(DataGrid1.Columns(4).CellValue(DataGrid1.Bookmark) liu = Trim(DataGrid1.Columns(5).CellValue(DataGrid1.Bookmark)qi = Trim(DataGrid1.Columns(6).CellValue(DataGrid1.Bookmark) If Trim(yi) = "" Then MsgBox "请选择要购买的图书!", vbOKOnly + vbExclamationElseDataGrid1.AllowDelete = TrueDataGrid1.Refresh sqq = "insert into lishi values(" & "'" & yi & "'" & "," & "'" & er & "'" _ & "," & "'" & san & "'" & "," & "'" & si & "'" & "," & "'" & wu _ & "'" & "," & "'" & liu & "'" & "," & "'" & qi & "'" & ")"rs.Open sqq, cn, adOpenKeyset, adLockPessimisticsql = "select * from linshi where 图书编号=" & "'" & yi & "'" & " and " & "数量=" & "'" & qi & "'"rs.Open sql, cn, adOpenKeyset, adLockPessimisticIf rs.EOF Then MsgBox "购物车里的物品已全部购买，请继续其他消费！" Unload Me Else DataGrid1.AllowDelete = True rs.Delete rs.Update DataGrid1.Refresh MsgBox "你已成功购买了该图书，请继续购买其他图书！"rs.Closessq = "select 库存量 from book where 图书编号=" & "'" & yi & "'"rs.Open ssq, cn, adOpenKeyset, adLockPessimisticn = Int(Trim(rs.Fields(0)rs.Closesqs = "update book set 库存量=" & "'" & Int(n - shuliang) & "'" & " where 图书编号=" & "'" & yi & "'"rs.Open sqs, cn, adOpenKeyset, adLockPessimistic End If End IfEnd SubPrivate Sub Command2_Click()Unload MeEnd SubPrivate Sub Form_Load() Dim cn As ADODB.Connection Dim strcon As String Dim sql As String Set cn = CreateObject("adodb.connection") Set rs = CreateObject("adodb.recordset") strcon = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=图书销售系统" cn.Open strcon sql = "select * from linshi " rs.CursorLocation = adUseClient rs.Open sql, cn, adOpenKeyset, adLockPessimistic If rs.EOF Then MsgBox "你还没有消费记录,那么赶紧消费吧!"ElseFrame1.Caption = "欢迎" + Trim(username) + "登录！这是您的购物车！" DataGrid1.AllowAddNew = False DataGrid1.AllowDelete = False DataGrid1.AllowUpdate = False Set DataGrid1.DataSource = rs Exit Sub ' 很重要,要与上句合用,不然,显示不出来 End If End SubPrivate Sub Form_Unload(Cancel As Integer) Set DataGrid1.DataSource = Nothing' rs.CloseEnd Sub4：库存Dim rs As ADODB.RecordsetPrivate Sub cmdcancel_Click()rs.CancelUpdate DataGrid1.Refresh DataGrid1.AllowAddNew = False DataGrid1.AllowUpdate = False cmdmodify.Enabled = True cmdupdate.Enabled = False cmdcancel.Enabled = False Unload Me cmdcancel.Enabled = FalseEnd SubPrivate Sub cmdmodify_Click() '修改库存记录DataGrid1.SetFocusDim answer As String On Error GoTo cmdmodify cmdmodify.Enabled = False cmdupdate.Enabled = True cmdcancel.Enabled = True DataGrid1.AllowUpdate = True Exit Subcmdmodify: If Err.Number <> 0 Then MsgBox Err.Description End If cmdcancel.Enabled = TrueEnd SubPrivate Sub cmdupdate_Click() '确定修改On Error Resume NextIf Not IsNull(DataGrid1.Bookmark) Then rs.Update End If cmdmodify.Enabled = True cmdupdate.Enabled = False cmdcancel.Enabled = False MsgBox "修改成功!", vbOKOnly + vbExclamation, ""End SubPrivate Sub Command1_Click()cmdmodify.Enabled = True Dim cn As ADODB.Connection Dim strcon As String Dim n As Integer Dim sql As String Set cn = CreateObject("adodb.connection") Set rs = CreateObject("adodb.recordset") strcon = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=图书销售系统" cn.Open strcon If Text1.Text = "" And Text2.Text = "" Then MsgBox "请输入相关图书信息进行查询!", vbExclamation + vbOKOnly, "警告！" Else If Option1.Value = True Then Text2.Text = "" If Text1.Text = "" Then MsgBox "请输入图书编号!" sql = "select 图书编号,图书名,库存量 from book where 图书编号=" & "'" & Trim(Text1.Text) & "'" End If If Option2.Value = True Then Text1.Text = "" If Text2.Text = "" Then MsgBox "请输入图书编号!" sql = "select 图书编号,图书名,库存量 from book where 图书名=" & "'" & Trim(Text2.Text) & "'" End If rs.CursorLocation = adUseClient rs.Open sql, cn, adOpenKeyset, adLockPessimistic DataGrid1.AllowAddNew = False DataGrid1.AllowDelete = False DataGrid1.AllowUpdate = False Set DataGrid1.DataSource = rs Exit Sub End IfEnd SubPrivate Sub Command2_Click() Unload MeEnd SubPrivate Sub Form_Load() Set DataGrid1.DataSource = Nothing cmdcancel.Enabled = False cmdmodify.Enabled = False cmdupdate.Enabled = False 'rs.CloseEnd SubPrivate Sub Form_Unload(Cancel As Integer) Set DataGrid1.DataSource = Nothing cmdcancel.Enabled = False 'rs.CloseEnd Sub5：历史消费记录Dim rs_find As New ADODB.RecordsetPrivate Sub Command1_Click()End SubPrivate Sub Command2_Click()Unload MeEnd SubPrivate Sub Form_Load() Dim cn As ADODB.Connection Dim strcon As String Dim sql As String Set cn = CreateObject("adodb.connection") Set rs_find = CreateObject("adodb.recordset") strcon = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=图书销售系统" cn.Open strcon sql = "select * from lishi " rs_find.CursorLocation = adUseClient rs_find.Open sql, cn, adOpenKeyset, adLockPessimistic If rs_find.EOF Then MsgBox "还没有消费记录!"Else DataGrid1.AllowAddNew = False DataGrid1.AllowDelete = False DataGrid1.AllowUpdate = False Set DataGrid1.DataSource = rs_find Exit Sub ' 很重要,要与上句合用,不然,显示不出来 End If rs_find.Close End SubPrivate Sub Form_Unload(Cancel As Integer) Set DataGrid1.DataSource = Nothing' rs_find.CloseEnd Sub6：添加图书类别Private Sub Command1_Click() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim strcon As String Dim sql As String Set cn = CreateObject("adodb.connection") Set rs = CreateObject("adodb.recordset") strcon = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=图书销售系统" cn.Open strcon If Trim(Text1.Text) = "" Then MsgBox "图书类别不能为空 ", vbOK0nly + vbExclamation, "" Text1.SetFocus Exit Sub End If If Trim(Text2.Text) = "" Then MsgBox "新类别必须对应新编号", vbOK0nly + vbExclamation, "" Text2.SetFocus Exit Sub End If sql = "select * from 图书类别 where 类别名称='" & Text1.Text & "'" rs.Open sql, cn, adOpenKeyset, adLockPessimistic If rs.EOF Then rs.AddNew rs.Fields(0) = Trim(Text1.Text) rs.Fields(1) = Trim(Text2.Text) rs.Update MsgBox "添加图书类别成功!", vbOKOnly, "" rs.Close Else MsgBox "图书类别重复！", vbOKOnly + vbExclamation, "" Text1.SetFocus Text1.Text = "" rs.Close Exit SubEnd IfUnload MeEnd SubPrivate Sub Command2_Click() Unload MeEnd Sub7：添加图书信息Private Sub Command1_Click() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim strcon As String Dim n As Integer Dim strsql, sql, sqq As String Set cn = CreateObject("adodb.connection") Set rs = CreateObject("adodb.recordset") strcon = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=图书销售系统" cn.Open strconIf Trim(Text1.Text) = "" Then '确定图书编号不为空 MsgBox "图书编号不能为空", vbOKOnly + vbExclamation, "" Text1.SetFocus Exit SubEnd IfIf Trim(Text2.Text) = "" Then '确定书名不能为空 MsgBox "书名不能为空", vbOKOnly + vbExclamation, "" Text2.SetFocus Exit SubEnd IfIf Trim(Combo1.Text) = "" Then '确定请选择图书种类 MsgBox "请选择图书种类", vbOKOnly + vbExclamation, "" Combo1.SetFocus Exit SubEnd IfIf Trim(Text3.Text) = "" Then '确定作者不为空 MsgBox "作者不能为空", vbOKOnly + vbExclamation, "" Text3.SetFocus Exit SubEnd IfIf Trim(Text4.Text) = "" Then '确定出版社不为空 MsgBox "出版社不能为空", vbOKOnly + vbExclamation, "" Text4.SetFocus Exit SubEnd IfIf Trim(Text5.Text) = "" Then '确定定价不为空 MsgBox "定价不能为空", vbOKOnly + vbExclamation, "" Text5.SetFocus Exit SubEnd Ifstrsql = "select * from book where 图书编号=" & "'" & Trim(Text1.Text) & "'" '判断是否存在相同图书编号sql = "insert into book values(" & "'" & Trim(Text1.Text) & "'" & "," & "'" & Trim(Text2.Text) & "'" & "," & "'" & Trim(Text3.Text) & "'" & "," & "'" & Trim(Text4.Text) & "'" & "," & "'" & Trim(Combo1.Text) & "'" & "," & "'" & Trim(Text5.Text) & "'" & "," & "'" & Trim(Text6.Text) & "'" & "," & "'" & Trim(Text7.Text) & "'" & ")"rs.Open strsql, cn, adOpenKeyset, adLockPessimisticIf rs.EOF Thenrs.Closers.Open sql, cn, adOpenKeyset, adLockPessimisticElsen = rs.Fields(7) + Int(Trim(Text7.Text)sqq = " update book set 库存量=" & "'" & n & "'"rs.Closers.Open sqq, cn, adOpenKeyset, adLockPessimisticEnd If MsgBox "添加书籍信息成功!", vbOKOnly, "" Unload MeEnd SubPrivate Sub Command2_Click() Unload MeEnd SubPrivate Sub Form_Load()Dim cn As ADODB.Connection Dim rs_leibie As ADODB.Recordset Dim strcon As String Dim strsql As String Set cn = CreateObject("adodb.connection") Set rs_leibie = CreateObject("adodb.recordset") strcon = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=图书销售系统" cn.Open strcon sql = "select * from 图书类别" rs_leibie.Open sql, cn, adOpenKeyset, adLockPessimistic rs_leibie.MoveFirstDo While Not rs_leibie.EOF Combo1.AddItem rs_leibie.Fields(0) rs_leibie.MoveNextLooprs_leibie.CloseEnd Sub8：图书类别管理Option ExplicitDim rs_reader As New ADODB.RecordsetPrivate Sub cmdcancel_Click() rs_reader.CancelUpdate DataGrid1.Refresh DataGrid1.AllowAddNew = False DataGrid1.AllowUpdate = False cmddel.Enabled = True cmdmodify.Enabled = True cmdupdate.Enabled = False cmdcancel.Enabled = FalseEnd SubPrivate Sub cmddel_Click() Dim answer As String answer = MsgBox("确定要删除吗？", vbYesNo, "") If answer = vbYes Then DataGrid1.AllowDelete = True rs_reader.Delete rs_reader.Update DataGrid1.Refresh Else Exit Sub End IfEnd SubPrivate Sub cmdmodify_Click() Dim answer As String On Error GoTo
