clscustservice.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 = "clsCustService"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Dim m_tagErrInfo                As TYPE_ERRORINFO       ' 错误信息

Public Event ServerStop(ByVal iMode As Integer)
Public Event PrintInfo(ByVal iMode As Integer)

Public Property Get ConnectInfo() As Boolean
Attribute ConnectInfo.VB_Description = "判断是否连接数据库"
    ConnectInfo = bolDBStatus
End Property

Public Function AddQueue(ByVal sService As String, ByRef sCustCode As String) As Boolean
    On Error GoTo ERROR_EXIT
    Dim sCode As String, iCode As Long
    Dim rs As New ADODB.Recordset, cmd As New ADODB.Command
    Dim strSQL As String, iTrans As Integer
    Dim iServerID As Integer
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '判断系统是否能启动 - 启动服务和时间检查
    If Check_Set = False Then
        AddQueue = False
        RaiseEvent ServerStop(1)                        '1 - 没有排队启动服务
        Exit Function
    End If
    
    iCode = 0
    If Check_Service_Code(sService, iServerID) = False Then
        AddQueue = False
        RaiseEvent ServerStop(2)                        '2 - 排队队列没有登记
        Exit Function
    End If
    
    '连接数据库
    cmd.ActiveConnection = dbMyDB
    cmd.CommandType = adCmdText
    
    strSQL = "SELECT TOP 1 * FROM CustomerQueue WHERE cq_start_data = '" & Date & "' ORDER BY cq_id DESC"
    cmd.CommandText = strSQL
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenStatic, adLockReadOnly
    If rs.EOF Or rs.RecordCount < 1 Then
        iCode = 0
    Else
        sCode = rs!cq_code
        If Not IsNumeric(sCode) Then
            AddQueue = False
            RaiseEvent ServerStop(3)                    '3 - 排队顾客编号不正确
            Exit Function
        End If
        iCode = CLng(sCode)
    End If
    rs.Close
    
    iCode = iCode + 1
    '生成客户编码
    sCode = Format(iCode, "0000")
    
    iTrans = dbMyDB.BeginTrans
    
    dbMyDB.Execute "INSERT INTO CustomerQueue([cq_code], [cq_start_data]," _
                & "[cu_start_time],[cu_name]," _
                & "[cu_end_time],[service_time]," _
                & "[service_queue],[service_process], " _
                & "[service_state],[other_queue]) " _
                & "VALUES( '" _
                & sCode & "', '" & Date & "', '" _
                & Date & " " & Time & "', Null, " _
                & "Null, Null, '" _
                & iServerID & "', '" & 0 & "', " _
                & "Null, Null)"
                
    If iTrans > 0 Then
        dbMyDB.CommitTrans
        iTrans = 0
    End If
    
    '打印排队数据
    If Print_Queue_Info(sCode) = False Then
        AddQueue = False
        RaiseEvent ServerStop(4)                        '4 - 打印票签错误
        Exit Function
    End If
    
    If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
    Set cmd = Nothing
    
    sCustCode = sCode
    AddQueue = True
    RaiseEvent ServerStop(0)                            '0 - 排队数据正确完成
    Exit Function
ERROR_EXIT:
    If iTrans > 0 Then dbMyDB.RollbackTrans
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "clsCustService"
    m_tagErrInfo.strErrFunc = "AddQueue"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    sCustCode = ""
    AddQueue = False
    RaiseEvent ServerStop(9)                            '9 - 数据库更新错误
End Function

'检查服务类型是否存在
Private Function Check_Service_Code(ByVal sService As String, ByRef iService As Integer) As Boolean
    On Error GoTo ERROR_EXIT
    Dim rs As New ADODB.Recordset, cmd As New ADODB.Command
    Dim strSQL As String
    
    If Not IsNumeric(sService) Then GoTo ERROR_EXIT
    iService = CInt(sService)
    
    '连接数据库
    cmd.ActiveConnection = dbMyDB
    cmd.CommandType = adCmdText
    
    strSQL = "SELECT * FROM Style WHERE st_code = '" & sService & "' AND st_type = 1"
    cmd.CommandText = strSQL
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenStatic, adLockReadOnly
    If rs.EOF Or rs.RecordCount > 1 Then
        GoTo ERROR_EXIT
    Else
        iService = rs!st_id
    End If
        
    If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
    Set cmd = Nothing
        
    Check_Service_Code = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "clsCustService"
    m_tagErrInfo.strErrFunc = "Check_Service_Code"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    iService = -1
    Check_Service_Code = False
End Function

'启动服务和时间检查
Private Function Check_Set() As Boolean
    On Error GoTo ERROR_EXIT
    Dim rs As New ADODB.Recordset, cmd As New ADODB.Command
    Dim strSQL As String, bServer As Boolean
    Dim iResult As Integer, sTime As String
    
    '连接数据库
    cmd.ActiveConnection = dbMyDB
    cmd.CommandType = adCmdText
    
    iResult = 0
    bServer = False
    
    '判断是否服务
    strSQL = "SELECT TOP 1 * FROM QueueSystemServer WHERE qs_code = 'QueueServer' ORDER BY qs_id DESC"
    cmd.CommandText = strSQL
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenStatic, adLockReadOnly
    If Not rs.EOF Or rs.RecordCount > 0 Then
        iResult = rs!qs_type
        sTime = rs!qs_time
    End If
    
    If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
    Set cmd = Nothing
    
    sTime = DateValue(sTime)
    If sTime <> Date Then
        bServer = False
    Else
        If iResult = 1 Then
            bServer = True
        Else
            bServer = False
        End If
    End If
    
    '没有启动服务
    If bServer = False Then
        If my_service_stop_print.stop_service_set = True Then
            '打印停止服务信息
            Print_Stop_Info my_service_stop_print.print_date
        End If
        Check_Set = False
        Exit Function
    End If
    
    '检查是否到启动服务的时间
    If my_time_set.time_use = True Then
        If Time < TimeValue(my_time_set.time_start) Or Time > TimeValue(my_time_set.time_end) Then
            '不在服务时间内
            Check_Set = False
            Exit Function
        End If
    End If
    
    Check_Set = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "clsCustService"
    m_tagErrInfo.strErrFunc = "Check_Service_Code"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    Check_Set = False
End Function

'打印客户排队票签
Private Function Print_Queue_Info(ByVal sCode As String) As Boolean
    On Error GoTo ERROR_EXIT
    Dim dlgReport As rptPrintQueue                      ' 报表控件窗体
    Dim sCustomerCode As String, sDate As String
    
    sCustomerCode = sCode
    sDate = Date
        
    Set dlgReport = New rptPrintQueue
    If Not dlgReport.ShowReport(sCustomerCode, sDate) Then GoTo ERROR_EXIT
    dlgReport.PrintReport False
    
    Unload dlgReport
    Set dlgReport = Nothing
    
    Print_Queue_Info = True
    RaiseEvent PrintInfo(0)                             '0 - 打印正常完成
    Exit Function
ERROR_EXIT:
    Unload dlgReport
    Set dlgReport = Nothing
    
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "clsCustService"
    m_tagErrInfo.strErrFunc = "Print_Queue_Info"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    Print_Queue_Info = False
    RaiseEvent PrintInfo(9)                             '9 - 其他打印错误,数据库类
End Function

'打印停止服务信息
Private Sub Print_Stop_Info(ByVal sInfo As String)
    On Error GoTo ERROR_EXIT
    Dim dlgReport As rptPrintStop                       '报表控件窗体
    Dim sPrintInfo As String, sDate As String
    
    sPrintInfo = sInfo
    sDate = Date
     
    Set dlgReport = New rptPrintStop
    If Not dlgReport.ShowReport(sPrintInfo, sDate) Then GoTo ERROR_EXIT
    dlgReport.PrintReport False
    
    Unload dlgReport
    Set dlgReport = Nothing
    
    RaiseEvent PrintInfo(0)                             '0 - 打印正常完成
    Exit Sub
ERROR_EXIT:
    Unload dlgReport
    Set dlgReport = Nothing
    
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "clsCustService"
    m_tagErrInfo.strErrFunc = "Print_Stop_Info"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    RaiseEvent PrintInfo(9)                             '9 - 其他打印错误,数据库类
End Sub