clsservicecommand.cls

排队分诊管理系统源代码！该代码使用VB6开发环境

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

Private m_ActiveConnection              As ADODB.Connection
Private m_yxErr                         As New CYXError             '错误对象
Private m_strObjPrefix As String
Private m_strTableName As String                                    '对象所对应的表的名称
Private m_strParentKey As String

Public sc_id            As Currency     '数据编号           decimal         N
Public us_login         As String       '服务员工编号       nvarchar    50  N
Public computer_code    As Integer      '服务计算机编号     nvarchar    50  N
Public windows_code     As Integer      '服务窗口编号       nvarchar    50  N
Public command_time     As String       '下达命令时间       char        8   N
Public command          As String       '下达命令           char        4   N
Public PARA_1           As String       '命令参数1          nvarchar    50  Y
Public PARA_2           As String       '命令参数2          nvarchar    50  Y
Public PARA_3           As String       '命令参数3          nvarchar    50  Y
Public PARA_4           As String       '命令参数4          nvarchar    50  Y
Public PARA_5           As String       '命令参数5          nvarchar    50  Y
Public PARA_6           As String       '命令参数6          nvarchar    50  Y
Public use_yesno        As String       '是否处理           tinyint     1   N

'''''''''''''''''''
' 根据 Recordset 设置对象
Private Function IBaseClass_RecordSet(ByVal rs As ADODB.Recordset) As Boolean
    On Error GoTo ERROR_DEFAULT
    
    If rs Is Nothing Then GoTo ERROR_DEFAULT
    If rs.EOF Then GoTo ERROR_DEFAULT
    
    If Not IsNull(rs!sc_id) Then sc_id = rs!sc_id
    If Not IsNull(rs!us_login) Then us_login = rs!us_login
    If Not IsNull(rs!computer_code) Then computer_code = rs!computer_code
    If Not IsNull(rs!windows_code) Then windows_code = rs!windows_code
    
    If Not IsNull(rs!command_time) Then command_time = rs!command_time
    If Not IsNull(rs!command) Then command = rs!command
    If Not IsNull(rs!PARA_1) Then PARA_1 = rs!PARA_1
    If Not IsNull(rs!PARA_2) Then PARA_2 = rs!PARA_2
    
    If Not IsNull(rs!PARA_3) Then PARA_3 = rs!PARA_3
    If Not IsNull(rs!PARA_4) Then PARA_4 = rs!PARA_4
    If Not IsNull(rs!PARA_5) Then PARA_5 = rs!PARA_5
    If Not IsNull(rs!PARA_6) Then PARA_6 = rs!PARA_6
       
    If Not IsNull(rs!use_yesno) Then use_yesno = rs!use_yesno
    
    IBaseClass_RecordSet = True
    Exit Function
ERROR_DEFAULT:
    If Err <> 0 Then m_yxErr.Raise Err, Err.Description, Err.Source, "IBaseClass_RecordSet"
    IBaseClass_RecordSet = False
End Function

'''''''''''''''''''
'查询操作，如果操作成功则将自身设置为返回的对象
' 如果 strSQL 为空，则根据 sc_id 查询
Public Function IBaseClass_Query(Optional ByVal strSQL As String = "") As Boolean
    On Error GoTo ERROR_DEFAULT
    Dim cmd As New ADODB.command, rs As New ADODB.Recordset
    
    If m_ActiveConnection Is Nothing Then GoTo ERROR_DEFAULT
    Set cmd.ActiveConnection = m_ActiveConnection
    cmd.CommandType = adCmdText
    cmd.CommandText = IIf(Trim(strSQL) <> "", strSQL, _
        "SELECT * FROM " & m_strTableName & " WHERE sc_id = " & sc_id)
    
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenStatic, adLockReadOnly
    Set rs.ActiveConnection = Nothing
    If rs.EOF Then GoTo ERROR_DEFAULT
    If rs.RecordCount <> 1 Then GoTo ERROR_DEFAULT
    If Not IBaseClass_RecordSet(rs) Then GoTo ERROR_DEFAULT
    
    If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
    Set cmd = Nothing
    IBaseClass_Query = True
    Exit Function
ERROR_DEFAULT:
    If Err <> 0 Then m_yxErr.Raise Err, Err.Description, Err.Source, "IBaseClass_Query"
    If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
    Set cmd = Nothing
    IBaseClass_Query = False
End Function

'''''''''''''''''''
'检查操作是否能进行
Public Function IBaseClass_CanDo(ByVal optype As ENUM_OPTYPE) As Boolean
    On Error GoTo ERROR_DEFAULT
    Dim cmd As New ADODB.command, rs As New ADODB.Recordset
    
    If m_ActiveConnection Is Nothing Then GoTo ERROR_DEFAULT
    Set cmd.ActiveConnection = m_ActiveConnection
    cmd.CommandType = adCmdText
    
    '检查数据完整性
    If optype = ENUM_OPTYPE.OPTYPE_INSERT Or optype = ENUM_OPTYPE.OPTYPE_MODIFY Then
        If Trim$(us_login) = "" Then
            m_yxErr.Raise , "服务员工编号不得为空。"
            GoTo ERROR_DEFAULT
        End If
        
        If Not IsNumeric(computer_code) Then
            m_yxErr.Raise , "服务计算机编号输入错误。"
            GoTo ERROR_DEFAULT
        End If
        
        If Not IsNumeric(windows_code) Then
            m_yxErr.Raise , "服务窗口编号不得为空。"
            GoTo ERROR_DEFAULT
        End If
        
        If Trim$(command_time) = "" Then
            m_yxErr.Raise , "下达命令时间输入错误。"
            GoTo ERROR_DEFAULT
        End If
        
        If Trim$(command) = "" Then
            m_yxErr.Raise , "下达命令内容不得为空。"
            GoTo ERROR_DEFAULT
        End If
    End If
    
    '检查数据合法性
    If optype <> OPTYPE_INSERT Then
        If rs.State = adStateOpen Then rs.Close
        cmd.CommandText = "SELECT * FROM " & m_strTableName & " WHERE sc_id = '" & sc_id & "'"
        rs.CursorLocation = adUseClient
        rs.Open cmd, , adOpenStatic, adLockReadOnly
        If rs.RecordCount <> 1 Then
            m_yxErr.Raise , "服务命令id无效。"
            GoTo ERROR_DEFAULT
        End If
    End If
    
    Select Case optype
        Case ENUM_OPTYPE.OPTYPE_INSERT        '增加操作
            If rs.State = adStateOpen Then rs.Close
            cmd.CommandText = "SELECT * FROM " & m_strTableName & " WHERE us_login = '" & us_login & "' " & _
                              "AND computer_code = '" & computer_code & "' " & _
                              "AND windows_code = '" & windows_code & "' " & _
                              "AND command_time = '" & command_time & "' " & _
                              "AND command = '" & command & "'"
            rs.CursorLocation = adUseClient
            rs.Open cmd, , adOpenStatic, adLockReadOnly
            If rs.RecordCount > 0 Then
                m_yxErr.Raise , "服务命令已经存在。"
                GoTo ERROR_DEFAULT
            End If
        Case ENUM_OPTYPE.OPTYPE_MODIFY          '修改操作
            If rs.State = adStateOpen Then rs.Close
            cmd.CommandText = "SELECT * FROM " & m_strTableName & " WHERE sc_id <> '" & sc_id & "'"
            rs.CursorLocation = adUseClient
            rs.Open cmd, , adOpenStatic, adLockReadOnly
            If rs.RecordCount > 0 Then
                m_yxErr.Raise , "服务命令重复存在。"
                GoTo ERROR_DEFAULT
            End If
        Case ENUM_OPTYPE.OPTYPE_DELETE          '删除操作
            
        Case Else ' OPTYPE_AUDIT , OPTYPE_UNAUDIT
            GoTo ERROR_DEFAULT
    End Select
    
    If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
    Set cmd = Nothing
    IBaseClass_CanDo = True
    Exit Function
ERROR_DEFAULT:
    If Err <> 0 Then m_yxErr.Raise Err, Err.Description, Err.Source, "IBaseClass_CanDo"
    If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
    Set cmd = Nothing
    IBaseClass_CanDo = False
End Function

'''''''''''''''''''
'作废操作
Public Function IBaseClass_Blank() As Boolean
    On Error GoTo ERROR_DEFAULT
    Dim iTrans As Integer
    
    If m_ActiveConnection Is Nothing Then GoTo ERROR_DEFAULT
    If Not IBaseClass_CanDo(ENUM_OPTYPE.OPTYPE_BLANK) Then GoTo ERROR_DEFAULT
    
    iTrans = m_ActiveConnection.BeginTrans
    m_ActiveConnection.Execute "UPDATE " & m_strTableName & _
                " SET use_yesno = 1 WHERE sc_id = '" & sc_id & "'"
    If iTrans > 0 Then
        m_ActiveConnection.CommitTrans
        iTrans = 0
    End If
    
    IBaseClass_Blank = True
    Exit Function
ERROR_DEFAULT:
    If iTrans > 0 Then m_ActiveConnection.RollbackTrans
    If Err <> 0 Then m_yxErr.Raise Err, Err.Description, Err.Source, "IBaseClass_Blank"
    IBaseClass_Blank = False
End Function

'''''''''''''''''''
'反作废操作
Public Function IBaseClass_UnBlank() As Boolean
    On Error GoTo ERROR_DEFAULT
    Dim iTrans As Integer
    
    If m_ActiveConnection Is Nothing Then GoTo ERROR_DEFAULT
    If Not IBaseClass_CanDo(ENUM_OPTYPE.OPTYPE_UNBLANK) Then GoTo ERROR_DEFAULT
    
    iTrans = m_ActiveConnection.BeginTrans
    m_ActiveConnection.Execute "UPDATE " & m_strTableName & _
                " SET use_yesno = 0 WHERE sc_id = '" & sc_id & "'"
    If iTrans > 0 Then
        m_ActiveConnection.CommitTrans
        iTrans = 0
    End If
    
    IBaseClass_UnBlank = True
    Exit Function
ERROR_DEFAULT:
    If iTrans > 0 Then m_ActiveConnection.RollbackTrans
    If Err <> 0 Then m_yxErr.Raise Err, Err.Description, Err.Source, "IBaseClass_UnBlank"
    IBaseClass_UnBlank = False
End Function

'''''''''''''''''''
'删除操作
Public Function IBaseClass_Delete() As Boolean
    On Error GoTo ERROR_DEFAULT
    Dim iTrans As Integer
    
    If m_ActiveConnection Is Nothing Then GoTo ERROR_DEFAULT
    If Not IBaseClass_CanDo(ENUM_OPTYPE.OPTYPE_DELETE) Then GoTo ERROR_DEFAULT
    
    iTrans = m_ActiveConnection.BeginTrans
    m_ActiveConnection.Execute "DELETE FROM " & m_strTableName & " WHERE sc_id = '" & sc_id & "'"
    If iTrans > 0 Then
        m_ActiveConnection.CommitTrans
        iTrans = 0
    End If
    
    IBaseClass_Delete = True
    Exit Function
ERROR_DEFAULT:
    If iTrans > 0 Then m_ActiveConnection.RollbackTrans
    If Err <> 0 Then m_yxErr.Raise Err, Err.Description, Err.Source, "IBaseClass_Delete"
    IBaseClass_Delete = False
End Function

'''''''''''''''''''
'修改操作
Public Function IBaseClass_Modify() As Boolean
    On Error GoTo ERROR_DEFAULT
    Dim iTrans As Integer
    
    If m_ActiveConnection Is Nothing Then GoTo ERROR_DEFAULT
    If Not IBaseClass_CanDo(ENUM_OPTYPE.OPTYPE_MODIFY) Then GoTo ERROR_DEFAULT
    
    iTrans = m_ActiveConnection.BeginTrans
    m_ActiveConnection.Execute "UPDATE " & m_strTableName & " SET [us_login] = '" & us_login & "', " & _
                "[computer_code] = '" & computer_code & "', [windows_code] = '" & windows_code & "' , " & _
                "[command_time] = '" & command_time & "', [command] = '" & command & "', " & _
                "[para_1] = '" & PARA_1 & "', [para_2] = '" & PARA_2 & "', " & _
                "[para_3] = '" & PARA_3 & "', [para_4] = '" & PARA_4 & "', " & _
                "[para_5] = '" & PARA_5 & "', [para_6] = '" & PARA_6 & "' " & _
                "WHERE [sc_id] = '" & sc_id & "'"
    If iTrans > 0 Then
        m_ActiveConnection.CommitTrans
        iTrans = 0
    End If
        
    IBaseClass_Modify = True
    Exit Function
ERROR_DEFAULT:
    If iTrans > 0 Then m_ActiveConnection.RollbackTrans
    If Err <> 0 Then m_yxErr.Raise Err, Err.Description, Err.Source, "IBaseClass_Modify"
    IBaseClass_Modify = False
End Function

'''''''''''''''''''
'增加操作
Public Function IBaseClass_Insert() As Boolean
    On Error GoTo ERROR_DEFAULT
    Dim iTrans As Integer
    
    If m_ActiveConnection Is Nothing Then GoTo ERROR_DEFAULT
    If Not IBaseClass_CanDo(ENUM_OPTYPE.OPTYPE_INSERT) Then GoTo ERROR_DEFAULT
    
    iTrans = m_ActiveConnection.BeginTrans
    '向表中插入数据
    m_ActiveConnection.Execute "INSERT INTO " & m_strTableName & "([us_login], [computer_code]," _
                & "[windows_code],[command_time],[command],[para_1],[para_2],[para_3],[para_4],[para_5],[para_6]) " _
                & "VALUES( '" & us_login & "', '" & computer_code & "', '" & windows_code & "', " _
                & "'" & command_time & "', '" & command & "', '" & PARA_1 & "', '" & PARA_2 & "', " _
                & "'" & PARA_3 & "', '" & PARA_4 & "', '" & PARA_5 & "', '" & PARA_6 & "')"
    If iTrans > 0 Then
        m_ActiveConnection.CommitTrans
        iTrans = 0
    End If
                
    IBaseClass_Insert = True
    Exit Function
ERROR_DEFAULT:
    If iTrans > 0 Then m_ActiveConnection.RollbackTrans
    If Err <> 0 Then m_yxErr.Raise Err, Err.Description, Err.Source, "IBaseClass_Insert"
    IBaseClass_Insert = False
End Function

Private Sub Class_Initialize()
    m_strObjPrefix = "SERVICE_COMMAND_CLASS"
    m_strTableName = "ServiceCommand"
    m_yxErr.ObjectName = TypeName(Me)
End Sub

Public Property Get IBaseClass_ParentKey() As String
    If m_strParentKey = "" Then
        IBaseClass_ParentKey = ""
    Else
        IBaseClass_ParentKey = m_strParentKey
    End If
End Property

Public Property Let IBaseClass_ParentKey(strParent As String)
    m_strParentKey = strParent
End Property

Public Property Get IBaseClass_Key(Optional ByVal strID As String = "") As String
    If strID <> "" Then
        IBaseClass_Key = m_strObjPrefix & strID
        Exit Property
    End If
    IBaseClass_Key = m_strObjPrefix & sc_id
End Property

Public Property Get IBaseClass_TableName() As String
    IBaseClass_TableName = m_strTableName
End Property

Public Property Get IBaseClass_yxErr() As CYXError
    Set IBaseClass_yxErr = m_yxErr
End Property

Public Property Get IBaseClass_Prefix() As String
    IBaseClass_Prefix = m_strObjPrefix
End Property

Friend Property Let IBaseClass_Prefix(str As String)
    m_strObjPrefix = str
End Property

Public Property Set IBaseClass_ActiveConnection(ByVal vData As ADODB.Connection)
    If Not vData Is Nothing Then Set m_ActiveConnection = vData
End Property

Public Property Get IBaseClass_ActiveConnection() As ADODB.Connection
    Set IBaseClass_ActiveConnection = m_ActiveConnection
End Property