classcon.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 = "classCon"
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 strField(strID As String, nOrder As Integer, strTable 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 " & strTable & " WHERE 密码='" & strAPWD & "'"
Cnn.Open strCnn
rsR.Open strSQL, Cnn, adOpenStatic, adLockOptimistic
strField = Trim(rsR.Fields(nOrder))
End Function

'验证记录是否存在
Public Function IsRecord(strID As String, strTable 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 " & strTable & " WHERE 姓名='" & strID & "'"
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)
  IsRecord = False
Else
  If rsR.RecordCount > 0 Then
    IsRecord = True
  Else
    IsRecord = False
  End If
End If
End Function

'显示记录
Public Function ListRecord(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 & " ORDER BY 编号 ASC"

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 Function AddRecord(strAddValue As String, strTable 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 " & strTable & " VALUES(" & strAddValue & ")"

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 Sub DelRecord(strID As String, strTable As String)
On Error Resume Next

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

strSQL = " DELETE FROM " & strTable & " WHERE 编号=" & "'" & strID & "'"

Cnn.Open strCnn
Cnn.Errors.Clear
Cnn.Execute strSQL, aff, adExecuteNoRecords
If Cnn.Errors.Count > 0 Then
  RaiseEvent Errs(Cnn.Errors)
Else
  If aff < 1 Then
    RaiseEvent Active(8)
  Else
    RaiseEvent Active(800)
  End If
End If
End Sub

'修改记录
Public Sub ModifyRecord(strID As String, strField As String, strValue As String, strTable As String, strCount As String)
On Error Resume Next

Dim Cnn As New ADODB.Connection
Dim rsR As New ADODB.Recordset
Dim aff As Long
Dim strSQL As String
If strCount = "no" Then
 strSQL = " UPDATE " & strTable & " SET " & strField & "=" & "'" & strValue & "'" & " WHERE 编号=" & "'" & strID & "'"
End If
If strCount = "+1" Then
 strValue = Trim(Str(Val(strValue) + 1))
 strSQL = " UPDATE " & strTable & " SET " & strField & "=" & "'" & strValue & "'" & " WHERE 编号=" & "'" & strID & "'"
End If
If strCount = "-1" Then
 strValue = Trim(Str(Val(strValue) - 1))
 strSQL = " UPDATE " & strTable & " SET " & strField & "=" & "'" & strValue & "'" & " WHERE 编号=" & "'" & strID & "'"
End If
Cnn.Open strCnn
Cnn.Errors.Clear
Cnn.Execute strSQL, aff, adExecuteNoRecords
If Cnn.Errors.Count > 0 Then
  RaiseEvent Errs(Cnn.Errors)
Else
  If aff < 1 Then
    RaiseEvent Active(2)
  Else
    RaiseEvent Active(200)
  End If
End If
End Sub

'通过关键字查记录
Public Function FindRecord(strKey As String, strField As String, 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 & " WHERE " & strField & " LIKE " & "'%" & strKey & "%'" & " ORDER BY 编号 ASC"

Cnn.CursorLocation = adUseClient
Cnn.Open strCnn
Cnn.Errors.Clear
Set FindRecord = 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 CompareRecord(strTable1 As String, strTable2 As String, _
                              strID1 As String, strID2 As String, _
                              nNum1 As Integer, nNum2 As Integer) As Integer
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 * FROM " & strTable2 & " WHERE 编号=" & "'" & strID2 & "'"
Cnn.Open strCnn
Cnn.Errors.Clear

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

Value1 = rsR1.Fields(nNum1)
Value2 = rsR2.Fields(nNum2)

If Value1 > Value2 Then
 CompareRecord = 1
End If
If Value1 = Value2 Then
 CompareRecord = 0
End If
If Value1 < Value2 Then
 CompareRecord = -1
End If
End Function
Public Function strField1(strID As String, nOrder As Integer, strTable 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 " & strTable & " WHERE 编号='" & strID & "'"

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)
  strField1 = ""
Else
  If rsR.RecordCount > 0 Then
    strField1 = Trim(rsR.Fields(nOrder))
  Else
    strField1 = ""
  End If
End If
End Function