源程序
1.主窗体
Private Sub add_back_Click() frmbackbookinfo.Show
End Sub
Private Sub add_binf_Click() frmaddbookinfo.Show
End Sub
Private Sub add_book_style_Click() frmaddbookstyle.Show
End Sub
Private Sub add_manager_Click() frmadduser.Show
End Sub
Private Sub add_rinf_Click() frmaddreaderinfo.Show
End Sub
Private Sub add_rstyle_Click() frmaddreaderstyle.Show
End Sub
Private Sub change_binf_Click() frmmodifybookinfo.Show
End Sub
Private Sub change_book_style_Click() frmmodifybookstyle.Show
End Sub
Private Sub delete_binf_Click() frmmodifybookinfo.Show
End Sub
Private Sub delete_book_style_Click() frmmodifybookstyle.Show
End Sub
Private Sub delete_rstyle_Click() frmmodifyreaderstyle.Show
End Sub
Private Sub exit_Click()
End
End Sub
Private Sub find_binf_Click() frmfindbook.Show
End Sub
Private Sub find_lend_Click() frmfindborrowinfo.Show
End Sub
Private Sub find_rinf_Click()
frmfindreader.Show
End Sub
Private Sub password_Click()
frmchangepwd.Show
End Sub
2.Login
Option Explicit
Private Sub cmdOK_Click()
Dim strUserName As String
Dim strPassword As String
Dim strTargetAsp As String
Dim conn As ADODB.Connection
Dim rsLogin As ADODB.Recordset
Dim strSQL As String
If Trim(txtUserName.Text) = "" Then
MsgBox "“用户名”不能为空！"
Exit Sub
Else
strUserName = Trim(txtUserName.Text)
End If
If Trim(txtPassword.Text) = "" Then
MsgBox "“口令”不能为空！"
Exit Sub
Else
strPassword = Trim(txtPassword.Text)
End If
'检查口令、用户身份
Set conn = New ADODB.Connection
conn.Provider = "Microsoft.jet.OLEDB.4.0"
conn.ConnectionString = "D:\图书管理系统\book.mdb"
conn.Open
strUserName = Replace(strUserName, "'", "“")
strSQL = "select*from 系统管理where 用户名='" & strUserName & "'and 密码='" & strPassword & "'"
Set rsLogin = conn.Execute(strSQL)
If rsLogin.EOF Or rsLogin.BOF Then
MsgBox "用户名或口令错误，请检查！"
txtPassword.SelStart = 0
txtPassword.SelLength = Len(txtPassword.Text)
txtPassword.SetFocus
Else
Select Case rsLogin("权限")
Case "领导"
strTargetAsp = "LeadersMain.asp"
Case "主任"
strTargetAsp = "ZhuRenMain.asp"
Case "秘书"
strTargetAsp = "MishuMain.asp"
Case "图书管理员"
strTargetAsp = "TuShuManagerMain.asp"
Case Else
strTargetAsp = "OtherMain.asp"
End Select
SaveSetting "JGYOA", "Login", "UserName", strUserName
Hyperlink.NavigateTo "HTTP://" & "/oa/" & strTargetAsp
End If
'释放变量
Set rsLogin = Nothing
Set conn = Nothing
End Sub
3.frmaddbookinfo
Private Sub Command1_Click()
Dim rs_addbook As New ADODB.Recordset
Dim sql As String
If Trim(Combo1.Text) = " " Then
MsgBox "请选择图书种类", vbOKOnly + vbExclamation, ""
Combo1.SetFocus
Exit Sub
End If
If Trim(Text1.Text) = " " Then
MsgBox "图书编号不能为空", vbOKOnly + vbExclamation, ""
Text1.SetFocus
Exit Sub
End If
If Trim(Text2.Text) = " " Then
MsgBox "书名不能为空", vbOKOnly + vbExclamation, ""
Text2.SetFocus
Exit Sub
End If
If Not IsDate(Text5.Text) Then
MsgBox "请按照yyy-mm-dd格式输入日期", vbOKOnly + vbExclamation, ""
Text5.SetFocus
Exit Sub
End If
If Not IsDate(Text6.Text) Then
MsgBox "请按照yyy-mm-dd格式输入日期", vbOKOnly + vbExclamation, ""
