📄 modwinsock.bas

📁 排队分诊管理系统源代码！该代码使用VB6开发环境
💻 BAS
📖 第 1 页 / 共 3 页
字号:
上一页 1 23
    If sFunction <> "ROBI" Then GoTo ERROR_EXIT
    If sPara(3) <> m_strOld Then GoTo ERROR_EXIT
    
    If UCase(sPara(1)) = "QUER" Then
        If UCase(sPara(2)) = "OK" Then
            frmQueue.cmdRecall.Tag = "1"
            '显示选择框
            Set dlg = New dlgSrgQueue
            Load dlg
            dlg.CustCode = sPara(4)
            If dlg.InitSet = True Then dlg.Show vbModal
            If dlg.bResult = True Then
                m_sCustomerCode = dlg.sResult
            Else
                m_sCustomerCode = ""
            End If
            Set dlg = Nothing
            If m_sCustomerCode = "" Then
                frmQueue.cmdRecall.Tag = "0"
            Else
                send_data "ROBK" & vbTab & "CUCD" & vbTab & m_strOld & vbTab & m_sCustomerCode
            End If
        Else
            Select Case CInt(sPara(4))
                Case 1
                    Debug.Print "用户工号不正确！", vbCritical + vbOKOnly, "系统错误"
                Case 2
                    MsgBox "没有存储的客户编号！", vbOKOnly, "系统提示"
                Case Else
                    Debug.Print "其他数据服务错误！", vbCritical + vbOKOnly, "系统错误"
            End Select
            cust_roback = CInt(sPara(4))
            Exit Function
        End If
    Else
        If UCase(sPara(2)) = "OK" Then
            If sPara(4) <> m_sCustomerCode Then
                Debug.Print "客户编号不正确！", vbCritical + vbOKOnly, "系统错误"
                cust_roback = 2
                Exit Function
            End If
            frmQueue.cmdRecall.Tag = "0"
            m_bService = True                               '呼叫成功，开始排队工作
            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 4
                    Debug.Print "命令格式不正确！", vbCritical + vbOKOnly, "系统错误"
                Case Else
                    Debug.Print "其他数据服务错误！", vbCritical + vbOKOnly, "系统错误"
            End Select
            frmQueue.cmdRecall.Tag = "0"
            cust_roback = CInt(sPara(3))
            Exit Function
        End If
    End If
    
    cust_roback = 0
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modWinsock"
    m_tagErrInfo.strErrFunc = "cust_roback"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    frmQueue.cmdRecall.Tag = "0"
    cust_roback = 9
End Function

'客户顺呼
Private Function cust_storage(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 <> "STGI" 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_storage = 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 4
                Debug.Print "命令格式不正确！", vbCritical + vbOKOnly, "系统错误"
            Case Else
                Debug.Print "其他数据服务错误！", vbCritical + vbOKOnly, "系统错误"
        End Select
        cust_storage = CInt(sPara(3))
        Exit Function
    End If
    
    cust_storage = 0
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modWinsock"
    m_tagErrInfo.strErrFunc = "cust_storage"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    cust_storage = 9
End Function

'客户优先呼叫
Private Function cust_first(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
    If sFunction <> "FRSI" Then GoTo ERROR_EXIT
    If sPara(3) <> m_strOld Then GoTo ERROR_EXIT
    
    If UCase(sPara(1)) = "QUER" Then
        If UCase(sPara(2)) = "OK" Then
            '显示选择框
            Set dlg = New dlgSrgQueue
            Load dlg
            dlg.CustCode = sPara(4)
            If dlg.InitSet(False) = True Then dlg.Show vbModal
            If dlg.bResult = True Then
                m_sCustomerCode = dlg.sResult
            Else
                m_sCustomerCode = ""
            End If
            Set dlg = Nothing
            If m_sCustomerCode <> "" Then
                send_data "FRST" & vbTab & "CUCD" & vbTab & m_strOld & vbTab & m_sCustomerCode
            End If
        Else
            Select Case CInt(sPara(4))
                Case 1
                    Debug.Print "用户工号不正确！", vbCritical + vbOKOnly, "系统错误"
                Case 2
                    MsgBox "没有存储的客户编号！", vbOKOnly, "系统提示"
                Case Else
                    Debug.Print "其他数据服务错误！", vbCritical + vbOKOnly, "系统错误"
            End Select
            cust_first = CInt(sPara(4))
            Exit Function
        End If
    Else
        If UCase(sPara(2)) = "OK" Then
            If sPara(4) <> m_sCustomerCode Then
                Debug.Print "客户编号不正确！", vbCritical + vbOKOnly, "系统错误"
                cust_first = 2
                Exit Function
            End If
            m_bService = True                               '呼叫成功，开始排队工作
            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 4
                    Debug.Print "命令格式不正确！", vbCritical + vbOKOnly, "系统错误"
                Case Else
                    Debug.Print "其他数据服务错误！", vbCritical + vbOKOnly, "系统错误"
            End Select
            cust_first = CInt(sPara(3))
            Exit Function
        End If
    End If
    
    cust_first = 0
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modWinsock"
    m_tagErrInfo.strErrFunc = "cust_first"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    cust_first = 9
End Function

'客户转移呼叫
Private Function cust_shift(ByVal data As String) As Integer
    On Error GoTo ERROR_EXIT
    Dim sFunction As String, sPara() As String
'    Dim dlg As dlgService
'    Dim sService As String
    
    sPara = Split(data, vbTab)
    sFunction = UCase(sPara(0))
    If UBound(sPara) = 0 Then GoTo ERROR_EXIT
    If sFunction <> "SHII" Then GoTo ERROR_EXIT
    If sPara(3) <> m_strOld Then GoTo ERROR_EXIT
    
    If UCase(sPara(1)) = "QUER" Then
'        If UCase(sPara(2)) = "OK" Then
'            '显示选择框
'            Set dlg = New dlgService
'            Load dlg
'            dlg.CustCodeList = sPara(4)
'            dlg.CustCodeText = m_sCustomerCode
'            If dlg.InitSet(True) = True Then dlg.Show vbModal
'            If dlg.ServiceStatus = True Then
'                m_sCustomerCode = dlg.CustCode
'                sService = dlg.ServiceCode
'            Else
'                m_sCustomerCode = ""
'                sService = ""
'            End If
'            Set dlg = Nothing
'            If m_sCustomerCode <> "" And sService <> "" Then
'                send_data "SHIT" & vbTab & "CUCD" & vbTab & m_strOld & vbTab & m_sCustomerCode & _
'                          vbTab & sService
'            End If
'        Else
'            Select Case CInt(sPara(4))
'                Case 1
'                    Debug.Print "用户工号不正确！", vbCritical + vbOKOnly, "系统错误"
'                Case 2
'                    Debug.Print "没有存储的客户编号！", vbOKOnly, "系统提示"
'                Case Else
'                    Debug.Print "其他数据服务错误！", vbCritical + vbOKOnly, "系统错误"
'            End Select
'            cust_shift = CInt(sPara(4))
'            Exit Function
'        End If
    Else
        If UCase(sPara(2)) = "OK" Then
            If sPara(4) <> m_sCustomerCode Then
                Debug.Print "客户编号不正确！", vbCritical + vbOKOnly, "系统错误"
                cust_shift = 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 4
                    Debug.Print "命令格式不正确！", vbCritical + vbOKOnly, "系统错误"
                Case Else
                    Debug.Print "其他数据服务错误！", vbCritical + vbOKOnly, "系统错误"
            End Select
            cust_shift = CInt(sPara(3))
            Exit Function
        End If
    End If
    
    cust_shift = 0
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modWinsock"
    m_tagErrInfo.strErrFunc = "cust_shift"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    cust_shift = 9
End Function
上一页 1 23
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -