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 ''' 监听句柄 Private _tcpListener As TcpListener ''' 服务任务列表 Private _tasks As ServiceTasks ''' 当前设备App列表 Private _appManager As UtsAppManager ''' 鉴权信息管理类 Private _license As License ''' FTP服务类 Private _ftpClient As FtpService ''' 服务信息管理类 Private _service As ServiceConfig ''' Tcp监听中 Private _tcpAccepting As Boolean ''' Tcp本地端口号 Private _localPort As Integer ''' 日志文件夹路径 Private _logDirPath As String ''' 设置文件夹路径 Private _settingsDirPath As String ''' 设置文件路径 Private _settingsPath As String ''' ''' 服务正在运行中 ''' 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 ''' ''' 更新本地私有IP ''' ''' 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 "服务多播" ''' 广播端口 Private _groupPort As Integer ''' 广播套接字 Private _groupClient As UdpClient ''' 广播发送锁 Private _groupLock As New Object ''' 广播发送序号 Private _groupSendIndex As Integer = 0 ''' 广播服务管理器 Private _groupManager As ServiceGroupManager ''' ''' 本地IP变化的处理 ''' ''' Private Sub UdatePrivateIP(ip As String) ServiceLog.WriteInfoLog($"Private Ip Changed!Old Ip:{ServiceLog.PrivateIp},New Ip:{ip}") '更新日志的IP字段 ServiceLog.PrivateIp = ip End Sub ''' ''' MAC地址变化处理 ''' ''' Private Sub UpdateMAC(mac As String) ServiceLog.WriteInfoLog($"MAC Changed!Old mac:{ServiceLog.MAC},New mac:{mac}") '更新日志的MAC字段 ServiceLog.MAC = mac End Sub ''' ''' 初始化广播套接字 ''' 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 ''' ''' 接收处理来自数据服务的多播数据 ''' ''' UDP套接字 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 ''' ''' 处理数据服务的广播包 ''' ''' 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 ''' ''' 获取广播下一次发送序号,并将序号+1 ''' ''' 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 ''' ''' 发送广播信息 ''' ''' 需要广播的服务内容 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 ''' ''' 初始化数据服务日志所需信息,需要提前初始化License与ServiceRegister ''' 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服务器通讯" ''' web通讯套接字对象 Private _webUdpClient As New UdpClient(New IPEndPoint(IPAddress.Any, _localPort)) ''' web通讯IP地址与端口 Private _webRemoteIP As IPEndPoint = Nothing ''' web服务组包对象 Private ReadOnly _webPacker As New UtsWebPacket ''' 当前设备公网Ip Private _localPublicIp As String ''' uts系列软件访问ftp的主机地址 Private _ftpHost As String ''' uts系列软件访问db的主机地址 Private _dbHost As String ''' ''' 定期发送心跳包,并获取公网IP与ftp网址 ''' ''' 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 ''' ''' 接收处理来自Web服务器的数据 ''' ''' 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 DealHeartbeatPacket(param) 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 ''' ''' 处理上传任务变化后状态 ''' ''' Private Sub DealUploadTaskStatusPacket(param As WebReplyParam) '暂无处理 End Sub ''' ''' 处理上传App变化后状态 ''' ''' Private Sub DealUploadAppStatusPacket(param As WebReplyParam) '暂无处理 End Sub ''' ''' 处理Web服务器心跳回复包 ''' ''' 回复参数 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 ''' ''' 填充反控App包的基本信息,含不包含附加信息 ''' ''' 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 ''' ''' 处理Web服务器获取App状态包 ''' ''' 回复参数 ''' 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 ''' ''' 处理Web服务器反控App状态包 ''' ''' 回复参数 ''' 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 ''' ''' 处理Web服务器添加任务控制包 ''' ''' 回复参数 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 ''' ''' 处理Web服务器删除任务控制包 ''' ''' 回复参数 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 ''' ''' 处理Web服务器获取任务控制包 ''' ''' 回复参数 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 ''' ''' 处理Web服务器设置任务控制包 ''' ''' 回复参数 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 ''' ''' 处理Web服务器启动任务控制包 ''' ''' 回复参数 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 ''' ''' 处理Web服务器启动任务控制包 ''' ''' 回复参数 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 ''' ''' 处理Web服务器启动任务控制包 ''' ''' 回复参数 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 ''' ''' 处理Web服务器设置日志类型 ''' ''' 回复参数 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 ''' ''' 处理Web服务器读取日志类型 ''' ''' 回复参数 Private Function DealGetLogTypePacket(param As WebReplyParam) As Byte() Dim replyParam As New List(Of Byte) '读取日志上报类型 replyParam.Add(ServiceLog.DbLogType) Return replyParam.ToArray() End Function ''' ''' 处理Web服务器上传文件控制包 ''' ''' 回复参数 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 ''' ''' 处理Web服务器读取文件大小控制包 ''' ''' 回复参数 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 ''' ''' 获取文件夹大小 ''' ''' 文件夹路径 ''' 是否包含子文件夹的大小,默认包含 ''' 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 ''' ''' 初始化License内容 ''' Private Function CheckLicense() As Boolean Try Dim licensePath As String = UtsRegistry.LicenseFilePath _license = New License(licensePath) _license.CheckLicense() 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 ''' ''' 上报添加服务信息至Web服务器 ''' ''' 任务信息 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 ''' ''' 上报更新服务信息至Web服务器 ''' ''' 任务信息 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 ''' ''' 上报删除服务信息至Web服务器 ''' ''' 任务名称 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 ''' ''' 上报清空 ''' 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 ''' ''' 读取Xml设置文档初始化设置 ''' 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 ''' ''' 保存当前设置至xml中 ''' 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 ''' ''' 开始循环监听数据 ''' 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 StartListen,Ip:{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 ''' ''' 判断当前网络端口是否被使用 ''' ''' ''' 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 "处理数据" ''' ''' 处理数据,并返回回复数据 ''' ''' 当前命令的套接字 ''' 需要处理的数据参数 ''' 需要回复的数据 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 ''' ''' 发送Task信息至Web服务器 ''' ''' UtsApp对象 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 ''' ''' 发送App信息至Web服务器 ''' ''' UtsApp对象 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 ''' ''' 处理添加任务 ''' ''' 任务参数 ''' 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 ''' ''' 处理修改任务参数 ''' ''' 任务参数 ''' 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 ''' ''' 处理获取指定任务的信息 ''' ''' 任务参数 ''' 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 ''' ''' 获取所有任务的信息 ''' ''' 任务参数 ''' 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 ''' ''' 处理删除指定任务 ''' ''' 任务参数 ''' 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 ''' ''' 删除所有任务 ''' ''' 任务参数 ''' 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 ''' ''' 处理开启指定任务 ''' ''' 任务参数 ''' 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 ''' ''' 开启所有任务 ''' ''' 任务参数 ''' 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 ''' ''' 处理暂停指定任务 ''' ''' 任务参数 ''' 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 ''' ''' 停止所有任务 ''' ''' 任务参数 ''' 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 ''' ''' 处理立即执行指定任务 ''' ''' 任务参数 ''' 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 ''' ''' 立即执行所有任务 ''' ''' 任务参数 ''' 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 ''' ''' 获取DataService版本信息 ''' ''' 任务参数 ''' 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 ''' ''' 发送数据 ''' ''' ''' 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