modwinsock.bas

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

'停止信息服务
Private Function service_stop(ByVal data As String) As Integer
    On Error GoTo ERROR_EXIT
    Dim sFunction As String, sPara() As String
    
    sPara = Split(data, vbTab)
    sFunction = UCase(sPara(0))
    If UBound(sPara) = 0 Then GoTo ERROR_EXIT
    If sFunction <> "STOI" Then GoTo ERROR_EXIT
    If UCase(sPara(1)) <> "OK" Then GoTo ERROR_EXIT
    
    service_stop = 0
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modWinsock"
    m_tagErrInfo.strErrFunc = "service_stop"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    service_stop = 9
End Function

'刷新服务信息
Private Function service_info(ByVal data As String) As Integer
    On Error GoTo ERROR_EXIT
    Dim sFunction As String, sPara() As String
    Dim sInfo1() As String, sInfo2() As String, i As Integer
    
    sPara = Split(data, vbTab)
    sFunction = UCase(sPara(0))
    If UBound(sPara) = 0 Then GoTo ERROR_EXIT
    If sFunction <> "REFI" Then GoTo ERROR_EXIT
    
    If UCase(sPara(1)) = "OK" Then
        If UBound(sPara) <> 5 Then GoTo ERROR_EXIT
        If sPara(3) <> m_strOld Then GoTo ERROR_EXIT
        
        Select Case sPara(2)
            Case "QUEU"
                m_iCustomerNum = CInt(sPara(4))
                m_iTotalNum = CInt(sPara(5))
                                
                frmQueue.Refresh_Info 1
            Case "SERV"
                sInfo1 = Split(sPara(4), " ")
                sInfo2 = Split(sPara(5), " ")
                
                ReDim queue_service(UBound(sInfo1))
                For i = 0 To UBound(sInfo1)
                    queue_service(i).service_id = CInt(sInfo1(i))
                    queue_service(i).service_name = sInfo2(i)
                    
                    If sInfo1(i) = my_service_type.service_id Then
                        queue_service(i).service_use = True
                    Else
                        queue_service(i).service_use = False
                    End If
                Next i
            Case Else
                GoTo ERROR_EXIT
        End Select
    Else
        If sPara(2) <> m_strOld Then GoTo ERROR_EXIT
        
        Select Case CInt(sPara(3))
            Case 1
                Debug.Print "用户工号不正确！", vbCritical + vbOKOnly, "系统错误"
            Case 2
                Debug.Print "系统命令不正确！", vbCritical + vbOKOnly, "系统错误"
            Case Else
                Debug.Print "其他数据服务错误！", vbCritical + vbOKOnly, "系统错误"
        End Select
        service_info = CInt(sPara(3))
        Exit Function
    End If
    
    service_info = 0
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modWinsock"
    m_tagErrInfo.strErrFunc = "service_info"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    service_info = 9
End Function

'////////////////////////////////////////////////////////////////////////////////////////////////////////
'/                                                                                                      /
'/      以下是业务处理信息，由服务人员端传入中心服务端处理                                              /
'/                                                                                                      /
'////////////////////////////////////////////////////////////////////////////////////////////////////////
'客户顺呼
Private Function cust_trans(ByVal data As String) As Integer
    On Error GoTo ERROR_EXIT
    Dim sFunction As String, sPara() As String
    
    sPara = Split(data, vbTab)
    sFunction = UCase(sPara(0))
    If UBound(sPara) = 0 Then GoTo ERROR_EXIT
    If sFunction <> "CTRI" Then GoTo ERROR_EXIT
    If sPara(2) <> m_strOld Then GoTo ERROR_EXIT
    
    If UCase(sPara(1)) = "OK" Then
        If Not IsNumeric(sPara(3)) Then
            MsgBox "客户编号不正确！", vbCritical + vbOKOnly, "系统错误"
            cust_trans = 2
            Exit Function
        End If
        m_sCustomerCode = sPara(3)
        m_bService = True                               '呼叫成功，开始排队工作
        frmQueue.EnableButton True
        frmQueue.Refresh_Info 1
    Else
        Select Case CInt(sPara(3))
            Case 1
                Debug.Print "用户工号不正确！", vbCritical + vbOKOnly, "系统错误"
            Case 2
                MsgBox "客户编号不正确！", vbCritical + vbOKOnly, "系统错误"
            Case Else
                Debug.Print "其他数据服务错误！", vbCritical + vbOKOnly, "系统错误"
        End Select
        cust_trans = CInt(sPara(3))
        Exit Function
    End If
    
    cust_trans = 0
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modWinsock"
    m_tagErrInfo.strErrFunc = "cust_trans"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    cust_trans = 9
End Function

'服务完成
Private Function cust_finish(ByVal data As String) As Integer
    On Error GoTo ERROR_EXIT
    Dim sFunction As String, sPara() As String
    
    sPara = Split(data, vbTab)
    sFunction = UCase(sPara(0))
    If UBound(sPara) = 0 Then GoTo ERROR_EXIT
    If sFunction <> "FENI" Then GoTo ERROR_EXIT
    If sPara(2) <> m_strOld Then GoTo ERROR_EXIT
    
    If UCase(sPara(1)) = "OK" Then
        If sPara(3) <> m_sCustomerCode Then
            MsgBox "客户编号不正确！", vbCritical + vbOKOnly, "系统错误"
            cust_finish = 2
            Exit Function
        End If
        m_sCustomerCode = ""
        m_bService = False                               '呼叫成功，开始排队工作
        frmQueue.EnableButton True
        frmQueue.Refresh_Info 1
    Else
        Select Case CInt(sPara(3))
            Case 1
                Debug.Print "用户工号不正确！", vbCritical + vbOKOnly, "系统错误"
            Case 2
                MsgBox "客户编号不正确！", vbCritical + vbOKOnly, "系统错误"
            Case 3
                MsgBox "服务状态不正确！", vbCritical + vbOKOnly, "系统错误"
            Case Else
                Debug.Print "其他数据服务错误！", vbCritical + vbOKOnly, "系统错误"
        End Select
        cust_finish = CInt(sPara(3))
        Exit Function
    End If
    
    cust_finish = 0
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modWinsock"
    m_tagErrInfo.strErrFunc = "cust_finish"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    cust_finish = 9
End Function

'客户重呼
Private Function cust_repeat(ByVal data As String) As Integer
    On Error GoTo ERROR_EXIT
    Dim sFunction As String, sPara() As String
    
    sPara = Split(data, vbTab)
    sFunction = UCase(sPara(0))
    If UBound(sPara) = 0 Then GoTo ERROR_EXIT
    If sFunction <> "CREI" Then GoTo ERROR_EXIT
    If sPara(2) <> m_strOld Then GoTo ERROR_EXIT
    
    If UCase(sPara(1)) = "OK" Then
        If sPara(3) <> m_sCustomerCode Then
            Debug.Print "客户编号不正确！", vbCritical + vbOKOnly, "系统错误"
            cust_repeat = 2
            Exit Function
        End If
        frmQueue.cmdAgain.Enabled = True
    Else
        Select Case CInt(sPara(3))
            Case 1
                Debug.Print "用户工号不正确！", vbCritical + vbOKOnly, "系统错误"
            Case 2
                Debug.Print "客户编号不正确！", vbCritical + vbOKOnly, "系统错误"
            Case 3
                Debug.Print "服务状态不正确！", vbCritical + vbOKOnly, "系统错误"
            Case Else
                Debug.Print "其他数据服务错误！", vbCritical + vbOKOnly, "系统错误"
        End Select
        cust_repeat = CInt(sPara(3))
        Exit Function
    End If
    
    cust_repeat = 0
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modWinsock"
    m_tagErrInfo.strErrFunc = "cust_repeat"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    cust_repeat = 9
End Function

'客户放弃
Private Function cust_abandon(ByVal data As String) As Integer
    On Error GoTo ERROR_EXIT
    Dim sFunction As String, sPara() As String
    
    sPara = Split(data, vbTab)
    sFunction = UCase(sPara(0))
    If UBound(sPara) = 0 Then GoTo ERROR_EXIT
    If sFunction <> "ABNI" Then GoTo ERROR_EXIT
    If sPara(2) <> m_strOld Then GoTo ERROR_EXIT
    
    If UCase(sPara(1)) = "OK" Then
        If sPara(3) <> m_sCustomerCode Then
            Debug.Print "客户编号不正确！", vbCritical + vbOKOnly, "系统错误"
            cust_abandon = 2
            Exit Function
        End If
        m_sCustomerCode = ""
        m_bService = False                               '放弃呼叫成功，开始排队工作
        frmQueue.EnableButton True
        frmQueue.Refresh_Info 1
    Else
        Select Case CInt(sPara(3))
            Case 1
                Debug.Print "用户工号不正确！", vbCritical + vbOKOnly, "系统错误"
            Case 2
                Debug.Print "客户编号不正确！", vbCritical + vbOKOnly, "系统错误"
            Case 3
                Debug.Print "服务状态不正确！", vbCritical + vbOKOnly, "系统错误"
            Case Else
                Debug.Print "其他数据服务错误！", vbCritical + vbOKOnly, "系统错误"
        End Select
        cust_abandon = CInt(sPara(3))
        Exit Function
    End If
    
    cust_abandon = 0
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modWinsock"
    m_tagErrInfo.strErrFunc = "cust_abandon"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    cust_abandon = 9
End Function

'回呼客户
Private Function cust_roback(ByVal data As String) As Integer
    On Error GoTo ERROR_EXIT
    Dim sFunction As String, sPara() As String
    Dim dlg As dlgSrgQueue
        
    sPara = Split(data, vbTab)
    sFunction = UCase(sPara(0))
    If UBound(sPara) = 0 Then GoTo ERROR_EXIT