moddecode.bas

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

Attribute VB_Name = "modDecode"
Option Explicit

Dim m_tagErrInfo                As TYPE_ERRORINFO      ' 错误信息

'user id, name, socket, password
Type user_type
    'socket they are using, 0 if not used
    socket          As Integer
    'user login id
    user_login      As String
    'user name
    user_name       As String
    'user password
    user_pass       As String
    'time they connected
    connected_at    As String
    'service state
    service_state   As Boolean
End Type

'this creates an array for each possible client
Public user() As user_type

Public Sub decode_data(ByVal data As String, ByVal socket As Integer)
    On Error GoTo ERROR_EXIT
    Dim sFunction As String, sPara() As String, customer As String
    Dim iResult As Integer, i As Integer
    
    'a socket has sent some data to the server, write your code
    'to translate the data here..
    
    'first update the idle information
    client(get_clientid(socket)).idle_since = f_time
    
    'now decode the data
    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 "USER"                     '用户登录命令
            customer = ""
            iResult = check_user(data, socket, customer)
            If iResult = 0 Then
                '合法登陆
                For i = 0 To UBound(user)
                    If user(i).socket = socket And user(i).service_state = True Then
                        iResult = i
                        Exit For
                    End If
                Next i
                '保存登录信息
                If Login_Info_Save(socket, 0) = False Then GoTo ERROR_EXIT
                send_data socket, "USEI" & vbTab & "OK" & vbTab & user(iResult).user_name & _
                                  vbTab & customer & vbLf
                                    
            Else
                '不合法登陆
                send_data socket, "USEI" & vbTab & "ERROR" & vbTab & iResult & vbLf
            End If
        Case "PCWD"                     '用户修改密码命令
            iResult = change_password(data, socket)
            '登陆用户
            For i = 0 To UBound(user)
                If user(i).socket = socket And user(i).service_state = True Then
                    Exit For
                End If
            Next i
            If iResult = 0 Then
                '保存登录信息
                If Save_Password(socket, data) = False Then GoTo ERROR_EXIT
                send_data socket, "PCWI" & vbTab & "OK" & vbTab & user(i).user_login
            Else
                '不合法登陆
                send_data socket, "PCWI" & vbTab & "ERR" & vbTab & user(i).user_login & vbTab & iResult
            End If
'        Case "SYPU"                     '用户暂停服务命令
'            iResult = pause_service(data, socket)
'            '登陆用户
'            For i = 0 To UBound(user)
'                If user(i).socket = socket And user(i).service_state = False Then
'                    Exit For
'                End If
'            Next i
'            If iResult = 0 Then
'                '保存暂停信息
'                If Login_Info_Save(socket, 2) = False Then GoTo ERROR_EXIT
'                send_data socket, "SYPI" & vbTab & "OK" & vbTab & user(i).user_login
'            Else
'                '不合法暂停
'                send_data socket, "SYPI" & vbTab & "ERR" & vbTab & user(i).user_login & vbTab & iResult
'            End If
'        Case "RYPU"                     '用户系统暂停恢复
'            iResult = pause_service(data, socket)
'            '登陆用户
'            For i = 0 To UBound(user)
'                If user(i).socket = socket And user(i).service_state = True Then
'                    Exit For
'                End If
'            Next i
'            If iResult = 0 Then
'                '保存暂停信息
'                If Login_Info_Save(socket, 3) = False Then GoTo ERROR_EXIT
'                send_data socket, "RYPI" & vbTab & "OK" & vbTab & user(i).user_login
'            Else
'                '不合法暂停
'                send_data socket, "RYPI" & vbTab & "ERR" & vbTab & user(i).user_login & vbTab & iResult
'            End If
'        Case "STOP"                     '用户退出服务命令
'            iResult = stop_service(data, socket)
'            '登陆用户
'            For i = 0 To UBound(user)
'                If user(i).socket = socket Then
'                    Exit For
'                End If
'            Next i
'            If iResult = 0 Then
'                '保存服务信息,将存储的客户弃号,为完成的标记为完成
''                If Finish_Service_Queue(Date, i, 1) = False Then GoTo ERROR_EXIT
''                If Finish_Service_Queue(Date, i, 2) = False Then GoTo ERROR_EXIT
'                send_data socket, "STOI" & vbTab & "OK" & vbTab & user(i).user_login
'            Else
'                '不合法退出
'                send_data socket, "STOI" & vbTab & "ERR" & vbTab & user(i).user_login & vbTab & iResult
'            End If
'        Case "REFH"                     '用户信息更新命令
'            ReDim sPara(3)
'            iResult = refresh_service(data, socket, sPara)
'            '登陆用户
'            For i = 0 To UBound(user)
'                If user(i).socket = socket Then
'                    Exit For
'                End If
'            Next i
'            If iResult = 0 Then
'                If sPara(0) = "SERV" Then                   '请求服务类型,服务编号;服务名称
'                    send_data socket, "REFI" & vbTab & "OK" & vbTab & "SERV" & vbTab & _
'                                      user(i).user_login & vbTab & sPara(1) & vbTab & sPara(2)
'                Else                                        '请求排队人数,本队列排队人数;全部排队人数
'                    send_data socket, "REFI" & vbTab & "OK" & vbTab & "QUEU" & vbTab & _
'                                      user(i).user_login & vbTab & sPara(1) & vbTab & sPara(2)
'                End If
'            Else
'                '不合法刷新
'                send_data socket, "REFI" & vbTab & "ERR" & vbTab & user(i).user_login & vbTab & iResult
'            End If
        Case Else
            send_data socket, "ERR" & vbTab & "Command Format Error"
    End Select
    
    Exit Sub
ERROR_EXIT:
    send_data socket, "ERR" & vbTab & "DataBase Function"
    
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "decode_data"
    m_tagErrInfo.strErrFunc = "modDecode"
    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 Function f_time() As String
    On Error Resume Next
    
    'returns time in a nice format
    f_time = Format(time, "hh:mm:ss")
End Function

Public Sub send_data(ByVal socket As Integer, 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
    
    frmServer.sock(socket).SendData data
    
    Debug.Print data
    
    DoEvents
    Exit Sub
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "send_data"
    m_tagErrInfo.strErrFunc = "modDecode"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
End Sub

'////////////////////////////////////////////////////////////////////////////////////////////////////////
'/                                                                                                      /
'/      以下是系统处理信息，由服务人员端传入中心服务端处理                                              /
'/                                                                                                      /
'////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Function check_user(ByVal data As String, ByVal socket As Integer, _
                ByRef sService As String) As Integer
    On Error GoTo ERROR_EXIT
    Dim sFunction As String, sPara() As String
    Dim i As Integer
    Dim rs As New ADODB.Recordset, cmd As New ADODB.Command
    Dim iResult As Integer, strSQL As String
    
    iResult = -1
    
    sPara = Split(data, vbTab)
    sFunction = UCase(sPara(0))
    If UBound(sPara) = 0 Then GoTo ERROR_EXIT
    If sFunction <> "USER" Then GoTo ERROR_EXIT
    '获得员工工号
    sFunction = ""
'    sFunction = sPara(1)
    modCipher.Decipher "CoBeyond_Queue_Yixing", sPara(1), sFunction
    sFunction = Trim$(sFunction)
    
    '检查是否重复连接
    If IsArrayInit(user()) Then
        For i = 0 To UBound(user)
            If user(i).user_login = sFunction Then
                '检查这个socket是否有效
                iResult = 2                             'ERROR = 2,重复连接
                Exit For
            End If
        Next i
        If iResult = 2 Then
            check_user = iResult
            Exit Function
        End If
    End If
            
    '连接数据库
    cmd.ActiveConnection = dbMyDB
    cmd.CommandType = adCmdText
    
    strSQL = "SELECT * FROM Employee WHERE ep_code = '" & sFunction & "' AND nouse_yesno = 0"
    cmd.CommandText = strSQL
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenStatic, adLockReadOnly
    If rs.EOF Or rs.RecordCount = 0 Then
        iResult = 1                                     'ERROR = 1,用户不存在
    End If
    If Not rs.EOF And rs.RecordCount = 1 Then
        rs.MoveFirst
        If Trim$(rs!Property) = Trim$(sPara(2)) Then
            iResult = 0
            sPara(1) = Trim$(rs!name_c)
        Else
            iResult = 3                                 'ERROR = 3,密码错误
        End If
    End If
    rs.Close
    
    If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
    
    '保存登录数据
    If iResult = 0 Then
        If IsArrayInit(user) Then
            i = UBound(user) + 1
            ReDim Preserve user(i)
        Else
            i = 0
            ReDim user(i)
        End If
        
        user(i).connected_at = Date & " " & time
        user(i).socket = socket
        user(i).user_login = sFunction
        user(i).user_name = sPara(1)
        user(i).user_pass = sPara(2)
    End If
    
    check_user = iResult
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "check_user"
    m_tagErrInfo.strErrFunc = "modDecode"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    check_user = 9                                      '其他错误，如数据库连接错误
End Function

Private Function change_password(ByVal data As String, ByVal socket As Integer) As Integer
    On Error GoTo ERROR_EXIT
    Dim sFunction As String, sPara() As String
    Dim i As Integer, iResult As Integer
    
    sPara = Split(data, vbTab)
    sFunction = UCase(sPara(0))
    If UBound(sPara) = 0 Then GoTo ERROR_EXIT
    If sFunction <> "PCWD" Then GoTo ERROR_EXIT
    
    '获得员工工号
    sFunction = ""
    modCipher.Decipher "CoBeyond_Queue_Yixing", sPara(1), sFunction
    sFunction = Trim$(sFunction)
    
    '合法登陆
    iResult = -1
    For i = 0 To UBound(user)
        If user(i).socket = socket And user(i).service_state = True Then
            iResult = i
            Exit For
        End If
    Next i
    If iResult = -1 Or (sFunction <> user(iResult).user_login) Then
        change_password = 1                             'ERROR = 1 ,无此用户
        Exit Function
    End If
    
    If Trim$(sPara(2)) <> Trim$(user(iResult).user_pass) Then
        change_password = 2                             'ERROR = 2 ,原密码不正确
        Exit Function
    End If
    
    If user(iResult).service_state = False Then GoTo ERROR_EXIT
    
    '返回正确信息
    iResult = 0
    change_password = iResult
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "change_password"
    m_tagErrInfo.strErrFunc = "modDecode"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    change_password = 9                                 '其他错误，如数据库连接错误
End Function