This repository has been archived on 2025-11-27. You can view files and clone it. You cannot open issues or pull requests or push a commit.
Files
AUTS_OLD/AUTS_DataService/Service1.vb

2238 lines
82 KiB
VB.net
Raw Normal View History

2024-03-11 16:32:52 +08:00
Imports System.IO
Imports System.Net
Imports System.Net.NetworkInformation
Imports System.Net.Sockets
Imports System.Text
Imports System.Threading
Imports Newtonsoft.Json
Imports UTS_Core.Database
Imports UTS_Core.Serialize
Imports UTS_Core.UTSModule
Imports UTS_Core.UTSModule.DbTableModel.LocalPrivate
Imports UTS_Core.UTSModule.License
Imports UTS_Core.UTSModule.Service
Imports UTS_Core.UTSModule.Test.StatusMonitor
Public Class Service1
''' <summary> 监听句柄 </summary>
Private _tcpListener As TcpListener
''' <summary>服务任务列表</summary>
Private _tasks As ServiceTasks
''' <summary>当前设备App列表</summary>
Private _appManager As UtsAppManager
''' <summary>鉴权信息管理类 </summary>
Private _license As License
''' <summary> FTP服务类 </summary>
Private _ftpClient As FtpService
''' <summary>服务信息管理类 </summary>
Private _service As ServiceConfig
''' <summary>Tcp监听中</summary>
Private _tcpAccepting As Boolean
''' <summary>Tcp本地端口号 </summary>
Private _localPort As Integer
''' <summary>日志文件夹路径</summary>
Private _logDirPath As String
''' <summary>设置文件夹路径</summary>
Private _settingsDirPath As String
''' <summary>设置文件路径</summary>
Private _settingsPath As String
''' <summary>
''' 服务正在运行中
''' </summary>
Private _running As Boolean
Protected Overrides Sub OnStart(args() As String)
' 请在此处添加代码以启动您的服务。此方法应完成设置工作
' 以使您的服务开始工作。
InitServiceInfo()
CreateSystemFolder()
ThreadPool.SetMinThreads(20, 20)
ThreadPool.SetMaxThreads(1024, 512)
ServiceLog.LogDirPath = _logDirPath
ServiceLog.LogFilePrefix = My.Application.Info.ProductName
'License检测
If CheckLicense() = False Then Return
'根据License信息,初始化数据库连接信息
_dbHost = UtsRegistry.DbHost
UtsDb.InitConnectParams(_license)
'由此开始向云端写入数据
ServiceLog.WriteInfoLog($"DataService Started!")
'修改本地注册表版本号
UtsRegistry.DataServiceVersion = _service.DsVerString
'初始化数据服务日志入库信息
InitDataServiceLog()
'初始化Ftp信息
InitFtp()
'初始化Web服务器udp套接字
InitWebClient()
'读取本地设置文档
ReadSettings()
'定期接收Web服务器下发的信息
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf ReceiveWebServicePacket))
'定期向Web服务器发送保活包
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf SendHeartbeatPacket))
'定时更新服务信息至云端数据库
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf UpdateServiceInfo))
'定期存储服务日志队列内容至数据库
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf SaveServiceLog))
'监听本机Tcp通讯
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf ListenUtsApp))
'初始化多播套接字
InitMulticastGroup()
'定期检测Ftp与DB连接状态
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf UpdateState))
'定期检测本地IP与MAC地址
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf UpdatePrivateIp))
End Sub
Protected Overrides Sub OnStop()
' 在此处添加代码以执行任何必要的拆解操作,从而停止您的服务。
ServiceLog.WriteDebugLog($"Service Begin Stop!")
_running = False
My.Settings.dbLogType = ServiceLog.DbLogType
My.Settings.Save()
SaveSettings() '保存当前设置至xml中
ServiceLog.WriteInfoLog($"Service Stoped!")
ServiceLog.SaveLogQueueToDb()
End Sub
''' <summary>
''' 更新本地私有IP
''' </summary>
''' <param name="state"></param>
Private Sub UpdatePrivateIp(state As Object)
While _running
Try
_service.InitMacAndLocalIP()
Catch ex As Exception
ServiceLog.WriteErrorLog($"Update PrivateIp And MAC Error:{ex.Message}")
End Try
Thread.Sleep(1000)
End While
End Sub
Private Sub UpdateState(state As Object)
While _running
'本地数据库缓存数量
Try
Using db As New DbExecutor(UtsDb.LocalDbType, UtsDb.LocalConnString)
db.Open()
Dim tableName As String = CacheTable.TableName
Dim condition As String = $"{CacheTable.ColNamesEnum.IsUpload} = 0"
Dim cmdText As String = db.CmdHelper.SearchCount(tableName, condition)
_service.CacheCount = CInt(db.ExecuteScalar(cmdText))
db.Close()
End Using
Catch ex As Exception
ServiceLog.WriteErrorLog($"Search CacheTable Count Error:{ex.Message}")
End Try
'云端数据库连接状态
Try
Using db As New DbExecutor(UtsDb.RemoteDbType, UtsDb.RemoteConnString)
db.Open()
db.Close()
End Using
_service.DbStatus = 1
Catch ex As Exception
_service.DbStatus = 0
ServiceLog.WriteErrorLog($"Check DB Status Error:{ex.Message}")
End Try
'Ftp连接状态
Try
_ftpClient.CanConnected()
_service.FtpStatus = 1
Catch ex As Exception
_service.FtpStatus = 0
ServiceLog.WriteErrorLog($"Check FTP Status Error:{ex.Message}")
End Try
Thread.Sleep(1000 * 60)
End While
End Sub
#Region "服务多播"
''' <summary>广播端口</summary>
Private _groupPort As Integer
''' <summary>广播套接字</summary>
Private _groupClient As UdpClient
''' <summary>广播发送锁</summary>
Private _groupLock As New Object
''' <summary>广播发送序号</summary>
Private _groupSendIndex As Integer = 0
''' <summary>广播服务管理器</summary>
Private _groupManager As ServiceGroupManager
''' <summary>
''' 本地IP变化的处理
''' </summary>
''' <param name="ip"></param>
Private Sub UdatePrivateIP(ip As String)
ServiceLog.WriteInfoLog($"Private Ip Changed!Old Ip:{ServiceLog.PrivateIp},New Ip:{ip}")
'更新日志的IP字段
ServiceLog.PrivateIp = ip
End Sub
''' <summary>
''' MAC地址变化处理
''' </summary>
''' <param name="mac"></param>
Private Sub UpdateMAC(mac As String)
ServiceLog.WriteInfoLog($"MAC Changed!Old mac:{ServiceLog.MAC},New mac:{mac}")
'更新日志的MAC字段
ServiceLog.MAC = mac
End Sub
''' <summary>
''' 初始化广播套接字
''' </summary>
Private Sub InitMulticastGroup()
_groupManager = New ServiceGroupManager
_groupPort = 22483
'广播接收
_groupClient = New UdpClient(_groupPort, AddressFamily.InterNetwork)
_groupClient.EnableBroadcast = True
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf ReceiveDataServicePacket), _groupClient)
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf ServiceGroupKeepAlive), _groupClient)
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf ServiceGroupCheckAlive), _groupClient)
AddHandler _service.PrivateIPChanged, AddressOf UdatePrivateIP
AddHandler _service.MACChanged, AddressOf UpdateMAC
End Sub
Private Sub ServiceGroupCheckAlive(state As Object)
Dim inteval As Integer = 30 * 1000
While _running
Try
_groupManager.Add(New OtherService(_service.DsIndex, _groupSendIndex))
_groupManager.CheckAliveService()
_service.NetworkNeiborhood = _groupManager.GetAliveServiceIndexString
Catch ex As Exception
ServiceLog.WriteErrorLog($"ServiceGroupCheckAlive Error:{ex.Message}")
End Try
Thread.Sleep(inteval)
End While
End Sub
Private Sub ServiceGroupKeepAlive(state As Object)
Dim inteval As Integer = 10 * 1000
Dim sg As New ServiceGroup
sg.Type = "KeepAlive"
sg.ServiceIndex = _service.DsIndex
sg.ServiceGroup = _service.BarnchNet
While _running
Try
sg.Index = GetGroupNextSendInxex()
SendGroupMsg(sg)
Catch ex As Exception
ServiceLog.WriteErrorLog($"ServiceGroupKeepAlive Error:{ex.Message}")
End Try
Thread.Sleep(inteval)
End While
End Sub
''' <summary>
''' 接收处理来自数据服务的多播数据
''' </summary>
''' <param name="state">UDP套接字</param>
Private Sub ReceiveDataServicePacket(state As Object)
Dim client As UdpClient = CType(state, UdpClient)
Dim ep As New IPEndPoint(IPAddress.Any, 0)
Dim bytes() As Byte
While _running
Try
bytes = client.Receive(ep)
Catch ex As Exception
ServiceLog.WriteDebugLog($"Receive Group Packet Fail:{ex.Message}")
Continue While
End Try
If bytes.Length = 0 Then Continue While
Dim replyParam As New WebReplyParam
replyParam.Ep = New IPEndPoint(ep.Address, ep.Port)
replyParam.Packet = bytes
replyParam.Client = client.Client
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf DealDataServicePacket), replyParam)
End While
End Sub
''' <summary>
''' 处理数据服务的广播包
''' </summary>
''' <param name="state"></param>
Private Sub DealDataServicePacket(state As Object)
Dim data As WebReplyParam = CType(state, WebReplyParam)
Dim jsonStrings As String = Encoding.UTF8.GetString(data.Packet)
'校验Json字符串必须以回车换行结尾
If jsonStrings.EndsWith(vbCrLf) = False Then
ServiceLog.WriteDebugLog($"Deal DataService Receive Data Not EndsWith!")
Return
End If
For Each jsonString As String In jsonStrings.Split(New String() {vbCrLf}, Integer.MaxValue, StringSplitOptions.RemoveEmptyEntries)
Try
'反序列化
Dim group As ServiceGroup = JsonConvert.DeserializeObject(Of ServiceGroup)(jsonString)
'反序列化失败,则处理下一包
If IsNothing(group) Then
ServiceLog.WriteDebugLog($"Deal DataService Receive Data IsNothing(taskParam)!")
Continue For
End If
'过滤发向服务本身广播的信息
If group.ServiceIndex = _service.DsIndex Then Continue For
'过滤不同子网发送过来的信息
If String.Compare(group.ServiceGroup, _service.BarnchNet, True) <> 0 Then Continue For
'过滤相同IP发送的重复包
If _groupManager.CheckServiceSendIndex(group.ServiceIndex, group.Index) Then Continue For
'写入接收记录
ServiceLog.WriteDebugLog($"[{group.ServiceIndex:D4}] - [{group.Index:D4}] Recive: {jsonString}")
'处理数据,返回回复数据
Dim reply As ServiceGroup = DealGroupReceiveData(group)
'无需回复,则处理下一包
If reply Is Nothing Then Continue For
'序列化回复数据
SendGroupMsg(reply)
Catch ex As Exception
ServiceLog.WriteErrorLog($"Deal DataService Receive Data Error,{ex.Message}")
End Try
Next
End Sub
Public Function DealGroupReceiveData(group As ServiceGroup) As ServiceGroup
Dim result As ServiceGroup = Nothing
Select Case group.Type
Case "SnListChanged"
'更新数据库
If String.Compare(group.GroupInfo("DB"), UtsDb.RemotePrivateDb, True) <> 0 Then
ServiceLog.WriteWarningLog($"DealGroupReceiveData,Service Db [{UtsDb.RemotePrivateDb}] Not Equal [{group.GroupInfo("DB")}]!")
Exit Select
End If
If String.IsNullOrEmpty(group.GroupInfo("Barcode")) Then
ServiceLog.WriteWarningLog("DealGroupReceiveData,Barcode IsNullOrEmpty!")
Exit Select
End If
'更新其他服务存活状态
_groupManager.Add(New OtherService(group.ServiceIndex, group.Index))
Try
DbConnect.DbConnector.UpdateLocalSnList(group.GroupInfo("Barcode"),
group.GroupInfo("SnListOrder"),
group.GroupInfo("StartTime"),
group.GroupInfo("Result"),
group.GroupInfo("A1String"))
Catch ex As Exception
ServiceLog.WriteErrorLog($"DealGroupReceiveData,UpdateLocalSnList Error:{ex.Message}")
End Try
Case "KeepAlive"
'更新其他服务存活状态
_groupManager.Add(New OtherService(group.ServiceIndex, group.Index))
End Select
Return result
End Function
''' <summary>
''' 获取广播下一次发送序号,并将序号+1
''' </summary>
''' <returns></returns>
Private Function GetGroupNextSendInxex() As Integer
Static lock As New Object
SyncLock lock
_groupSendIndex += 1
If _groupSendIndex >= Integer.MaxValue Then
_groupSendIndex = 1
End If
Return _groupSendIndex
End SyncLock
End Function
''' <summary>
''' 发送广播信息
''' </summary>
''' <param name="group">需要广播的服务内容</param>
Private Sub SendGroupMsg(group As ServiceGroup)
Try
Dim jsonString As String = JsonConvert.SerializeObject(group) & vbCrLf
Dim bytes() As Byte = Encoding.UTF8.GetBytes(jsonString)
SyncLock _groupLock
_groupClient.Send(bytes, bytes.Length, New IPEndPoint(IPAddress.Broadcast, _groupPort))
Thread.Sleep(1)
_groupClient.Send(bytes, bytes.Length, New IPEndPoint(IPAddress.Broadcast, _groupPort))
Thread.Sleep(1)
_groupClient.Send(bytes, bytes.Length, New IPEndPoint(IPAddress.Broadcast, _groupPort))
End SyncLock
ServiceLog.WriteDebugLog($"[{group.ServiceIndex:D4}] - [{group.Index:D4}] Send: {jsonString}")
Catch ex As Exception
ServiceLog.WriteErrorLog($"Send Group Packet Fail:{ex.Message}")
End Try
End Sub
#End Region
''' <summary>
''' 初始化数据服务日志所需信息需要提前初始化License与ServiceRegister
''' </summary>
Private Sub InitDataServiceLog()
Try
ServiceLog.CreateServiceLogTable() '创建服务日志本地表
Catch ex As Exception
ServiceLog.WriteErrorLog($"CreateServiceLogTable Fail:{ex.Message},Stop Service!")
Return
End Try
ServiceLog.DbLogType = My.Settings.dbLogType
If ServiceLog.DbLogType = 0 Then ServiceLog.DbLogType = 30
ServiceLog.VendorName = _license.VendorName '写入数据前指定软件公司名
ServiceLog.PrivateIp = _service.PrivateIP
ServiceLog.DsIndex = _service.DsIndex
ServiceLog.DsVersion = _service.DsVerString
ServiceLog.UsVersion = _service.UsVerString
ServiceLog.MAC = _service.Mac
End Sub
Private Sub InitFtp()
'从注册表中读取ftp域名
_ftpHost = UtsRegistry.FtpHost
_ftpClient = New FtpService(UtsRegistry.FtpHost, CInt(_license.FtpPort), _license.FtpUser, _license.FtpPwd)
End Sub
Private Sub InitWebClient()
Dim port As Integer = 55621
While True
Try
_webUdpClient = New UdpClient(New IPEndPoint(IPAddress.Any, port))
Exit While
Catch ex As Exception
UTS_Core.DebugLog.ApplicationLog.WriteLog("Info", "Init udp clinet fail," & ex.Message)
End Try
port += 1
If port >= 65535 Then port = 10240
End While
Try
_webRemoteIP = New IPEndPoint(Dns.GetHostAddresses("www.uts-data.com")(0), 5980)
Catch ex As Exception
ServiceLog.WriteInfoLog($"InitWebClient Get RemoteIP Fail:{ex.Message}")
End Try
End Sub
#Region "与Web服务器通讯"
''' <summary> web通讯套接字对象</summary>
Private _webUdpClient As New UdpClient(New IPEndPoint(IPAddress.Any, _localPort))
''' <summary> web通讯IP地址与端口</summary>
Private _webRemoteIP As IPEndPoint = Nothing
''' <summary> web服务组包对象</summary>
Private ReadOnly _webPacker As New UtsWebPacket
''' <summary> 当前设备公网Ip</summary>
Private _localPublicIp As String
''' <summary>uts系列软件访问ftp的主机地址</summary>
Private _ftpHost As String
''' <summary>uts系列软件访问db的主机地址</summary>
Private _dbHost As String
''' <summary>
''' 定期发送心跳包,并获取公网IP与ftp网址
''' </summary>
''' <param name="state"></param>
Private Sub SendHeartbeatPacket(state As Object)
Dim sendInterval As Integer = 10 * 1000 '单位ms
While _running
Thread.Sleep(sendInterval)
Try
If _webRemoteIP Is Nothing Then
_webRemoteIP = New IPEndPoint(Dns.GetHostAddresses("www.uts-data.com")(0), 5980)
End If
Catch ex As Exception
If sendInterval < 60 * 1000 Then sendInterval += 10 * 1000 '每次累加10秒至多1分钟
ServiceLog.WriteDebugLog($"Get RemoteIP Fail:{ex.Message}")
Continue While
End Try
Try
Dim param As New List(Of Byte)
param.AddRange(BitConverter.GetBytes(_service.DsIndex))
param.Add(CByte(_service.DsVersion.Major))
param.Add(CByte(_service.DsVersion.Minor))
param.Add(CByte(_service.DsVersion.Build))
param.Add(CByte(_service.DsVersion.Revision))
param.Add(CByte(_service.UsVersion.Major))
param.Add(CByte(_service.UsVersion.Minor))
param.Add(CByte(_service.UsVersion.Build))
param.Add(CByte(_service.UsVersion.Revision))
Dim packet() As Byte = _webPacker.FillPacket(CByte(UtsWebPacket.Commands.Heartbeat), param.ToArray)
SendDataToWeb(_webUdpClient.Client, _webRemoteIP, packet)
sendInterval = 10 * 1000
Catch ex As Exception
If sendInterval < 60 * 1000 Then sendInterval += 10 * 1000
ServiceLog.WriteDebugLog($"Send Heartbeat Packet Fail:{ex.Message}")
End Try
End While
End Sub
''' <summary>
''' 接收处理来自Web服务器的数据
''' </summary>
''' <param name="state"></param>
Private Sub ReceiveWebServicePacket(state As Object)
Dim ep As New IPEndPoint(IPAddress.Any, 0)
Dim bytes() As Byte
While _running
Try
bytes = _webUdpClient.Receive(ep)
Catch ex As Exception
ServiceLog.WriteDebugLog($"Recv Web Packet Fail:{ex.Message}")
Continue While
End Try
If bytes.Length = 0 Then Continue While
Dim replyParam As New WebReplyParam
replyParam.Ep = New IPEndPoint(ep.Address, ep.Port)
replyParam.Packet = bytes
replyParam.Client = _webUdpClient.Client
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf DealWebServicePacket), replyParam)
End While
End Sub
Public Sub DealWebServicePacket(state As Object)
Dim param As WebReplyParam = CType(state, WebReplyParam)
'校验
Try
_webPacker.CheckPacket(param.Packet)
Catch ex As Exception
ServiceLog.WriteErrorLog($"DealWebServicePacket,Check Packet Error:{ex.Message}")
Return
End Try
'处理
Dim replyData() As Byte
Dim snByte As Byte = param.Packet(UtsWebPacket.PacketBits.SerialNumber)
Dim cmdByte As Byte = param.Packet(UtsWebPacket.PacketBits.Command)
Dim command As UtsWebPacket.Commands
If [Enum].TryParse(cmdByte.ToString(), command) = False Then
ServiceLog.WriteErrorLog($"DealWebServicePacket,Unknown CmdByte:{cmdByte}")
Return
End If
Select Case command
Case UtsWebPacket.Commands.Heartbeat
'todo:此处需要处理心跳包,获取公网IP与ftp地址
'DealHeartbeatPacket(param)
2024-03-11 16:32:52 +08:00
Case UtsWebPacket.Commands.SetLogType
replyData = DealSetLogTypePacket(param)
' param.Client.SendTo(_webPacker.FillPacket(snByte, cmdByte, replyData), param.Ep)
SendDataToWeb(param.Client, param.Ep, _webPacker.FillPacket(snByte, cmdByte, replyData))
Case UtsWebPacket.Commands.GetLogType
replyData = DealGetLogTypePacket(param)
SendDataToWeb(param.Client, param.Ep, _webPacker.FillPacket(snByte, cmdByte, replyData))
Case UtsWebPacket.Commands.AddServiceTask
replyData = DealAddServiceTaskPacket(param)
SendDataToWeb(param.Client, param.Ep, _webPacker.FillPacket(snByte, cmdByte, replyData))
Case UtsWebPacket.Commands.DelServiceTask
replyData = DealDelServiceTaskPacket(param)
SendDataToWeb(param.Client, param.Ep, _webPacker.FillPacket(snByte, cmdByte, replyData))
Case UtsWebPacket.Commands.GetServiceTask
replyData = DealGetServiceTaskPacket(param)
SendDataToWeb(param.Client, param.Ep, _webPacker.FillPacket(snByte, cmdByte, replyData))
Case UtsWebPacket.Commands.SetServiceTask
replyData = DealSetServiceTaskPacket(param)
SendDataToWeb(param.Client, param.Ep, _webPacker.FillPacket(snByte, cmdByte, replyData))
Case UtsWebPacket.Commands.StartServiceTask
replyData = DealStartServiceTaskPacket(param)
SendDataToWeb(param.Client, param.Ep, _webPacker.FillPacket(snByte, cmdByte, replyData))
Case UtsWebPacket.Commands.StopServiceTask
replyData = DealStopServiceTaskPacket(param)
SendDataToWeb(param.Client, param.Ep, _webPacker.FillPacket(snByte, cmdByte, replyData))
Case UtsWebPacket.Commands.RestartServiceTask
replyData = DealReStartServiceTaskPacket(param)
SendDataToWeb(param.Client, param.Ep, _webPacker.FillPacket(snByte, cmdByte, replyData))
Case UtsWebPacket.Commands.UploadFile
replyData = DealUploadFilePacket(param)
SendDataToWeb(param.Client, param.Ep, _webPacker.FillPacket(snByte, cmdByte, replyData))
Case UtsWebPacket.Commands.ReadFileSize
replyData = DealReadFileSizePacket(param)
SendDataToWeb(param.Client, param.Ep, _webPacker.FillPacket(snByte, cmdByte, replyData))
Case UtsWebPacket.Commands.UploadTaskStatus
DealUploadTaskStatusPacket(param)
Case UtsWebPacket.Commands.UploadAppStatus
DealUploadAppStatusPacket(param)
Case UtsWebPacket.Commands.GetAppStatus
replyData = DealGetAppStatusPacket(param)
SendDataToWeb(param.Client, param.Ep, _webPacker.FillPacket(snByte, cmdByte, replyData))
Case UtsWebPacket.Commands.SetAppStatus
replyData = DealSetAppStatusPacket(param)
SendDataToWeb(param.Client, param.Ep, _webPacker.FillPacket(snByte, cmdByte, replyData))
Case Else
ServiceLog.WriteErrorLog($"DealWebServicePacket, Unknown Command:{Hex(cmdByte)}")
End Select
End Sub
''' <summary>
''' 处理上传任务变化后状态
''' </summary>
''' <param name="param"></param>
Private Sub DealUploadTaskStatusPacket(param As WebReplyParam)
'暂无处理
End Sub
''' <summary>
''' 处理上传App变化后状态
''' </summary>
''' <param name="param"></param>
Private Sub DealUploadAppStatusPacket(param As WebReplyParam)
'暂无处理
End Sub
''' <summary>
''' 处理Web服务器心跳回复包
''' </summary>
''' <param name="param">回复参数</param>
Private Sub DealHeartbeatPacket(param As WebReplyParam)
Dim tmpIp As String = $"{param.Packet(UtsWebPacket.PacketBits.Param)}.{param.Packet(UtsWebPacket.PacketBits.Param + 1)}.{param.Packet(UtsWebPacket.PacketBits.Param + 2)}.{param.Packet(UtsWebPacket.PacketBits.Param + 3)}"
If String.Compare(_localPublicIp, tmpIp) <> 0 Then
_localPublicIp = tmpIp
End If
If String.Compare(ServiceLog.PublicIp, _localPublicIp) <> 0 Then
ServiceLog.PublicIp = _localPublicIp
End If
'额外数据处理
Dim type As Integer
Dim length As Integer
For i As Integer = UtsWebPacket.PacketBits.Param + 4 To param.Packet.Count - 1
type = param.Packet(i)
length = param.Packet(i + 1)
Select Case type
Case 1 'ftp服务器地址
Dim ftpHost As String = Encoding.UTF8.GetString(param.Packet, i + 2, length)
'比较注册表
If String.Compare(_ftpHost, ftpHost) <> 0 Then
_ftpHost = ftpHost
UtsRegistry.FtpHost = _ftpHost '写入注册表
_ftpClient.FtpHost = _ftpHost '重新初始化FTP服务器地址
'下发ftp服务器地址变更
Dim sendParam As TaskJsonParam = FillServiceMsg()
sendParam.AppInfo.Add("AppStatus", $"{TaskJsonParam.ServiceMsgTypes.FtpHostChange}")
sendParam.AppInfo.Add("FtpHost", _ftpHost)
Dim jsonString As String = TaskJsonParam.SerializeToJson(sendParam) & vbCrLf
For Each app As UtsApp In _appManager.GetAllApps
If app.Status = UtsApp.AppStatus.Started Then SendJsonString(app.Client, jsonString)
Next
End If
Case 2 'db服务器地址
Dim dbHost As String = Encoding.UTF8.GetString(param.Packet, i + 2, length)
'比较注册表
If String.Compare(_dbHost, dbHost) <> 0 Then
_dbHost = dbHost
UtsRegistry.DbHost = _dbHost '写入注册表
UtsDb.InitConnectParams(_license) '重新初始化数据库连接信息
'下发ftp服务器地址变更
Dim sendParam As TaskJsonParam = FillServiceMsg()
sendParam.AppInfo.Add("AppStatus", $"{TaskJsonParam.ServiceMsgTypes.DbHostChange}")
sendParam.AppInfo.Add("DbHost", _dbHost)
Dim jsonString As String = TaskJsonParam.SerializeToJson(sendParam) & vbCrLf
For Each app As UtsApp In _appManager.GetAllApps
If app.Status = UtsApp.AppStatus.Started Then SendJsonString(app.Client, jsonString)
Next
End If
End Select
i += length + 1
Next
End Sub
''' <summary>
''' 填充反控App包的基本信息,含不包含附加信息
''' </summary>
''' <returns></returns>
Private Function FillServiceMsg() As TaskJsonParam
Dim sendParam As New TaskJsonParam
sendParam.CmdName = TaskJsonParam.CmdNamesEnum.ServiceMsg
sendParam.AppName = "AUTS_DataService"
sendParam.User = "Admin"
Return sendParam
End Function
''' <summary>
''' 处理Web服务器获取App状态包
''' </summary>
''' <param name="param">回复参数</param>
''' <returns></returns>
Private Function DealGetAppStatusPacket(param As WebReplyParam) As Byte()
'上报缓冲区中的App信息
'获取执行方式
Dim type As Byte = param.Packet(UtsWebPacket.PacketBits.Param)
Dim replyParam As New List(Of Byte)
Dim appsInfo As New List(Of UtsApp)
If type = 0 Then
appsInfo.AddRange(_appManager.GetAllApps())
Try
replyParam.Add(&H0)
replyParam.AddRange(Encoding.UTF8.GetBytes(JsonConvert.SerializeObject(appsInfo)))
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes(ex.Message))
End Try
Else
Dim length As Integer = param.Packet.Length - UtsWebPacket.PacketBits.Param - 1
Dim paramBytes(length - 1) As Byte
Array.Copy(param.Packet, UtsWebPacket.PacketBits.Param + 1, paramBytes, 0, paramBytes.Length)
'转换为字符串
Dim paramStr As String = Encoding.UTF8.GetString(paramBytes)
Try
Dim appNames() As String = paramStr.Split(New Char() {","c}, StringSplitOptions.RemoveEmptyEntries)
For Each appName As String In appNames
appsInfo.Add(_appManager.GetApp(appName))
Next
replyParam.Add(&H0)
replyParam.AddRange(Encoding.UTF8.GetBytes(JsonConvert.SerializeObject(appsInfo)))
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes(ex.Message))
End Try
End If
Return replyParam.ToArray()
End Function
''' <summary>
''' 处理Web服务器反控App状态包
''' </summary>
''' <param name="param">回复参数</param>
''' <returns></returns>
Private Function DealSetAppStatusPacket(param As WebReplyParam) As Byte()
Dim replyParam As New List(Of Byte)
Dim type As Byte = param.Packet(UtsWebPacket.PacketBits.Param)
If type = 0 Then
Dim paramOffset As Integer = UtsWebPacket.PacketBits.Param
Dim paramLength As Integer = param.Packet.Length - paramOffset
Dim paramBytes(paramLength - 1) As Byte
Array.Copy(param.Packet, paramOffset, paramBytes, 0, paramBytes.Length)
Dim paramStr As String = Encoding.UTF8.GetString(paramBytes)
'反序列化设置的参数
Dim sendParam As TaskJsonParam = FillServiceMsg()
sendParam.AppInfo = JsonConvert.DeserializeObject(Of Dictionary(Of String, String))(paramStr)
Dim jsonString As String = TaskJsonParam.SerializeToJson(sendParam) & vbCrLf
'下发设置信息至所有App
For Each app As UtsApp In _appManager.GetAllApps
If app.Status = UtsApp.AppStatus.Started Then SendJsonString(app.Client, jsonString)
Next
replyParam.Append(&H0)
Else
Dim nameLength As Integer = param.Packet(UtsWebPacket.PacketBits.Param + 1)
Dim nameBytes(nameLength - 1) As Byte
Array.Copy(param.Packet, UtsWebPacket.PacketBits.Param + 2, nameBytes, 0, nameBytes.Length)
Dim nameStr As String = Encoding.UTF8.GetString(nameBytes)
Dim paramOffset As Integer = UtsWebPacket.PacketBits.Param + nameLength + 2
Dim paramLength As Integer = param.Packet.Length - paramOffset
Dim paramBytes(paramLength - 1) As Byte
Array.Copy(param.Packet, paramOffset, paramBytes, 0, paramBytes.Length)
Dim paramStr As String = Encoding.UTF8.GetString(paramBytes)
'反序列化设置的参数
Dim sendParam As TaskJsonParam = FillServiceMsg()
sendParam.AppInfo = JsonConvert.DeserializeObject(Of Dictionary(Of String, String))(paramStr)
Dim jsonString As String = TaskJsonParam.SerializeToJson(sendParam) & vbCrLf
Dim appNames() As String = nameStr.Split(New Char() {","c}, StringSplitOptions.RemoveEmptyEntries)
For Each appName As String In appNames
'下发设置信息至所有App
Dim app As UtsApp = _appManager.GetApp(appName)
If app.Status = UtsApp.AppStatus.Started Then SendJsonString(app.Client, jsonString)
Next
replyParam.Append(&H0)
End If
Return replyParam.ToArray()
End Function
''' <summary>
''' 处理Web服务器添加任务控制包
''' </summary>
''' <param name="param">回复参数</param>
Private Function DealAddServiceTaskPacket(param As WebReplyParam) As Byte()
'将数据库的参数部分取出
Dim length As Integer = param.Packet.Length - UtsWebPacket.PacketBits.Param
Dim paramBytes(length - 1) As Byte
Array.Copy(param.Packet, UtsWebPacket.PacketBits.Param, paramBytes, 0, paramBytes.Length)
'转换为字符串
Dim paramStr As String = Encoding.UTF8.GetString(paramBytes)
'处理数据
Dim replyParam As New List(Of Byte)
Try
Dim taskInfo As Dictionary(Of String, String) = JsonConvert.DeserializeObject(Of Dictionary(Of String, String))(paramStr)
_tasks.Add(taskInfo)
replyParam.Add(&H0)
replyParam.AddRange(Encoding.UTF8.GetBytes(JsonConvert.SerializeObject(_tasks.GetTaskParams(taskInfo("Name")))))
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes(ex.Message))
End Try
Return replyParam.ToArray()
End Function
''' <summary>
''' 处理Web服务器删除任务控制包
''' </summary>
''' <param name="param">回复参数</param>
Private Function DealDelServiceTaskPacket(param As WebReplyParam) As Byte()
'获取执行方式
Dim type As Byte = param.Packet(UtsWebPacket.PacketBits.Param)
'处理数据
Dim replyParam As New List(Of Byte)
If type = 0 Then '清空任务
Try
_tasks.Clear()
replyParam.Add(&H0)
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes(ex.Message))
End Try
Else
Dim length As Integer = param.Packet.Length - UtsWebPacket.PacketBits.Param - 1
Dim paramBytes(length - 1) As Byte
Array.Copy(param.Packet, UtsWebPacket.PacketBits.Param + 1, paramBytes, 0, paramBytes.Length)
'转换为字符串
Dim paramStr As String = Encoding.UTF8.GetString(paramBytes)
Try
Dim taskNames() As String = paramStr.Split(New Char() {","c}, StringSplitOptions.RemoveEmptyEntries)
For Each taskName As String In taskNames
_tasks.RemoveAt(taskName)
Next
replyParam.Add(&H0)
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes(ex.Message))
End Try
End If
Return replyParam.ToArray()
End Function
''' <summary>
''' 处理Web服务器获取任务控制包
''' </summary>
''' <param name="param">回复参数</param>
Private Function DealGetServiceTaskPacket(param As WebReplyParam) As Byte()
'获取执行方式
Dim type As Byte = param.Packet(UtsWebPacket.PacketBits.Param)
'处理数据
Dim replyParam As New List(Of Byte)
replyParam.Clear()
Dim tasksInfo As New List(Of Dictionary(Of String, String))
If type = 0 Then
Try
tasksInfo.AddRange(_tasks.GetAllTasksParam())
replyParam.Add(&H0)
replyParam.AddRange(Encoding.UTF8.GetBytes(JsonConvert.SerializeObject(tasksInfo)))
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes(ex.Message))
End Try
Else
Dim length As Integer = param.Packet.Length - UtsWebPacket.PacketBits.Param - 1
Dim paramBytes(length - 1) As Byte
Array.Copy(param.Packet, UtsWebPacket.PacketBits.Param + 1, paramBytes, 0, paramBytes.Length)
'转换为字符串
Dim paramStr As String = Encoding.UTF8.GetString(paramBytes)
Try
Dim taskNames() As String = paramStr.Split(New Char() {","c}, StringSplitOptions.RemoveEmptyEntries)
For Each taskName As String In taskNames
tasksInfo.Add(_tasks.GetTaskParams(taskName))
Next
replyParam.Add(&H0)
replyParam.AddRange(Encoding.UTF8.GetBytes(JsonConvert.SerializeObject(tasksInfo)))
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes(ex.Message))
End Try
End If
Return replyParam.ToArray()
End Function
''' <summary>
''' 处理Web服务器设置任务控制包
''' </summary>
''' <param name="param">回复参数</param>
Private Function DealSetServiceTaskPacket(param As WebReplyParam) As Byte()
'将数据库的参数部分取出
Dim length As Integer = param.Packet.Length - UtsWebPacket.PacketBits.Param
Dim paramBytes(length - 1) As Byte
Array.Copy(param.Packet, UtsWebPacket.PacketBits.Param, paramBytes, 0, paramBytes.Length)
'转换为字符串
Dim paramStr As String = Encoding.UTF8.GetString(paramBytes)
'处理数据
Dim replyParam As New List(Of Byte)
Try
Dim taskInfo As Dictionary(Of String, String) = JsonConvert.DeserializeObject(Of Dictionary(Of String, String))(paramStr)
If taskInfo.ContainsKey("Name") Then
_tasks.SetTaskParams(taskInfo("Name"), taskInfo)
Else
Throw New Exception($"SetTasks Invalid TaskInfo")
End If
replyParam.Add(&H0)
replyParam.AddRange(Encoding.UTF8.GetBytes(JsonConvert.SerializeObject(_tasks.GetTaskParams(taskInfo("Name")))))
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes(ex.Message))
End Try
Return replyParam.ToArray()
End Function
''' <summary>
''' 处理Web服务器启动任务控制包
''' </summary>
''' <param name="param">回复参数</param>
Private Function DealStartServiceTaskPacket(param As WebReplyParam) As Byte()
'获取执行方式
Dim type As Byte = param.Packet(UtsWebPacket.PacketBits.Param)
'处理数据
Dim replyParam As New List(Of Byte)
If type = 0 Then '清空任务
Try
_tasks.StartAllTasks()
replyParam.Add(&H0)
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes(ex.Message))
End Try
Else
Dim length As Integer = param.Packet.Length - UtsWebPacket.PacketBits.Param - 1
Dim paramBytes(length - 1) As Byte
Array.Copy(param.Packet, UtsWebPacket.PacketBits.Param + 1, paramBytes, 0, paramBytes.Length)
'转换为字符串
Dim paramStr As String = Encoding.UTF8.GetString(paramBytes)
Try
Dim taskNames() As String = paramStr.Split(New Char() {","c}, StringSplitOptions.RemoveEmptyEntries)
For Each taskName As String In taskNames
_tasks.StartTask(taskName)
Next
replyParam.Add(&H0)
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes(ex.Message))
End Try
End If
Return replyParam.ToArray()
End Function
''' <summary>
''' 处理Web服务器启动任务控制包
''' </summary>
''' <param name="param">回复参数</param>
Private Function DealStopServiceTaskPacket(param As WebReplyParam) As Byte()
'获取执行方式
Dim type As Byte = param.Packet(UtsWebPacket.PacketBits.Param)
'处理数据
Dim replyParam As New List(Of Byte)
If type = 0 Then '清空任务
Try
_tasks.StopAllTasks()
replyParam.Add(&H0)
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes(ex.Message))
End Try
Else
Dim length As Integer = param.Packet.Length - UtsWebPacket.PacketBits.Param - 1
Dim paramBytes(length - 1) As Byte
Array.Copy(param.Packet, UtsWebPacket.PacketBits.Param + 1, paramBytes, 0, paramBytes.Length)
'转换为字符串
Dim paramStr As String = Encoding.UTF8.GetString(paramBytes)
Try
Dim taskNames() As String = paramStr.Split(New Char() {","c}, StringSplitOptions.RemoveEmptyEntries)
For Each taskName As String In taskNames
_tasks.StopTask(taskName)
Next
replyParam.Add(&H0)
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes(ex.Message))
End Try
End If
Return replyParam.ToArray()
End Function
''' <summary>
''' 处理Web服务器启动任务控制包
''' </summary>
''' <param name="param">回复参数</param>
Private Function DealReStartServiceTaskPacket(param As WebReplyParam) As Byte()
'获取执行方式
Dim type As Byte = param.Packet(UtsWebPacket.PacketBits.Param)
'处理数据
Dim replyParam As New List(Of Byte)
If type = 0 Then '清空任务
Try
_tasks.RestartAllTasks()
replyParam.Add(&H0)
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes(ex.Message))
End Try
Else
Dim length As Integer = param.Packet.Length - UtsWebPacket.PacketBits.Param - 1
Dim paramBytes(length - 1) As Byte
Array.Copy(param.Packet, UtsWebPacket.PacketBits.Param + 1, paramBytes, 0, paramBytes.Length)
'转换为字符串
Dim paramStr As String = Encoding.UTF8.GetString(paramBytes)
Try
Dim taskNames() As String = paramStr.Split(New Char() {","c}, StringSplitOptions.RemoveEmptyEntries)
For Each taskName As String In taskNames
_tasks.RestartTask(taskName)
Next
replyParam.Add(&H0)
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes(ex.Message))
End Try
End If
Return replyParam.ToArray()
End Function
''' <summary>
''' 处理Web服务器设置日志类型
''' </summary>
''' <param name="param">回复参数</param>
Private Function DealSetLogTypePacket(param As WebReplyParam) As Byte()
Dim replyParam As New List(Of Byte)
'设置日志上报类型
ServiceLog.DbLogType = param.Packet(UtsWebPacket.PacketBits.Param)
replyParam.Add(&H0)
Return replyParam.ToArray()
End Function
''' <summary>
''' 处理Web服务器读取日志类型
''' </summary>
''' <param name="param">回复参数</param>
Private Function DealGetLogTypePacket(param As WebReplyParam) As Byte()
Dim replyParam As New List(Of Byte)
'读取日志上报类型
replyParam.Add(ServiceLog.DbLogType)
Return replyParam.ToArray()
End Function
''' <summary>
''' 处理Web服务器上传文件控制包
''' </summary>
''' <param name="param">回复参数</param>
Private Function DealUploadFilePacket(param As WebReplyParam) As Byte()
' Static ftpDirPath As String = "/uts_Manager/UpLoad/Windows"
Static ftpDirPath As String = $"/uts_Manager/AUTS/{_license.VendorName}/Upload"
Dim replyParam As New List(Of Byte)
Dim sourcePath As String
Dim fileType As String
'获取执行方式
Dim type As Byte = param.Packet(UtsWebPacket.PacketBits.Param)
Select Case type
Case &H1 'usLog
fileType = "utLog"
sourcePath = $"{UtsRegistry.UpdateServiceDirPath}\Log\{UtsRegistry.UpdateServiceName}_{Date.Now:yyyyMMdd}.Log"
Case &H2 'dsLog
fileType = "dsLog"
sourcePath = ServiceLog.LogFilePath
Case &H3 'lic
fileType = "Lic"
sourcePath = UtsRegistry.LicenseFilePath
Case &H4 'dat
fileType = "Dat"
sourcePath = $"{UtsRegistry.LocalDbDirPath}\{_license.SqliteName}"
Case &H10 'auts_Dir
fileType = "rootDir"
sourcePath = $"{UtsRegistry.RootPath}\"
Case &H11 'usLog
fileType = "usLogDir"
sourcePath = $"{UtsRegistry.UpdateServiceDirPath}\Log\"
Case &H12 'dsLog
fileType = "dsLogDir"
sourcePath = $"{UtsRegistry.DataServiceDirPath}\Log\"
Case &H13 'lic
fileType = "licDir"
sourcePath = $"{UtsRegistry.LicenseDirPath}\"
Case &H14 'dat
fileType = "datDir"
sourcePath = $"{UtsRegistry.LocalDbDirPath}\"
Case &H15 'dsDir
fileType = "dsDir"
sourcePath = $"{UtsRegistry.DataServiceDirPath}\"
Case &H16 'usDir
fileType = "usDir"
sourcePath = $"{UtsRegistry.UpdateServiceDirPath}\"
Case Else 'unknown
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes($"Unknown type{type}"))
Return replyParam.ToArray()
End Select
Dim fileName As String = $"{_service.DsIndex:D6}_{Now:yyyyMMdd_HHmmss}_{fileType}.zip"
Dim zipFilePath As String = $"{Path.GetTempPath()}\{fileName}"
Try
If type < &H10 Then
UTS_Core.Compress.Compress.SaveFileToZip(sourcePath, zipFilePath) '压缩文件
Else
UTS_Core.Compress.Compress.SaveDirToZip(sourcePath, zipFilePath) '压缩文件夹
End If
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes($"Compress error{ex.Message}"))
Return replyParam.ToArray()
End Try
Try
_ftpClient.FtpUpload($"{ftpDirPath}\{fileName}", zipFilePath)
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes($"Upload error{ex.Message}"))
Return replyParam.ToArray()
End Try
File.Delete(zipFilePath) '删除压缩文件
replyParam.Add(&H0)
Return replyParam.ToArray()
End Function
''' <summary>
''' 处理Web服务器读取文件大小控制包
''' </summary>
''' <param name="param">回复参数</param>
Private Function DealReadFileSizePacket(param As WebReplyParam) As Byte()
Dim sourcePath As String
Dim replyParam As New List(Of Byte)
Dim type As Byte = param.Packet(UtsWebPacket.PacketBits.Param)
Select Case type
Case &H1 'usLog
sourcePath = $"{UtsRegistry.UpdateServiceDirPath}\Log\{UtsRegistry.UpdateServiceName}_{Date.Now:yyyyMMdd}.Log"
Case &H2 'dsLog
sourcePath = ServiceLog.LogFilePath
Case &H3 'lic
sourcePath = UtsRegistry.LicenseFilePath
Case &H4 'dat
sourcePath = $"{UtsRegistry.LocalDbDirPath}\{_license.SqliteName}"
Case &H10 'auts_Dir
sourcePath = $"{UtsRegistry.RootPath}\"
Case &H11 'usLog
sourcePath = $"{UtsRegistry.UpdateServiceDirPath}\Log\"
Case &H12 'dsLog
sourcePath = $"{UtsRegistry.DataServiceDirPath}\Log\"
Case &H13 'lic
sourcePath = $"{UtsRegistry.LicenseDirPath}\"
Case &H14 'dat
sourcePath = $"{UtsRegistry.LocalDbDirPath}\"
Case &H15 'dsDir
sourcePath = $"{UtsRegistry.DataServiceDirPath}\"
Case &H16 'usDir
sourcePath = $"{UtsRegistry.UpdateServiceDirPath}\"
Case Else
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes($"Unknown type{type}"))
Return replyParam.ToArray()
End Select
Dim fileLength As Long
Try
If type < &H10 Then
fileLength = My.Computer.FileSystem.GetFileInfo(sourcePath).Length '获取文件信息
Else
fileLength = GetFolderSize(sourcePath) '获取文件夹信息
End If
Catch ex As Exception
replyParam.Add(&H1)
replyParam.AddRange(Encoding.UTF8.GetBytes($"GetFileLength error{ex.Message}"))
Return replyParam.ToArray()
End Try
replyParam.Add(&H0)
replyParam.AddRange(BitConverter.GetBytes(fileLength))
Return replyParam.ToArray()
End Function
''' <summary>
''' 获取文件夹大小
''' </summary>
''' <param name="dirPath">文件夹路径</param>
''' <param name="includeSubFolders">是否包含子文件夹的大小,默认包含</param>
''' <returns></returns>
Public Function GetFolderSize(dirPath As String, Optional includeSubFolders As Boolean = True) As Long '获取一个文件夹的大小,可包含子文件夹
Dim lngDirSize As Long
Dim objDir As New DirectoryInfo(dirPath)
For Each objFileInfo As FileInfo In objDir.GetFiles()
lngDirSize += objFileInfo.Length
Next
If includeSubFolders Then
For Each objSubFolder As DirectoryInfo In objDir.GetDirectories()
lngDirSize += GetFolderSize(objSubFolder.FullName)
Next
End If
Return lngDirSize
End Function
Public Class WebReplyParam
Public Ep As IPEndPoint
Public Client As Socket
Public Packet() As Byte
End Class
Public Sub SendDataToWeb(client As Socket, remoteEp As IPEndPoint, packet() As Byte)
Static lock As New Object
SyncLock lock
Try
client.SendTo(packet, remoteEp)
Catch ex As Exception
ServiceLog.WriteErrorLog("SendDataToWeb Error:" & ex.Message)
End Try
End SyncLock
End Sub
#End Region
Private Sub UpdateServiceInfo(state As Object)
Dim Interval As Integer = 1000 * 60 * 1 '单位ms
While _running
Try
_service.UpdateServiceInfo()
Catch ex As Exception
ServiceLog.WriteErrorLog($"Update Service Info Error:{ex.Message}.")
End Try
Thread.Sleep(Interval)
End While
End Sub
Private Sub SaveServiceLog(state As Object)
Dim Interval As Integer = 1000 * 60 * 1 '单位ms
While _running
Try
ServiceLog.SaveLogQueueToDb()
Catch ex As Exception
ServiceLog.WriteErrorLog($"Save Service LogQueue To DB Error:{ex.Message}.")
End Try
Thread.Sleep(Interval)
End While
End Sub
Private Sub InitServiceInfo()
_running = True
_localPort = CInt(UtsRegistry.DataServicePort)
'_logDirPath = $"{UtsRegistry.DataServiceDirPath}\Log"
_logDirPath = $"{UtsRegistry.RootPath}\Log\{My.Application.Info.ProductName}"
_settingsDirPath = $"{UtsRegistry.DataServiceDirPath}\Settings"
_settingsPath = $"{_settingsDirPath}\Settings.xml"
_appManager = New UtsAppManager
_service = New ServiceConfig()
AddHandler ServiceError.ServiceError, AddressOf _service.UpdateErrMsg
End Sub
Private Sub CreateSystemFolder()
Directory.CreateDirectory(_settingsDirPath) '创建设置文件夹
Directory.CreateDirectory(_logDirPath) '创建日志文件夹
End Sub
''' <summary>
''' 初始化License内容
''' </summary>
Private Function CheckLicense() As Boolean
Try
Dim licensePath As String = UtsRegistry.LicenseFilePath
UTS_Core.DebugLog.ApplicationLog.WriteInfoLog($"License Path:{licensePath}.")
2024-03-11 16:32:52 +08:00
_license = New License(licensePath)
_license.CheckLicense()
UTS_Core.DebugLog.ApplicationLog.WriteInfoLog($"License Info:{JsonConvert.SerializeObject(_license, Formatting.Indented)}.")
2024-03-11 16:32:52 +08:00
UTS_Core.DebugLog.ApplicationLog.WriteInfoLog($"CheckLicense Success.")
Catch ex As Exception
UTS_Core.DebugLog.ApplicationLog.WriteErrorLog($"CheckLicense Error:{ex.Message}.")
Return False
End Try
Return True
End Function
''' <summary>
''' 上报添加服务信息至Web服务器
''' </summary>
''' <param name="task">任务信息</param>
Public Sub UploadAddTask(task As Dictionary(Of String, String))
Dim param As New List(Of Byte)
param.Add(&H1)
param.AddRange(Encoding.UTF8.GetBytes(JsonConvert.SerializeObject(task)))
Dim packet() As Byte = _webPacker.FillPacket(CByte(UtsWebPacket.Commands.UploadTaskStatus), param.ToArray)
SendDataToWeb(_webUdpClient.Client, _webRemoteIP, packet)
ServiceLog.WriteDebugLog($"UploadAddTask :{JsonConvert.SerializeObject(task)}")
End Sub
''' <summary>
''' 上报更新服务信息至Web服务器
''' </summary>
''' <param name="task">任务信息</param>
Public Sub UploadUpdateTask(task As Dictionary(Of String, String))
Dim param As New List(Of Byte)
param.Add(&H2)
param.AddRange(Encoding.UTF8.GetBytes(JsonConvert.SerializeObject(task)))
Dim packet() As Byte = _webPacker.FillPacket(CByte(UtsWebPacket.Commands.UploadTaskStatus), param.ToArray)
SendDataToWeb(_webUdpClient.Client, _webRemoteIP, packet)
ServiceLog.WriteDebugLog($"UploadUpdateTask :{JsonConvert.SerializeObject(task)}")
End Sub
''' <summary>
''' 上报删除服务信息至Web服务器
''' </summary>
''' <param name="taskName">任务名称</param>
Public Sub UploadDelTask(taskName As String)
Dim param As New List(Of Byte)
param.Add(&H3)
param.AddRange(Encoding.UTF8.GetBytes(taskName))
Dim packet() As Byte = _webPacker.FillPacket(CByte(UtsWebPacket.Commands.UploadTaskStatus), param.ToArray)
SendDataToWeb(_webUdpClient.Client, _webRemoteIP, packet)
ServiceLog.WriteDebugLog($"UploadDelTask :{taskName}")
End Sub
''' <summary>
''' 上报清空
''' </summary>
Public Sub UploadClearTask()
Dim param As New List(Of Byte)
param.Add(&H4)
Dim packet() As Byte = _webPacker.FillPacket(CByte(UtsWebPacket.Commands.UploadTaskStatus), param.ToArray)
SendDataToWeb(_webUdpClient.Client, _webRemoteIP, packet)
ServiceLog.WriteDebugLog($"UploadClearTask")
End Sub
''' <summary>
''' 读取Xml设置文档初始化设置
''' </summary>
Private Sub ReadSettings()
_tasks = New ServiceTasks()
AddHandler _tasks.AddTask, AddressOf UploadAddTask
AddHandler _tasks.UpdateTask, AddressOf UploadUpdateTask
AddHandler _tasks.DelTask, AddressOf UploadDelTask
AddHandler _tasks.ClearTask, AddressOf UploadClearTask
If File.Exists(_settingsPath) Then
Try
Dim settings As ServiceSettings = Serializer.DeserializeFormXml(Of ServiceSettings)(_settingsPath)
For Each task As ServiceTask In settings.Tasks
_tasks.Add(task, False)
If task.TaskStatus = ServiceTask.ServiceTaskStatusEnum.Start Then
task.Start()
End If
Next
ServiceLog.WriteInfoLog($"ReadSettings Success!")
Catch ex As Exception
ServiceLog.WriteErrorLog($"ReadSettings Error:{ex.Message}")
End Try
End If
'确保每次都有数据库同步任务开启
Dim hasDbSync As Boolean = False
For Each task As ServiceTask In _tasks.GetAllServiceTasks()
If task.TaskType = ServiceTask.ServiceTaskTypeEnum.DbSync Then hasDbSync = True
Next
If hasDbSync = False Then _tasks.Add(New DbSyncServiceTask())
End Sub
''' <summary>
''' 保存当前设置至xml中
''' </summary>
Private Sub SaveSettings()
Try
Dim settings As New ServiceSettings
settings.Tasks = _tasks.GetAllServiceTasks
Serializer.SerializeToXml(_settingsPath, settings)
ServiceLog.WriteInfoLog($"SaveSettings Success!")
Catch ex As Exception
ServiceLog.WriteErrorLog($"SaveSettings Error:{ex.Message}")
End Try
End Sub
''' <summary>
''' 开始循环监听数据
''' </summary>
Private Sub ListenUtsApp(state As Object)
_tcpAccepting = True
Dim localAddress As IPAddress = IPAddress.Parse("127.0.0.1")
While _tcpAccepting
If PortInUse(_localPort) Then
_localPort += 1
If _localPort >= 65535 Then _localPort = 1024
Continue While
End If
Try
_tcpListener = New TcpListener(localAddress, _localPort)
_tcpListener.Start()
ServiceLog.WriteDebugLog($"Tcp Service StartListenIp:{localAddress}, Port:{_localPort}")
UtsRegistry.DataServicePort = _localPort.ToString()
Exit While
Catch ex As Exception
ServiceLog.WriteErrorLog($"Tcp Service StartListen Error:{ex.Message}")
_localPort += 1
End Try
End While
While _tcpAccepting
Try
Dim client As TcpClient = _tcpListener.AcceptTcpClient()
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf TcpClientReceive), client)
Catch ex As Exception
ServiceLog.WriteErrorLog($"Tcp Service Listener Error:{ex.Message}")
End Try
End While
End Sub
''' <summary>
''' 判断当前网络端口是否被使用
''' </summary>
''' <param name="port"></param>
''' <returns></returns>
Private Function PortInUse(port As Integer) As Boolean
Dim result As Boolean
Dim ipEndPoints() As IPEndPoint = IPGlobalProperties.GetIPGlobalProperties().GetActiveTcpListeners()
For Each ipEndPoint As IPEndPoint In ipEndPoints
If ipEndPoint.Port = port Then
result = True
Continue For
End If
Next
Return result
End Function
#Region "处理数据"
''' <summary>
''' 处理数据,并返回回复数据
''' </summary>
''' <param name="client">当前命令的套接字</param>
''' <param name="taskParam">需要处理的数据参数</param>
''' <returns>需要回复的数据</returns>
Private Function DealReceiveData(client As TcpClient, taskParam As TaskJsonParam) As TaskJsonParam
Select Case taskParam.CmdName
Case TaskJsonParam.CmdNamesEnum.AddTasks
Return DealAddTasks(taskParam)
Case TaskJsonParam.CmdNamesEnum.SetTasks
Return DealSetTasks(taskParam)
Case TaskJsonParam.CmdNamesEnum.GetTasks
Return DealGetTasks(taskParam)
Case TaskJsonParam.CmdNamesEnum.GetAllTasks
Return DealGetAllTasks(taskParam)
Case TaskJsonParam.CmdNamesEnum.DeleteTasks
Return DealDeleteTasks(taskParam)
Case TaskJsonParam.CmdNamesEnum.DeleteAllTasks
Return DealDeleteAllTasks(taskParam)
Case TaskJsonParam.CmdNamesEnum.StartTasks
Return DealStartTasks(taskParam)
Case TaskJsonParam.CmdNamesEnum.StartAllTasks
Return DealStartAllTasks(taskParam)
Case TaskJsonParam.CmdNamesEnum.StopTasks
Return DealStopTasks(taskParam)
Case TaskJsonParam.CmdNamesEnum.StopAllTasks
Return DealStopAllTasks(taskParam)
Case TaskJsonParam.CmdNamesEnum.RestartTasks
Return DealReStartTasks(taskParam)
Case TaskJsonParam.CmdNamesEnum.RestartAllTasks
Return DealRestartAllTasks(taskParam)
Case TaskJsonParam.CmdNamesEnum.GetServiceVersion
Return DealGetServiceVersionTasks(client, taskParam)
Case TaskJsonParam.CmdNamesEnum.InitApp
Return DealInitApp(client, taskParam)
Case TaskJsonParam.CmdNamesEnum.AppMsg
Return DealAppMsg(client, taskParam)
Case TaskJsonParam.CmdNamesEnum.ServiceMsg
Return DealServiceMsg()
Case Else
Throw New Exception($"Invalid CmdName:{taskParam.CmdName}")
End Select
End Function
Private Function DealServiceMsg() As TaskJsonParam
Return Nothing
End Function
Private Function DealAppMsg(client As TcpClient, taskParam As TaskJsonParam) As TaskJsonParam
Dim replyParam As New TaskJsonParam(taskParam.CmdName, True)
Try
Dim app As UtsApp = _appManager.GetApp(taskParam.AppName)
app.Client = client
app.Name = taskParam.AppName
'依此判断App修改类型
Dim status As TaskJsonParam.AppMsgTypes
status = CType([Enum].Parse(GetType(TaskJsonParam.AppMsgTypes), taskParam.AppInfo("AppStatus")), TaskJsonParam.AppMsgTypes)
replyParam.AppInfo.Add("AppStatus", taskParam.AppInfo("AppStatus"))
Dim infoChanged As Boolean = False
Select Case status
Case TaskJsonParam.AppMsgTypes.AppStart
app.Status = UtsApp.AppStatus.Started
Case TaskJsonParam.AppMsgTypes.AppClose
app.Status = UtsApp.AppStatus.Closed
infoChanged = True
Case TaskJsonParam.AppMsgTypes.AppAlive
If app.Status <> UtsApp.AppStatus.Started Then
app.Status = UtsApp.AppStatus.Started
infoChanged = True
End If
If app.ProjectName <> taskParam.AppInfo("Project") Then
app.ProjectName = taskParam.AppInfo("Project")
infoChanged = True
End If
If app.StationName <> taskParam.AppInfo("Station") Then
app.StationName = taskParam.AppInfo("Station")
infoChanged = True
End If
If app.TestPlan <> taskParam.AppInfo("TestPlan") Then
app.TestPlan = taskParam.AppInfo("TestPlan")
infoChanged = True
End If
If app.Version <> taskParam.AppInfo("Version") Then
app.Version = taskParam.AppInfo("Version")
infoChanged = True
End If
app.TestStatus = CType([Enum].Parse(GetType(TestStatusMonitor.TestStatusEnum), taskParam.AppInfo("TestStatus")), TestCommandStatusMonitor.TestCommandStatusEnum)
app.UtsStatus = CType([Enum].Parse(GetType(ComportStatusMonitor.ComPortConnectStatusEnum), taskParam.AppInfo("UtsStatus")), ComportStatusMonitor.ComPortConnectStatusEnum)
replyParam.AppInfo.Add("DbStatus", _service.DbStatus.ToString)
replyParam.AppInfo.Add("FtpStatus", _service.FtpStatus.ToString)
replyParam.AppInfo.Add("CacheCount", _service.CacheCount.ToString)
replyParam.AppInfo.Add("SyncTime", DbSyncServiceTask.LastUpdateTime)
replyParam.AppInfo.Add("Services", _service.NetworkNeiborhood)
Case TaskJsonParam.AppMsgTypes.StationChanged
app.Status = UtsApp.AppStatus.Started
app.ProjectName = taskParam.AppInfo("Project")
app.StationName = taskParam.AppInfo("Station")
app.TestPlan = taskParam.AppInfo("TestPlan")
infoChanged = True
Case TaskJsonParam.AppMsgTypes.SnListChanged
If app.Status <> UtsApp.AppStatus.Started Then
app.Status = UtsApp.AppStatus.Started
infoChanged = True
End If
'广播通知SN表变化
Dim sg As New ServiceGroup
sg.ServiceGroup = _service.BarnchNet
sg.ServiceIndex = _service.DsIndex
sg.Index = GetGroupNextSendInxex()
sg.Type = "SnListChanged"
sg.GroupInfo.Add("DB", taskParam.AppInfo("DB"))
sg.GroupInfo.Add("Barcode", taskParam.AppInfo("Barcode"))
sg.GroupInfo.Add("SnListOrder", taskParam.AppInfo("SnListOrder"))
sg.GroupInfo.Add("StartTime", taskParam.AppInfo("StartTime"))
sg.GroupInfo.Add("Result", taskParam.AppInfo("Result"))
sg.GroupInfo.Add("A1String", taskParam.AppInfo("A1String"))
SendGroupMsg(sg)
End Select
'记录端口号与App的绑定关系,断连时通过端口号更新APP的连接状态
_appManager.BindClientAndApp(client, app)
If infoChanged Then
ServiceLog.WriteDebugLog("App Status Chaged,Send Upload App Status To Web!")
SendUploadAppStatusToWeb(app)
End If
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Pass.ToString()
Catch ex As Exception
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Fail.ToString()
replyParam.CmdMsg = ex.Message
ServiceLog.WriteDebugLog($"Deal AppMsg Error:{ex.Message}")
End Try
Return replyParam
End Function
''' <summary>
''' 发送Task信息至Web服务器
''' </summary>
''' <param name="task">UtsApp对象</param>
Private Sub SendUploadTaskStatusToWeb(task As ServiceTask)
Dim jsonString As String = JsonConvert.SerializeObject(task)
Dim packet() As Byte = _webPacker.FillPacket(CByte(UtsWebPacket.Commands.UploadTaskStatus), Encoding.UTF8.GetBytes(jsonString))
SendDataToWeb(_webUdpClient.Client, _webRemoteIP, packet.ToArray)
End Sub
''' <summary>
''' 发送App信息至Web服务器
''' </summary>
''' <param name="app">UtsApp对象</param>
Private Sub SendUploadAppStatusToWeb(app As UtsApp)
Dim jsonString As String = JsonConvert.SerializeObject(app)
Dim packet() As Byte = _webPacker.FillPacket(CByte(UtsWebPacket.Commands.UploadAppStatus), Encoding.UTF8.GetBytes(jsonString))
SendDataToWeb(_webUdpClient.Client, _webRemoteIP, packet.ToArray)
End Sub
Private Function DealInitApp(client As TcpClient, taskParam As TaskJsonParam) As TaskJsonParam
Dim replyParam As New TaskJsonParam(taskParam.CmdName, True)
Try
Dim app As UtsApp = _appManager.GetApp(taskParam.AppName)
app.Client = client
app.Name = taskParam.AppName
app.Status = UtsApp.AppStatus.Started
'获取软件索引
Dim appReg As New AppRegister(_service.DsIndex, taskParam.AppName, taskParam.AppInfo("AppVersion"))
replyParam.AppInfo.Add("ServiceIndex", _service.DsIndex.ToString())
'变化上报状态
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Pass.ToString()
Catch ex As Exception
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Fail.ToString()
replyParam.CmdMsg = ex.Message
End Try
Return replyParam
End Function
''' <summary>
''' 处理添加任务
''' </summary>
''' <param name="taskParam">任务参数</param>
''' <returns></returns>
Private Function DealAddTasks(taskParam As TaskJsonParam) As TaskJsonParam
Dim replyParam As New TaskJsonParam(taskParam.CmdName, True)
Try
For Each taskInfo As Dictionary(Of String, String) In taskParam.TasksInfo
_tasks.Add(taskInfo)
Next
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Pass.ToString()
Catch ex As Exception
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Fail.ToString()
replyParam.CmdMsg = ex.Message
End Try
Return replyParam
End Function
''' <summary>
''' 处理修改任务参数
''' </summary>
''' <param name="taskParam">任务参数</param>
''' <returns></returns>
Private Function DealSetTasks(taskParam As TaskJsonParam) As TaskJsonParam
Dim replyParam As New TaskJsonParam(taskParam.CmdName, True)
Try
For Each taskInfo As Dictionary(Of String, String) In taskParam.TasksInfo
If taskInfo.ContainsKey("Name") Then
_tasks.SetTaskParams(taskInfo("Name"), taskInfo)
Else
Throw New Exception($"SetTasks Invalid TaskInfo")
End If
Next
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Pass.ToString()
Catch ex As Exception
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Fail.ToString()
replyParam.CmdMsg = ex.Message
End Try
Return replyParam
End Function
''' <summary>
''' 处理获取指定任务的信息
''' </summary>
''' <param name="taskParam">任务参数</param>
''' <returns></returns>
Private Function DealGetTasks(taskParam As TaskJsonParam) As TaskJsonParam
Dim replyParam As New TaskJsonParam(taskParam.CmdName, True)
Try
For Each taskName As String In taskParam.TasksName
replyParam.TasksInfo.Add(_tasks.GetTaskParams(taskName))
Next
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Pass.ToString()
Catch ex As Exception
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Fail.ToString()
replyParam.CmdMsg = ex.Message
End Try
Return replyParam
End Function
''' <summary>
''' 获取所有任务的信息
''' </summary>
''' <param name="taskParam">任务参数</param>
''' <returns></returns>
Private Function DealGetAllTasks(taskParam As TaskJsonParam) As TaskJsonParam
Dim replyParam As New TaskJsonParam(taskParam.CmdName, True)
Try
replyParam.TasksInfo = _tasks.GetAllTasksParam()
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Pass.ToString()
Catch ex As Exception
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Fail.ToString()
replyParam.CmdMsg = ex.Message
End Try
Return replyParam
End Function
''' <summary>
''' 处理删除指定任务
''' </summary>
''' <param name="taskParam">任务参数</param>
''' <returns></returns>
Private Function DealDeleteTasks(taskParam As TaskJsonParam) As TaskJsonParam
Dim replyParam As New TaskJsonParam(taskParam.CmdName, True)
Try
For Each taskName As String In taskParam.TasksName
_tasks.RemoveAt(taskName)
Next
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Pass.ToString()
Catch ex As Exception
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Fail.ToString()
replyParam.CmdMsg = ex.Message
End Try
Return replyParam
End Function
''' <summary>
''' 删除所有任务
''' </summary>
''' <param name="taskParam">任务参数</param>
''' <returns></returns>
Private Function DealDeleteAllTasks(taskParam As TaskJsonParam) As TaskJsonParam
Dim replyParam As New TaskJsonParam(taskParam.CmdName, True)
Try
_tasks.Clear()
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Pass.ToString()
Catch ex As Exception
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Fail.ToString()
replyParam.CmdMsg = ex.Message
End Try
Return replyParam
End Function
''' <summary>
''' 处理开启指定任务
''' </summary>
''' <param name="taskParam">任务参数</param>
''' <returns></returns>
Private Function DealStartTasks(taskParam As TaskJsonParam) As TaskJsonParam
Dim replyParam As New TaskJsonParam(taskParam.CmdName, True)
Try
For Each taskName As String In taskParam.TasksName
_tasks.StartTask(taskName)
Next
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Pass.ToString()
Catch ex As Exception
ServiceLog.WriteErrorLog($"Start Task Error:{ex.Message}")
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Fail.ToString()
replyParam.CmdMsg = ex.Message
End Try
Return replyParam
End Function
''' <summary>
''' 开启所有任务
''' </summary>
''' <param name="taskParam">任务参数</param>
''' <returns></returns>
Private Function DealStartAllTasks(taskParam As TaskJsonParam) As TaskJsonParam
Dim replyParam As New TaskJsonParam(taskParam.CmdName, True)
Try
_tasks.StartAllTasks()
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Pass.ToString()
Catch ex As Exception
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Fail.ToString()
replyParam.CmdMsg = ex.Message
End Try
Return replyParam
End Function
''' <summary>
''' 处理暂停指定任务
''' </summary>
''' <param name="taskParam">任务参数</param>
''' <returns></returns>
Private Function DealStopTasks(taskParam As TaskJsonParam) As TaskJsonParam
Dim replyParam As New TaskJsonParam(taskParam.CmdName, True)
Try
For Each taskName As String In taskParam.TasksName
_tasks.StopTask(taskName)
Next
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Pass.ToString()
Catch ex As Exception
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Fail.ToString()
replyParam.CmdMsg = ex.Message
End Try
Return replyParam
End Function
''' <summary>
''' 停止所有任务
''' </summary>
''' <param name="taskParam">任务参数</param>
''' <returns></returns>
Private Function DealStopAllTasks(taskParam As TaskJsonParam) As TaskJsonParam
Dim replyParam As New TaskJsonParam(taskParam.CmdName, True)
Try
_tasks.StopAllTasks()
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Pass.ToString()
Catch ex As Exception
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Fail.ToString()
replyParam.CmdMsg = ex.Message
End Try
Return replyParam
End Function
''' <summary>
''' 处理立即执行指定任务
''' </summary>
''' <param name="taskParam">任务参数</param>
''' <returns></returns>
Private Function DealReStartTasks(taskParam As TaskJsonParam) As TaskJsonParam
Dim replyParam As New TaskJsonParam(taskParam.CmdName, True)
Try
For Each taskName As String In taskParam.TasksName
_tasks.RestartTask(taskName)
Next
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Pass.ToString()
Catch ex As Exception
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Fail.ToString()
replyParam.CmdMsg = ex.Message
End Try
Return replyParam
End Function
''' <summary>
''' 立即执行所有任务
''' </summary>
''' <param name="taskParam">任务参数</param>
''' <returns></returns>
Private Function DealRestartAllTasks(taskParam As TaskJsonParam) As TaskJsonParam
Dim replyParam As New TaskJsonParam(taskParam.CmdName, True)
Try
_tasks.RestartAllTasks()
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Pass.ToString()
Catch ex As Exception
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Fail.ToString()
replyParam.CmdMsg = ex.Message
End Try
Return replyParam
End Function
''' <summary>
''' 获取DataService版本信息
''' </summary>
''' <param name="taskParam">任务参数</param>
''' <returns></returns>
Private Function DealGetServiceVersionTasks(client As TcpClient, taskParam As TaskJsonParam) As TaskJsonParam
Dim replyParam As New TaskJsonParam(taskParam.CmdName, True)
Try
Dim version As String
version = _service.DsVerString
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Pass.ToString()
replyParam.ServiceVersion = version
'更新US连接状态
_service.UsConnected = 1
Dim app As UtsApp = _appManager.GetApp(taskParam.AppName)
app.Client = client
app.Name = taskParam.AppName
'记录端口号与App的绑定关系,断连时通过端口号更新APP的连接状态
_appManager.BindClientAndApp(client, app)
'处理US的心跳包并更新US的版本
If String.Compare(_service.UsName, taskParam.ServiceVersion) <> 0 Then Return replyParam
If String.IsNullOrEmpty(taskParam.ServiceVersion) Then Return replyParam
If String.Compare(_service.UsVerString, taskParam.ServiceVersion) = 0 Then Return replyParam
_service.UsVerString = taskParam.ServiceVersion
UtsRegistry.UpdateServiceVersion = _service.UsVerString
Catch ex As Exception
replyParam.CmdStatus = TaskJsonParam.CmdStatusEnum.Fail.ToString()
replyParam.CmdMsg = ex.Message
End Try
Return replyParam
End Function
#End Region
Private Sub TcpClientReceive(state As Object)
Dim client As TcpClient = CType(state, TcpClient)
Dim len As Integer
Dim buf(4096) As Byte
ServiceLog.WriteDebugLog($"Accept New TcpClient:{client.Client.RemoteEndPoint}")
While True
Try
len = client.Client.Receive(buf)
Catch ex As Exception
ServiceLog.WriteDebugLog($"TcpClient {client.Client.RemoteEndPoint} Recycling Connection, Receive Error:{ex.Message}")
Dim app As UtsApp = _appManager.GetClientBindApp(client)
_appManager.CancelClientBind(client) '会将地址与App绑定关系移除
If app IsNot Nothing Then SendUploadAppStatusToWeb(app)
Exit While
End Try
If len = 0 Then
'将对应App置为断连
ServiceLog.WriteDebugLog($"TcpClient {client.Client.RemoteEndPoint} Is Disconnect.")
Dim app As UtsApp = _appManager.GetClientBindApp(client)
_appManager.CancelClientBind(client) '会将地址与App绑定关系移除
If app IsNot Nothing Then SendUploadAppStatusToWeb(app)
Exit While
End If
Dim destBuf(len - 1) As Byte
Array.Copy(buf, 0, destBuf, 0, destBuf.Length)
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf DealTcpClientRecvData), New TcpData(client, destBuf))
End While
End Sub
Private Sub DealTcpClientRecvData(state As Object)
Dim data As TcpData = CType(state, TcpData)
Dim jsonStrings As String = Encoding.UTF8.GetString(data.Buffer)
'校验Json字符串必须以回车换行结尾
If jsonStrings.EndsWith(vbCrLf) = False Then
ServiceLog.WriteDebugLog($"Deal Tcp Receive Data Not EndsWith!")
Return
End If
For Each jsonString As String In jsonStrings.Split(New String() {vbCrLf}, Integer.MaxValue, StringSplitOptions.RemoveEmptyEntries)
Try
'反序列化
Dim taskParam As TaskJsonParam = TaskJsonParam.DeserializeFormJson(jsonString)
'反序列化失败,则处理下一包
If IsNothing(taskParam) Then
ServiceLog.WriteDebugLog($"Deal Tcp Receive Data IsNothing(taskParam)!")
Continue For
End If
'处理数据,返回回复数据
Dim reply As TaskJsonParam = DealReceiveData(data.Client, taskParam)
'无需回复,则处理下一包
If reply Is Nothing Then Continue For
'序列化回复数据
Dim replyString As String = TaskJsonParam.SerializeToJson(reply) & vbCrLf
'回复数据
SendJsonString(data.Client, replyString)
Catch ex As Exception
ServiceLog.WriteErrorLog($"Deal Tcp Receive Data Error!")
End Try
Next
End Sub
Public Class TcpData
Sub New(c As TcpClient, buf() As Byte)
Client = c
Buffer = buf
End Sub
Public Client As TcpClient
Public Buffer() As Byte
End Class
''' <summary>
''' 发送数据
''' </summary>
''' <param name="tcpClient"></param>
''' <param name="jsonString"></param>
Private Sub SendJsonString(tcpClient As TcpClient, jsonString As String)
Static SendLock As New Object
If tcpClient Is Nothing Then Return
If tcpClient.Client Is Nothing Then Return
SyncLock SendLock
Try
Dim buf() As Byte = Encoding.UTF8.GetBytes(jsonString)
tcpClient.GetStream().Write(buf, 0, buf.Length)
Catch ex As Exception
ServiceLog.WriteErrorLog($"TcpClient Send Data Error!")
End Try
End SyncLock
End Sub
End Class