modwinsock.bas

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

Attribute VB_Name = "modWinsock"
Option Explicit

Dim m_tagErrInfo                As TYPE_ERRORINFO       '错误信息
    
Public m_sCustomerCode          As String               '当前客户服务编号
Public m_iCustomerNum           As Integer              '当前排队人数
Public m_iTotalNum              As Integer              '全部排队人数

Public m_sUserName              As String               '用户名称
Public m_iWindow                As Integer              '窗口编号
Public my_service_type          As service_type         '服务编号

Public m_bService               As Boolean              '系统是否处于服务状态

Type service_type
    '服务编号
    service_id                  As Integer
    '服务名称
    service_name                As String
    '是否为当前服务
    service_use                 As Boolean
End Type

Public queue_service()          As service_type

Public Sub decode_data(ByVal data As String)
    On Error GoTo ERROR_EXIT
    Dim sFunction As String, sPara() As String
    Dim iResult As Integer, i As Integer
    
    sPara = Split(data, vbTab)
    
    'check data true or false
    If UBound(sPara) = 0 Then GoTo ERROR_EXIT
        
    sFunction = UCase(sPara(0))
    
    'decode data
    Select Case sFunction
'////////////////////////////////////////////////////////////////////////////////////////////////////////
'/                                                                                                      /
'/      以下是系统处理信息，由服务人员端传入中心服务端处理                                              /
'/                                                                                                      /
'////////////////////////////////////////////////////////////////////////////////////////////////////////

        Case "USEI"
            iResult = check_user(data)
        Case "PCWI"
            iResult = service_pass(data)
        Case "SYPI"
            iResult = service_pause(data)
        Case "RYPI"
            iResult = service_pause(data)
        Case "STOI"
            iResult = service_stop(data)
        Case "REFI"
            iResult = service_info(data)
            
'////////////////////////////////////////////////////////////////////////////////////////////////////////
'/                                                                                                      /
'/      以下是业务处理信息，由服务人员端传入中心服务端处理                                              /
'/                                                                                                      /
'////////////////////////////////////////////////////////////////////////////////////////////////////////
        
        Case "CTRI"
            iResult = cust_trans(data)
        Case "FENI"
            iResult = cust_finish(data)
        Case "CREI"
            iResult = cust_repeat(data)
        Case "ABNI"
            iResult = cust_abandon(data)
        Case "ROBI"
            iResult = cust_roback(data)
        Case "STGI"
            iResult = cust_storage(data)
        Case "FRSI"
            iResult = cust_first(data)
        Case "SHII"
            iResult = cust_shift(data)
        Case Else
            GoTo ERROR_EXIT
    End Select
    
    Exit Sub
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modWinsock"
    m_tagErrInfo.strErrFunc = "decode_data"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
End Sub

Public Sub send_data(ByVal data As String)
    On Error GoTo ERROR_EXIT
    
    'use this to send data out to 1 socket.
    'all of my server code will use this.
    If data = "" Then Exit Sub
    
    frmQueue.wskConnect.SendData data
    
    Debug.Print data
    
    DoEvents
    Exit Sub
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modWinsock"
    m_tagErrInfo.strErrFunc = "send_data"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
End Sub

'刷新服务队列
Public Sub Quire_Refrsh_Queue(Optional ByVal iMode As Integer = 0)
    On Error Resume Next
    
    If iMode = 0 Then
        send_data "REFH" & vbTab & "QUEU" & vbTab & m_strUser
    Else
        send_data "REFH" & vbTab & "SERV" & vbTab & m_strUser
    End If
    
End Sub

'////////////////////////////////////////////////////////////////////////////////////////////////////////
'/                                                                                                      /
'/      以下是系统处理信息，由服务人员端传入中心服务端处理                                              /
'/                                                                                                      /
'////////////////////////////////////////////////////////////////////////////////////////////////////////

'检查用户登录身份
Private Function check_user(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 <> "USEI" Then GoTo ERROR_EXIT
    
    If UCase(sPara(1)) = "OK" Then
'        If UBound(sPara) <> 5 Then GoTo ERROR_EXIT
'        If Not IsNumeric(sPara(3)) Then GoTo ERROR_EXIT
'        If Not IsNumeric(sPara(4)) Then GoTo ERROR_EXIT
        
        m_sUserName = sPara(2)
        m_iWindow = CInt(sPara(3))
        With my_service_type
            .service_id = CInt(sPara(4))
            .service_name = sPara(5)
            .service_use = True
        End With
        frmQueue.m_bConnect = True
        
        '刷新显示   - 0 刷新用户信息
        If Not frmQueue.Refresh_Info(0) Then GoTo ERROR_EXIT
        If Not frmQueue.Refresh_Info(2) Then GoTo ERROR_EXIT
        
        '请求刷新排队信息
        Quire_Refrsh_Queue 0
        Quire_Refrsh_Queue 1
        frmQueue.EnableButton True
        
        '启动定时器
        frmQueue.timInfo.Interval = 10000
        frmQueue.timInfo.Enabled = True
    Else
        frmQueue.m_bConnect = False
            
        Select Case CInt(sPara(2))
            Case 1
                MsgBox "用户工号与密码错误！", vbCritical + vbOKOnly, "系统错误"
            Case 2
                MsgBox "用户已经登录,无法重复登录！", vbCritical + vbOKOnly, "系统错误"
            Case 3
                MsgBox "该终端已设置为服务暂停,无法登录！", vbCritical + vbOKOnly, "系统错误"
            Case 4
                MsgBox "窗口没有建立对应的服务！", vbCritical + vbOKOnly, "系统错误"
            Case Else
                MsgBox "其他数据服务错误！", vbCritical + vbOKOnly, "系统错误"
        End Select
        check_user = CInt(sPara(2))
        Exit Function
    End If
    
    check_user = 0
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modWinsock"
    m_tagErrInfo.strErrFunc = "check_user"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    frmQueue.m_bConnect = False
    check_user = 9
End Function

'修改登录密码
Private Function service_pass(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 <> "PCWI" Then GoTo ERROR_EXIT
    If sPara(2) <> m_strOld Then GoTo ERROR_EXIT
    
    If UCase(sPara(1)) = "OK" Then
        MsgBox "密码修改成功,系统下次登录时生效。", vbOKOnly, "系统提示"
    Else
        Select Case CInt(sPara(3))
            Case 1
                MsgBox "用户工号不正确,无法修改密码！", vbCritical + vbOKOnly, "系统错误"
            Case 2
                MsgBox "用户旧密码不正确,无法重新修改密码！", vbCritical + vbOKOnly, "系统错误"
            Case Else
                MsgBox "其他服务登录服务错误！", vbCritical + vbOKOnly, "系统错误"
        End Select
        service_pass = CInt(sPara(3))
        Exit Function
    End If
    
    service_pass = 0
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modWinsock"
    m_tagErrInfo.strErrFunc = "service_pass"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    service_pass = 9
End Function

'暂停客户服务,以及恢复客户服务
Private Function service_pause(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 sPara(2) <> m_strOld Then GoTo ERROR_EXIT
    
    Select Case sFunction
        Case "SYPI", "RYPI"
            If UCase(sPara(1)) <> "OK" Then
                Select Case CInt(sPara(3))
                    Case 1
                        Debug.Print "用户工号不正确,无法修改密码！", vbCritical + vbOKOnly, "系统错误"""
                    Case Else
                        Debug.Print "其他服务登录服务错误！", vbCritical + vbOKOnly, "系统错误"
                End Select
                service_pause = CInt(sPara(3))
                Exit Function
            End If
        Case Else
            GoTo ERROR_EXIT
    End Select
    
    '修改按钮状态
    If sFunction = "SYPI" Then
        MsgBox "本窗口已暂停窗口服务。", vbOKOnly, "系统提示"
        frmQueue.EnableButton False
        
        frmQueue.cmdLogin.Enabled = False
        frmQueue.cmdPassword.Enabled = False
        frmQueue.cmdQuit.Enabled = False
    Else
        MsgBox "本窗口已恢复窗口服务。", vbOKOnly, "系统提示"
        frmQueue.EnableButton True
        
        frmQueue.cmdLogin.Enabled = True
        frmQueue.cmdPassword.Enabled = True
        frmQueue.cmdQuit.Enabled = True
    End If
    
    service_pause = 0
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "modWinsock"
    m_tagErrInfo.strErrFunc = "service_pause"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    service_pause = 9
End Function