classborrow.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 = "classBorrow"
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 Function DayCount(strDQ As String) As Integer
Dim dYear As Integer, dMonth As Integer, dDay As Integer
Dim runDay As Integer
Dim i As Integer
Dim Cnt As Integer
Dim strToday As String

dYear = Year(Date)
dMonth = Month(Date)
dDay = Day(Date)
Cnt = 0
For i = dDay To 1 Step -1
 strToday = Trim(Str(dYear)) & "-" & Trim(Str(dMonth)) & "-" & Trim(Str(i))
 Cnt = Cnt + 1
 If i = 1 Then
   If dMonth > 1 Then
    dMonth = dMonth - 1
   Else
    dMonth = 12
    dYear = dYear - 1
   End If
  Select Case dMonth
    Case 1, 3, 5, 7, 8, 10, 12
      i = 31
    Case 2
      If RunYear(dYear) Then
        i = 29
      Else
        i = 28
      End If
    Case Else
      i = 30
   End Select
  End If
 If StrComp(strDQ, strToday) = 0 Then
   DayCount = Cnt
   Exit Function
 End If
Next i
End Function

'归还所借图书
Public Function ReturnBook(strBookID As String, strReaderID As String, strAdminID) As Boolean
On Error Resume Next

Dim Cnn As New ADODB.Connection
Dim rsR As New ADODB.Recordset
Dim aff As Long
Dim strSQL As String
Dim dToday As String

dToday = Date
strSQL = " UPDATE BRInfo SET 是否还=0 ,是否超期=0, 归还时间=" & "'" & dToday & "'" & _
              ", 操作员编号=" & "'" & strAdminID & "'" & _
                "WHERE 图书编号=" & "'" & strBookID & "'" & _
              " AND " & "读者编号=" & "'" & strReaderID & "'"
Cnn.Open strCnn
Cnn.Errors.Clear
Cnn.Execute strSQL, aff, adExecuteNoRecords
If Cnn.Errors.Count > 0 Then
  RaiseEvent Errs(Cnn.Errors)
  ReturnBook = False
Else
  If aff < 1 Then
    RaiseEvent Active(2)
  Else
    RaiseEvent Active(200)
  End If
  ReturnBook = True
End If
End Function

'借阅图书馆图书
Public Function Borrow(strBookID As String, strBookName As String, _
                       strReaderID As String, strReaderName As String, _
                       strAdminID As String, DayCount As Integer) As Boolean
                       
Dim Cnn As New ADODB.Connection
Dim rsR As New ADODB.Recordset
Dim strSQL As String
Dim strID As String
Dim dateBorrow As String
Dim dqDate As String
Dim dYear As Integer
Dim dMonth As Integer
Dim dDay As Integer
Dim runDay As Integer
Dim i As Integer
'----------------------------------
dYear = Val(Year(Date))
dMonth = Val(Month(Date))
dDay = Val(Day(Date))

If RunYear(dYear) Then   '二月份是29天
  runDay = 29
Else
  runDay = 28
End If

For i = 0 To DayCount
  Select Case dMonth
    Case 1, 3, 5, 7, 8, 10, 12:
     If dDay < 31 Then
      dDay = dDay + 1
     ElseIf dMonth < 12 Then
      dMonth = dMonth + 1
      dDay = 1
     Else
      dYear = dYear + 1
      dMonth = 1
      dDay = 1
     End If
    Case 4, 6, 9, 11:
     If dDay < 30 Then
      dDay = dDay + 1
     ElseIf dMonth < 12 Then
      dMonth = dMonth + 1
      dDay = 1
     Else
      dYear = dYear + 1
      dMonth = 1
      dDay = 1
     End If
    Case 2:
     If dDay < runDay Then
      dDay = dDay + 1
     Else
      dMonth = dMonth + 1
      dDay = 1
     End If
  End Select
  Next i
'----------------------------------
dqDate = Trim(Str(dYear)) & "-" & Trim(Str(dMonth)) & "-" & Trim(Str(dDay))
dateBorrow = Date

strID = InitID("BRInfo")

strSQL = "INSERT INTO BRInfo VALUES "
strSQL = strSQL & "(" & "'" & strID & "'" & "," & _
                "'" & strBookID & "'" & "," & _
                "'" & strBookName & "'" & "," & _
                "'" & strReaderID & "'" & "," & _
                "'" & strReaderName & "'" & "," & _
                "'" & dateBorrow & "'" & "," & _
                "'" & dqDate & "'" & "," & _
                "'" & "未还" & "'" & "," & _
                1 & "," & _
                "'" & strAdminID & "'" & "," & 0 & ")"
                                         
Cnn.Open strCnn
Cnn.Errors.Clear
Cnn.Execute strSQL, , adExecuteNoRecords
If Cnn.Errors.Count > 0 Then
  Cnn.RollbackTrans
  Borrow = False
Else
  Borrow = True
  RaiseEvent Active(700)
End If
End Function

Private Function InitID(strTable As String) As String
Dim Cnn As New ADODB.Connection
Dim rsR As New ADODB.Recordset
Dim strSQL As String
Dim strID As String

strSQL = "SELECT * from " & strTable

Cnn.Open strCnn
Cnn.Errors.Clear

rsR.Open strSQL, Cnn, adOpenStatic, adLockOptimistic

If rsR.RecordCount > 0 Then
 rsR.MoveLast
 strID = rsR![编号]
Else
 strID = 0
End If

InitID = Trim(Str(Val(strID) + 1))
End Function

'判断是否是润年，是则返回True
Private Function RunYear(ddYear As Integer) As Boolean
If (ddYear Mod 4) = 0 Then
 If (ddYear Mod 100) <> 0 Then
  RunYear = True
 ElseIf (ddYear Mod 400) = 0 Then
 RunYear = True
 Else
 RunYear = False
 End If
Else
 RunYear = False
End If

End Function

'记录比较
Public Function cmpRecord(strTable1 As String, strTable2 As String, _
                              strID1 As String, strID2 As String, _
                              nNum1 As Integer) As Integer
On Error Resume Next

Dim Cnn As New ADODB.Connection
Dim rsR1 As New ADODB.Recordset
Dim rsR2 As New ADODB.Recordset
Dim strSQL1 As String
Dim strSQL2 As String

Dim Value1
Dim Value2

strSQL1 = "SELECT * FROM " & strTable1 & " WHERE 编号=" & "'" & strID1 & "'"
strSQL2 = "SELECT COUNT(*) AS '借出本数' FROM " & strTable2 & " WHERE 读者编号=" & "'" & strID2 & "'" & _
                                               " AND 是否还=1"
Cnn.Open strCnn
Cnn.Errors.Clear

rsR1.Open strSQL1, Cnn, adOpenStatic, adLockOptimistic
rsR2.Open strSQL2, Cnn, adOpenStatic, adLockOptimistic

Value1 = rsR1.Fields(nNum1)
Value2 = rsR2![借出本数]

If Value1 > Value2 Then
 cmpRecord = 1
End If
If Value1 = Value2 Then
 cmpRecord = 0
End If
End Function

'验证记录是否存在
Public Function IsBorrow(strBookID As String, strReaderID 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 = "SELECT * FROM BRInfo WHERE 图书编号=" & " '" & strBookID & "'" & _
              " AND " & "读者编号=" & "'" & strReaderID & "'" & _
              " AND " & "是否还=1"
Cnn.CursorLocation = adUseClient
Cnn.Open strCnn
Cnn.Errors.Clear
Set rsR = Cnn.Execute(strSQL, , adCmdText)
If Cnn.Errors.Count > 0 Then
  RaiseEvent Errs(Cnn.Errors)
  IsBorrow = False
Else
  If rsR.RecordCount > 0 Then
    IsBorrow = True
  Else
    IsBorrow = False
  End If
End If
End Function

'查找记录是否超期
Public Sub seekOver(strToday As String)
On Error Resume Next
Dim Cnn As New ADODB.Connection
Dim rsR As New ADODB.Recordset
Dim strSQL As String
Dim strRecordDate As String

strSQL = "SELECT * FROM BRInfo WHERE 是否还=1"
Cnn.Open strCnn
Cnn.Errors.Clear
rsR.Open strSQL, Cnn, adOpenStatic, adLockOptimistic
rsR.MoveFirst
While Not rsR.EOF
  strRecordDate = rsR![到期时间]
  If StrComp(strRecordDate, strToday) < 0 Then
    rsR![是否超期] = 1
  End If
  rsR.MoveNext
Wend
rsR.Close
End Sub

'交罚款
Public Function JFK(strReaderID As String, strBookID As String, _
                    strBookName As String, nDay As Integer, mMoney As Double, _
                    strCause As String, AdminID As String) As Boolean
On Error Resume Next

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

strDay = Date

strSQL = "INSERT INTO ForfeitInfo VALUES(" & "'" & strReaderID & "'" & "," & _
                 "'" & strBookID & "'" & "," & _
                 "'" & strBookName & "'" & "," & _
                 nDay & "," & mMoney & "," & _
                 "'" & strDay & "'" & "," & _
                 "'" & strCause & "'" & "," & "'" & AdminID & "'" & ")"
Cnn.Open strCnn
Cnn.Errors.Clear
Cnn.Execute strSQL, , adExecuteNoRecords
If Cnn.Errors.Count > 0 Then
  Cnn.RollbackTrans
  JFK = False
Else
  JFK = True
  RaiseEvent Active(700)
End If

End Function