vb7e.tmp

第一次用VB编写的图书管理系统,仅供大家参考,呵呵,不足之处多多包含

Attribute VB_Name = "ModMain"
Public DBCon As New ADODB.Connection
Public DBRct As New ADODB.Recordset
Public DBRct_M As New ADODB.Recordset
Function Choose(ByVal strIN As String) As String
Dim bytLen As Byte
 If InStr(strIN, "'") Then
    bytLen = Len(strIN)
    Do
     strIN = Left(strIN, InStr(strIN, "'") - 1) & "’" & Right(strIN, bytLen - InStr(strIN, "'"))
    Loop While InStr(strIN, "'")
 End If
 Choose = Trim(strIN)
End Function
Sub Main()
Unload FrmAL
Unload FrmAdmini
Unload FrmApwd
Unload FrmAstu
Unload FrmBook
Unload FrmB
Unload FrmF
Unload frmStu
Unload FrmSL
Unload FrmReturn
Unload FrmStat
If ConnectToServer() = False Then End
Call DBRct_M.Open("select * from pic", DBCon, adOpenDynamic, adLockOptimistic, -1)
FrmMain.Show
End Sub
Function ConnectToServer() As Boolean
On Error GoTo ConnectErr
 DBCon.ConnectionString = "driver={SQL SERVER};server=(local);uid=sa;pwd=;database=lib"
 DBCon.ConnectionTimeout = 30
 DBCon.Open
ConnectToServer = True
Exit Function
ConnectErr:
 ConnectToServer = False
 MsgBox "错误代码:" & Err.Number & vbCrLf & "错误描述:" & Err.Description, vbCritical, "连接错误"
 If MsgBox("是否重新连接!", vbInformation + vbYesNo, "提示信息") = 6 Then
 DBCon.ConnectionString = "driver={SQL SERVER};server=" & InputBox("输入服务器server", "服务器", "(local)") & ";uid=" & InputBox("输入用户名ID", "ID", "sa") & ";pwd=" & InputBox("输入密码！", "PWd") & ";database=lib"
 DBCon.ConnectionTimeout = 30
 DBCon.Open
 ConnectToServer = True
 End If
End Function
Sub DisConnect()
On Error Resume Next
 If DBCon.State = adStateOpen Then DBCon.Close
End Sub
Function QueryInfo(ByVal strSql As String) As Boolean
On Error GoTo ON_QUERYERR
 Set DBRct = Nothing
 Call DBRct.Open(strSql, DBCon, adOpenDynamic, adLockOptimistic, -1)
 QueryInfo = True: Exit Function
ON_QUERYERR:
 MsgBox "错误代码:" & Err.Number & vbCrLf & "错误描述:" & Err.Description, vbCritical, "错误"
 QueryInfo = False
End Function
Function ExecuteSQL(ByVal strSql As String) As Boolean
 On Error Resume Next
  DBCon.Execute (strSql)
   If Err.Number > 0 Then
    MsgBox "错误代码:" & Err.Number & vbCrLf & "错误描述:" & Err.Description, vbCritical, "错误"
    Err.Clear
    ExecuteSQL = False
  Else
   ExecuteSQL = True
  End If
End Function