?? moddecode.bas
字號(hào):
Attribute VB_Name = "modDecode"
Option Explicit
Dim m_tagErrInfo As TYPE_ERRORINFO ' 錯(cuò)誤信息
'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
'////////////////////////////////////////////////////////////////////////////////////////////////////////
'/ /
'/ 以下是系統(tǒng)處理信息,由服務(wù)人員端傳入中心服務(wù)端處理 /
'/ /
'////////////////////////////////////////////////////////////////////////////////////////////////////////
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" '用戶暫停服務(wù)命令
' 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" '用戶系統(tǒng)暫停恢復(fù)
' 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" '用戶退出服務(wù)命令
' 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
' '保存服務(wù)信息,將存儲(chǔ)的客戶棄號(hào),為完成的標(biāo)記為完成
'' 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 '請(qǐng)求服務(wù)類(lèi)型,服務(wù)編號(hào);服務(wù)名稱
' send_data socket, "REFI" & vbTab & "OK" & vbTab & "SERV" & vbTab & _
' user(i).user_login & vbTab & sPara(1) & vbTab & sPara(2)
' Else '請(qǐng)求排隊(duì)人數(shù),本隊(duì)列排隊(duì)人數(shù);全部排隊(duì)人數(shù)
' 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
'////////////////////////////////////////////////////////////////////////////////////////////////////////
'/ /
'/ 以下是系統(tǒng)處理信息,由服務(wù)人員端傳入中心服務(wù)端處理 /
'/ /
'////////////////////////////////////////////////////////////////////////////////////////////////////////
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
'獲得員工工號(hào)
sFunction = ""
' sFunction = sPara(1)
modCipher.Decipher "CoBeyond_Queue_Yixing", sPara(1), sFunction
sFunction = Trim$(sFunction)
'檢查是否重復(fù)連接
If IsArrayInit(user()) Then
For i = 0 To UBound(user)
If user(i).user_login = sFunction Then
'檢查這個(gè)socket是否有效
iResult = 2 'ERROR = 2,重復(fù)連接
Exit For
End If
Next i
If iResult = 2 Then
check_user = iResult
Exit Function
End If
End If
'連接數(shù)據(jù)庫(kù)
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,密碼錯(cuò)誤
End If
End If
rs.Close
If rs.State = adStateOpen Then rs.Close
Set rs = Nothing
'保存登錄數(shù)據(jù)
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 '其他錯(cuò)誤,如數(shù)據(jù)庫(kù)連接錯(cuò)誤
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
'獲得員工工號(hào)
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 ,無(wú)此用戶
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 '其他錯(cuò)誤,如數(shù)據(jù)庫(kù)連接錯(cuò)誤
End Function
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -