classt.cls

基于vb的图书管理系统的设计

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "classT"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Event Active(ByVal Status As Long)
Public Event Errs(ErrCon As Object)


Public Sub TypeRecord(strTable As String, cboType As ComboBox)
On Error Resume Next

Dim Cnn As New ADODB.Connection
Dim rsR As New ADODB.Recordset
Dim strSQL As String

strSQL = "SELECT * FROM " & strTable
Cnn.Open strCnn
rsR.Open strSQL, Cnn, adOpenStatic, adLockOptimistic
rsR.MoveFirst
cboType.Clear
While Not rsR.EOF
  cboType.AddItem Trim(rsR![类型名称])
  rsR.MoveNext
Wend

End Sub

'添加图书记录
Public Function AddRecord(strID As String, strName As String, strAuthor As String, _
                          strPublic As String, datePublic As String, fPrice As Double, _
                          nPage As Integer, strType As String, dateLogin As String, _
                          nCount As Integer, strRemark As String) As Boolean
On Error Resume Next

Dim Cnn As New ADODB.Connection
Dim rsR As New ADODB.Recordset
Dim strSQL As String

strSQL = "INSERT INTO BookInfo VALUES(" & "'" & strID & " '" & "," & _
                                      "'" & strName & "'" & "," & _
                                      "'" & strAuthor & "'" & "," & _
                                      "'" & strPublic & "'" & "," & _
                                      "'" & datePublic & "'" & "," & _
                                      fPrice & "," & nPage & "," & _
                                      "'" & strType & "'" & "," & _
                                      "'" & dateLogin & "'" & "," & _
                                      nCount & "," & 0 & "," & _
                                      "'" & strRemark & "'" & ")"

Cnn.Open strCnn
Cnn.Errors.Clear
Cnn.Execute strSQL, , adExecuteNoRecords
If Cnn.Errors.Count > 0 Then
  Cnn.RollbackTrans
  AddRecord = False
Else
  Cnn.CommitTrans
  AddRecord = True
  RaiseEvent Active(700)
End If
End Function

Public Function strID(strType As String) As String
On Error Resume Next

Dim Cnn As New ADODB.Connection
Dim rsR As New ADODB.Recordset
Dim strSQL As String
Dim aff As Long
strSQL = "SELECT * FROM ReaderType WHERE 类型名称=" & " '" & strType & " '"
Cnn.Open strCnn
Cnn.Errors.Clear
Set rsR = Cnn.Execute(strSQL, aff, adCmdText)
If Cnn.Errors.Count > 0 Then
 RaiseEvent Errs(Cnn.Errors)
Else
 If aff < 1 Then
  RaiseEvent Active(2)
 Else
  RaiseEvent Active(200)
 End If
 strID = Trim(rsR![编号])
End If
End Function

'显示记录
Public Function ListRecord(strTable As String, strTjField As String, strTjValue As String, nStyle As Integer) As ADODB.Recordset
On Error Resume Next

Dim Cnn As New ADODB.Connection
Dim rsR As New ADODB.Recordset
Dim strSQL As String
Dim nValue As Integer

If nStyle = 1 Then
  nValue = Val(strTjValue)
  strSQL = "SELECT 图书编号,图书名称,读者编号,读者姓名,借阅时间,到期时间,归还时间,操作员编号 FROM " & strTable & _
     " WHERE " & strTjField & "=" & nValue & " ORDER BY 编号 ASC"
End If
If nStyle = 2 Then
  strSQL = "SELECT 图书编号,图书名称,读者编号,读者姓名,借阅时间,到期时间,操作员编号 FROM " & strTable & _
     " WHERE " & strTjField & "=" & "'" & strTjValue & "'" & " ORDER BY 编号 ASC"
End If
Cnn.CursorLocation = adUseClient
Cnn.Open strCnn
Cnn.Errors.Clear
Set ListRecord = Cnn.Execute(strSQL, , adCmdText)
If Cnn.Errors.Count > 0 Then
  RaiseEvent Errs(Cnn.Errors)
Else
  If rsR.EOF Then
    RaiseEvent Active(3)
  Else
    RaiseEvent Active(300)
  End If
End If
End Function
'收集超期读者编号
Public Sub readerID(cboType As ComboBox)
On Error Resume Next

Dim Cnn As New ADODB.Connection
Dim rsR As New ADODB.Recordset
Dim strSQL As String

strSQL = "SELECT DISTINCT 读者编号 FROM BRInfo WHERE 是否超期=1"
Cnn.Open strCnn
rsR.Open strSQL, Cnn, adOpenStatic, adLockOptimistic
If rsR.RecordCount > 0 Then
rsR.MoveFirst
cboType.Clear
While Not rsR.EOF
  cboType.AddItem Trim(rsR![读者编号])
  rsR.MoveNext
Wend
Else
 Exit Sub
End If
End Sub
'收集超期图书编号
Public Sub BookID(cboType As ComboBox, strReaderID As String)
On Error Resume Next

Dim Cnn As New ADODB.Connection
Dim rsR As New ADODB.Recordset
Dim strSQL As String

strSQL = "SELECT DISTINCT 图书编号 FROM BRInfo WHERE 是否超期=1 AND 读者编号=" & "'" & strReaderID & "'"
Cnn.Open strCnn
rsR.Open strSQL, Cnn, adOpenStatic, adLockOptimistic
If rsR.RecordCount > 0 Then
rsR.MoveFirst
cboType.Clear
While Not rsR.EOF
  cboType.AddItem Trim(rsR![图书编号])
  rsR.MoveNext
Wend
Else
 Exit Sub
End If
End Sub

'显示罚款记录
Public Function ListForfeit(strReaderID As String) As ADODB.Recordset
On Error Resume Next

Dim Cnn As New ADODB.Connection
Dim rsR As New ADODB.Recordset
Dim strSQL As String

strSQL = "SELECT 图书编号,图书名称,借阅时间,到期时间,操作员编号 FROM BRInfo WHERE 读者编号=" & "'" & strReaderID & "'" & " AND " & _
          "是否超期=1"
          
Cnn.CursorLocation = adUseClient
Cnn.Open strCnn
Cnn.Errors.Clear
Set ListForfeit = Cnn.Execute(strSQL, , adCmdText)
If Cnn.Errors.Count > 0 Then
  RaiseEvent Errs(Cnn.Errors)
Else
  If rsR.EOF Then
    RaiseEvent Active(3)
  Else
    RaiseEvent Active(300)
  End If
End If
End Function

'提取超期记录的到期时间
Public Function dateDQ(strReaderID As String, strBookID As String, strBookName As String) As String
On Error Resume Next

Dim Cnn As New ADODB.Connection
Dim rsR As New ADODB.Recordset
Dim strSQL As String

strSQL = "SELECT * FROM BRInfo WHERE 读者编号=" & "'" & strReaderID & "'" & " AND " & _
             "图书编号=" & "'" & strBookID & "'" & " AND " & _
             "图书名称=" & "'" & strBookName & "'" & " AND " & _
          "是否超期=1"
          
Cnn.CursorLocation = adUseClient
Cnn.Open strCnn
Cnn.Errors.Clear
rsR.Open strSQL, Cnn, adOpenStatic, adLockOptimistic
dateDQ = Trim(rsR![到期时间])

End Function

'显示记录
Public Function ListFK(strTable As String) As ADODB.Recordset
On Error Resume Next

Dim Cnn As New ADODB.Connection
Dim rsR As New ADODB.Recordset
Dim strSQL As String

strSQL = "SELECT * FROM " & strTable

Cnn.CursorLocation = adUseClient
Cnn.Open strCnn
Cnn.Errors.Clear
Set ListFK = Cnn.Execute(strSQL, , adCmdText)
If Cnn.Errors.Count > 0 Then
  RaiseEvent Errs(Cnn.Errors)
Else
  If rsR.EOF Then
    RaiseEvent Active(3)
  Else
    RaiseEvent Active(300)
  End If
End If
End Function