Imports System.IO Imports System.Net Imports System.Net.Sockets Imports System.Text Imports UTS_Core.Database Imports UTS_Core.Security Imports UTS_Core.UTSModule Imports UTS_Core.UTSModule.DbConnect Imports UTS_Core.UTSModule.DbTableModel.Manage Imports UTS_Core.UTSModule.License Public Class FrmUpdateConfig Public Property RootPath() As String Public Property LicenseFileName() As String Public Property DataServiceName() As String Public Property UpdateServiceName() As String Public Property DataServiceAlias() As String Private _srcLicenseFilePath As String Private _destLicenseFilePath As String Private _serviceRegister As ServiceRegister ''' ''' 窗体加载 ''' ''' ''' Private Sub FrmUpdateConfig_Load(sender As Object, e As EventArgs) Handles MyBase.Load InitConfig() TBoRootPath.Text = RootPath TBoLicnese.Text = _srcLicenseFilePath TxtAlias.Text = DataServiceAlias RtxTip.Text = String.Empty If rb_SyncFloder_FollowRootPath.Checked Then lab_SyncPath.Text = TBoRootPath.Text & "\AUTS_Sync" If rb_SyncFloder_Spicfied.Checked Then lab_SyncPath.Text = tb_SyncFolder_BySelected.Text & "\AUTS_Sync" End Sub ''' ''' 初始化配置信息 ''' Private Sub InitConfig() Try UpdateInstallTip(0, "[Registry Value]") RootPath = UtsRegistry.RootPath LicenseFileName = UtsRegistry.LicenseFileName DataServiceAlias = UtsRegistry.DataServiceAlias _srcLicenseFilePath = UtsRegistry.LicenseFilePath Catch ex As Exception UpdateInstallTip(0, "[Default Value]") RootPath = $"C:\AUTS" DataServiceAlias = String.Empty LicenseFileName = String.Empty _srcLicenseFilePath = String.Empty End Try DataServiceName = $"AUTS_DataService" UpdateServiceName = $"AUTS_UpdateService" End Sub ''' ''' 选择所需要存放的根路径 ''' ''' ''' Private Sub BtnRootPath_Click(sender As Object, e As EventArgs) Handles BtnRootPath.Click TBoRootPath.Text = SelectFolderString() If rb_SyncFloder_FollowRootPath.Checked Then lab_SyncPath.Text = TBoRootPath.Text & "\AUTS_Sync" End Sub ''' ''' 选择同步文件夹 ''' ''' Private Function SelectSyncFolderString() As String Dim txtString As String = String.Empty Using folder As New FolderBrowserDialog If folder.ShowDialog() = DialogResult.OK Then txtString = folder.SelectedPath End If End Using If String.IsNullOrWhiteSpace(txtString) Then txtString = TBoRootPath.Text & "\AUTS_Sync" End If Return txtString End Function ''' ''' 自定义选择文件夹 ''' ''' Private Function SelectFolderString() As String Dim txtString As String = String.Empty Using folder As New FolderBrowserDialog If folder.ShowDialog() = DialogResult.OK Then txtString = folder.SelectedPath End If End Using If String.IsNullOrWhiteSpace(txtString) Then txtString = "C:\AUTS" Else If txtString.EndsWith("AUTS") = False Then If txtString.EndsWith("\") = False Then txtString &= "\" End If txtString &= "AUTS" End If End If Return txtString End Function ''' ''' 选择所需要的License文件 ''' ''' ''' Private Sub BtnLicense_Click(sender As Object, e As EventArgs) Handles BtnLicense.Click TBoLicnese.Text = SelectFileString() End Sub ''' ''' 自定义选择文件 ''' ''' Private Function SelectFileString() As String Dim txtString As String = String.Empty Using folder As New OpenFileDialog If folder.ShowDialog() = DialogResult.OK Then 'txtString = folder.SafeFileName txtString = folder.FileName End If End Using Return txtString End Function Private Sub UpdateProgressBar(value As Integer) TsPrgInstall.Value = value End Sub Private Sub UpdateInstallLog(value As Integer, log As String) If value = 0 Then RtxTip.Clear() RtxTip.AppendText($"[{value,3}%]-{log}{vbCrLf}") RtxTip.ScrollToCaret() End Sub Private Sub UpdateInstallTip(value As Integer, str As String) UpdateProgressBar(value) UpdateInstallLog(value, str) End Sub ''' ''' 开始一键发布更新 ''' ''' ''' Private Sub BtnStartUpdate_Click(sender As Object, e As EventArgs) Handles BtnStartUpdate.Click UpdateInstallTip(0, "Begin Install...") UpdateCacheValue() Try UpdateInstallTip(0, "Begin Check Input Info...") CheckCacheValue() UpdateInstallTip(5, "Check Input Info Success!") Catch ex As Exception UpdateInstallTip(100, $"Check Input Info Error:{ex.Message}") Return End Try '创建所需文件夹 Try UpdateInstallTip(10, "Begin CreateSystemFolder...") CreateSystemFolder() UpdateInstallTip(15, "CreateSystemFolder Success!") Catch ex As Exception UpdateInstallTip(100, $"CreateSystemFolder Error:{ex.Message}") Return End Try '拷贝License文件至指定路径 Try UpdateInstallTip(15, $"Begin Copy License {_srcLicenseFilePath} To {_destLicenseFilePath}...") If String.Compare(_srcLicenseFilePath, _destLicenseFilePath, True) <> 0 Then File.Copy(_srcLicenseFilePath, _destLicenseFilePath, True) Else UpdateInstallTip(20, "Don't Need Copy License !") End If UpdateInstallTip(20, "Copy License Success!") Catch ex As Exception UpdateInstallTip(100, $"Copy License Error:{ex.Message}") Return End Try '下载安装 Try UpdateInstallTip(20, "Begin InstallUpdateService...") InstallUpdateService() UpdateInstallTip(100, "InstallUpdateService Success!") Catch ex As Exception UpdateInstallTip(100, $"InstallUpdateService Error:{ex.Message}") Return End Try '创建同步目录 UpdateInstallTip(100, "Begin to create sync folder...") If CreateSyncFolder() = True Then UpdateInstallTip(100, "Success to Create sync folder!") Else UpdateInstallTip(100, "Fail to Create sync folder!") End If End Sub Private Sub UpdateCacheValue() RootPath = TBoRootPath.Text LicenseFileName = Path.GetFileName(TBoLicnese.Text) _srcLicenseFilePath = TBoLicnese.Text DataServiceAlias = TxtAlias.Text _serviceGroup = TxtGroup.Text _serviceRoles = TxtRoles.Text _dataServiceDirPath = $"{RootPath}\{DataServiceName}" _updateServiceDirPath = $"{RootPath}\{UpdateServiceName}" _dataServicePacketDirPath = $"{RootPath}\DataServiceDownload" _licenseDirPath = $"{RootPath}\License" _destLicenseFilePath = $"{_licenseDirPath}\{LicenseFileName}" _localDbDirPath = $"{RootPath}\LocalDB" End Sub Private Sub CheckCacheValue() If String.IsNullOrWhiteSpace(RootPath) Then Throw New Exception($"Invalid RootPath:{RootPath}") End If If File.Exists(_srcLicenseFilePath) = False Then Throw New Exception($"Invalid LicenseFilePath:{_srcLicenseFilePath}") End If If String.IsNullOrWhiteSpace(LicenseFileName) Then Throw New Exception($"Invalid LicenseFileName:{LicenseFileName}") End If If String.IsNullOrWhiteSpace(DataServiceName) Then Throw New Exception($"Invalid DataServiceName:{DataServiceName}") End If If String.IsNullOrWhiteSpace(UpdateServiceName) Then Throw New Exception($"Invalid UpdateServiceName:{UpdateServiceName}") End If If String.IsNullOrWhiteSpace(_serviceGroup) Then Throw New Exception($"子网名称不能为空,请重试") End If If String.IsNullOrWhiteSpace(_serviceRoles) Then Throw New Exception($"设备角色不能为空 ,请重试") End If End Sub #Region "发布更新" ''' License检测 Private _license As License ''' 初始化FTP服务类 Private _ftpClient As FtpService ''' 数据服务的文件夹路径,不含版本 Private _dataServiceDirPath As String ''' 更新服务的文件夹路径,不含版本 Private _updateServiceDirPath As String ''' 数据服务升级时存放从FTP下载的最新包文件夹路径 Private _dataServicePacketDirPath As String Private _licenseDirPath As String Private _localDbDirPath As String ''' 服务子网名(组名) Private _serviceGroup As String ''' 服务角色,0为普通,1为服务器 Private _serviceRoles As String ''' Ftp远程升级文件夹路径 Private ReadOnly _ftpUpdateDirPath As String = $"/uts_Manager/AUTS/Service" ''' 同步目录:auts_public Private _sync_auts_public_DirPath As String ''' 同步目录:auts_vendor Private _sync_auts_vendor_DirPath As String ''' ''' 创建运行时必要文件夹 ''' Private Sub CreateSystemFolder() Directory.CreateDirectory(RootPath) '创建UTS根目录 Directory.CreateDirectory(_dataServiceDirPath) '数据服务文件夹路径 Directory.CreateDirectory(_updateServiceDirPath) '更新服务文件夹路径 Directory.CreateDirectory(_dataServicePacketDirPath) '数据服务下载文件夹路径 Directory.CreateDirectory(_licenseDirPath) 'License文件夹 Directory.CreateDirectory(_localDbDirPath) 'DB文件夹 End Sub ''' ''' 创建同步文件夹 ''' Private Function CreateSyncFolder() As Boolean '同步目录 Dim syncRootPath As String = lab_SyncPath.Text If String.IsNullOrEmpty(syncRootPath) = True Then MsgBox("同步目录设置不正确!") Return False End If _sync_auts_public_DirPath = $"{syncRootPath}\uts_Public" _sync_auts_vendor_DirPath = $"{syncRootPath}\uts_{_license.VendorName}" Directory.CreateDirectory(_sync_auts_public_DirPath) 'uts_Public Directory.CreateDirectory(_sync_auts_vendor_DirPath) 'uts_VendorName If System.IO.Directory.Exists(_sync_auts_public_DirPath) = False OrElse System.IO.Directory.Exists(_sync_auts_vendor_DirPath) = False Then MsgBox("同步目录创建不成功!") Return False End If Return True End Function ''' ''' 获取更新服务的最新信息 ''' Private Function GetUpdateServiceInfo(serviceName As String) As UpdatePackageInfo If DbConnector.CanConnectToRemote = False Then '判断网络连接状态 Throw New Exception($"无法连接到数据库!") End If Using db As New DbExecutor(UtsDb.RemoteDbType, UtsDb.RemoteConnString) db.Open() Dim tableName As String = $"{SwUpdateTable.TableName}" Dim colNames As New List(Of String) From { $"{SwUpdateTable.ColNamesEnum.LastVersion}", $"{SwUpdateTable.ColNamesEnum.BinPackageMd5}", $"{SwUpdateTable.ColNamesEnum.PackageName}" } Dim condition As String = $"`{SwUpdateTable.ColNamesEnum.SoftwareName}` = '{serviceName}'" Dim dtServiceInfo As DataTable = db.ExecuteDataTable(db.CmdHelper.DbSearch(UtsDb.RemotePublicDb, colNames, tableName, condition)) If dtServiceInfo.Rows.Count <= 0 Then Throw New Exception($"从数据库获取不到{serviceName}的信息!") End If Dim packetInfo As New UpdatePackageInfo packetInfo.BinPackageMd5 = CStr(dtServiceInfo(0)($"{SwUpdateTable.ColNamesEnum.BinPackageMd5}")) packetInfo.LastVersion = CStr(dtServiceInfo(0)($"{SwUpdateTable.ColNamesEnum.LastVersion}")) packetInfo.PackageName = CStr(dtServiceInfo(0)($"{SwUpdateTable.ColNamesEnum.PackageName}")) db.Close() Return packetInfo End Using End Function Public Function GetUtsHost() As Boolean Dim _udpClient As New UdpClient() Dim _webPacker As New UtsWebPacket UpdateInstallTip(20, $"Start Get Uts Host") '获取webService目标地址 Dim remoteIP As IPEndPoint = Nothing Try If remoteIP Is Nothing Then remoteIP = New IPEndPoint(Dns.GetHostAddresses("www.uts-data.com")(0), 5980) End If Catch ex As Exception UpdateInstallTip(20, $"Send Heartbeat Packet Fail:{ex.Message}") Return False End Try '发送获取主机地址命令 Try Dim packet() As Byte = _webPacker.FillPacket(CByte(UtsWebPacket.Commands.Heartbeat), BitConverter.GetBytes(0)) _udpClient.Send(packet, packet.Length, remoteIP) Catch ex As Exception UpdateInstallTip(20, $"Send Heartbeat Packet Fail:{ex.Message}") Return False End Try '等待回复 Dim timeout As Integer = 5 * 1000 Dim lastTime As Date = Now Dim length As Integer Dim recvBuf() As Byte = Nothing Dim recviceIp As New IPEndPoint(IPAddress.Any, 0) While (Now - lastTime).TotalMilliseconds < timeout length = _udpClient.Available If length > 0 Then recvBuf = _udpClient.Receive(recviceIp) Exit While End If Threading.Thread.Sleep(1000) End While If recvBuf Is Nothing Then UpdateInstallTip(20, $"Get Host Fail!") Return False End If '校验 Try _webPacker.CheckPacket(recvBuf) Catch ex As Exception UpdateInstallTip(20, $"Check Packet Error:{ex.Message}") Return False End Try '处理回复 Dim cmdByte As Byte = recvBuf(UtsWebPacket.PacketBits.Command) '不是回复心跳包 If cmdByte <> 1 Then Return False Dim type As Integer Dim ftpHost As String = "" Dim dbHost As String = "" For i As Integer = UtsWebPacket.PacketBits.Param + 4 To recvBuf.Count - 1 type = recvBuf(i) length = recvBuf(i + 1) If length = 0 Then UpdateInstallTip(20, $"Invalid data length!") Return False End If Select Case type Case 1 'ftp服务器地址 ftpHost = Encoding.UTF8.GetString(recvBuf, i + 2, length) Case 2 'db服务器地址 dbHost = Encoding.UTF8.GetString(recvBuf, i + 2, length) End Select i += length + 1 Next If String.IsNullOrEmpty(ftpHost) Then UpdateInstallTip(20, $"Get FtpHost Fail,Host is null.") Return False Else If String.Compare(UtsRegistry.FtpHost, ftpHost) <> 0 Then UtsRegistry.FtpHost = ftpHost '写入注册表 End If End If If String.IsNullOrEmpty(dbHost) Then UpdateInstallTip(20, $"Get DbHost Fail,Host is null.") Return False Else If String.Compare(UtsRegistry.DbHost, dbHost) <> 0 Then UtsRegistry.DbHost = dbHost '写入注册表 End If End If UpdateInstallTip(20, $"Get Uts Host Success!") Return True End Function ''' ''' 一键更新 ''' Private Sub InstallUpdateService() If GetUtsHost() = False Then Return '根据License信息,获取服务器地址 '校验License UpdateInstallTip(20, "Begin CheckLicense...") _license = New License(_destLicenseFilePath) _license.CheckLicense() UtsDb.InitConnectParams(_license) '根据License信息,初始化数据库连接信息 UpdateInstallTip(25, "CheckLicense Success!") _ftpClient = New FtpService(UtsRegistry.FtpHost, CInt(_license.FtpPort), _license.FtpUser, _license.FtpPwd) '获取远程数据库内容 Dim packetInfo As UpdatePackageInfo = GetUpdateServiceInfo(UpdateServiceName) '检测服务存在 If WinService.ServicesExists(UpdateServiceName) Then 'Dim updateSerVer As String = UtsRegistry.UpdateServiceVersion 'If NeedToUpdateService(updateSerVer, packetInfo.LastVersion) = False Then ' UpdateInstallTip(100, $"UpdateService is latest version:{updateSerVer}!") ' Return 'End If '卸载当前服务 WinService.UnInstallService(UtsRegistry.UpdateServiceFilePath, Nothing) End If Try '注册服务 _serviceRegister = New ServiceRegister() _serviceRegister.LicenseID = _license.ID _serviceRegister.VendorName = _license.VendorName _serviceRegister.ExpirationDate = _license.ExpirationDate _serviceRegister.UsVersion = packetInfo.LastVersion _serviceRegister.TerminalAlias = DataServiceAlias _serviceRegister.Roles = _serviceRoles _serviceRegister.Group = _serviceGroup _serviceRegister.RegisterService() Catch ex As Exception UpdateInstallTip(30, $"Register Service Fail,{ex.Message}") Return End Try UpdateInstallTip(30, "Register Service Success!") '下载 UpdateInstallTip(40, $"Begin Download...") DownloadServicePacket(packetInfo) UpdateInstallTip(100, $"Download Success!") End Sub ''' ''' 下载服务包,完成服务安装 ''' ''' 数据库中该程序包的信息 ''' Private Function DownloadServicePacket(packetInfo As UpdatePackageInfo) As Boolean Dim localFilePath As String = $"{_dataServicePacketDirPath}\{packetInfo.PackageName}" Dim ftpFilePath As String = $"{_ftpUpdateDirPath}\{packetInfo.PackageName}" Dim updateSerDirVer As String = $"{_updateServiceDirPath}\{packetInfo.LastVersion}" '检测本地包是否存在 If Directory.Exists(_dataServicePacketDirPath) = False Then Directory.CreateDirectory(_dataServicePacketDirPath) If Directory.Exists(updateSerDirVer) = False Then Directory.CreateDirectory(updateSerDirVer) '删除本地已有下载包 If File.Exists(localFilePath) Then File.Delete(localFilePath) End If '下载FTP文件 UpdateInstallTip(40, $"Begin Download FtpFile {ftpFilePath} to {localFilePath}...") _ftpClient.FtpDownload(ftpFilePath, localFilePath) UpdateInstallTip(50, $"ftpPath:{ftpFilePath},localPath:{localFilePath},下载文件成功!") Threading.Thread.Sleep(2000) '更新包文件校验 UpdateInstallTip(50, $"开始校验服务包文件......") CheckDataServicePacket(localFilePath, packetInfo) UpdateInstallTip(60, $"校验服务包成功!") Threading.Thread.Sleep(2000) '解压,安装,启动服务 UpdateInstallTip(60, $"开始解压文件{localFilePath}到服务下版本文件夹{updateSerDirVer}......") UTS_Core.Compress.Compress.LoadFromZip(updateSerDirVer, localFilePath) UpdateInstallTip(70, $"解压成功!") Threading.Thread.Sleep(2000) UpdateInstallTip(70, $"Begin InstallService {updateSerDirVer}\{UpdateServiceName}...") WinService.InstallService($"{updateSerDirVer}\{UpdateServiceName}.exe", Nothing) UpdateInstallTip(80, $"InstallService Success!") '更新注册表 UpdateInstallTip(80, $"Begin Update UtsRegistry.") UtsRegistry.RootPath = RootPath UtsRegistry.LicenseFileName = LicenseFileName UtsRegistry.DataServiceName = DataServiceName UtsRegistry.DataServiceAlias = DataServiceAlias UtsRegistry.UpdateServiceName = UpdateServiceName UtsRegistry.UpdateServiceVersion = packetInfo.LastVersion UtsRegistry.Roles = _serviceRoles UtsRegistry.BarnchNet = _serviceGroup UpdateInstallTip(90, $"Update UtsRegistry Success.") '启动服务 UpdateInstallTip(90, $"开始启动服务程序......") WinService.StartService(UpdateServiceName) UpdateInstallTip(95, $"启动服务程序{UpdateServiceName}成功!") Return True End Function ''' ''' 校验数据服务包 ''' ''' ''' Private Sub CheckDataServicePacket(localFilePath As String, packetInfo As UpdatePackageInfo) Dim localMd5 As String = Md5.GetFileMd5(localFilePath) Dim remoteMd5 As String = packetInfo.BinPackageMd5 If String.Compare(localMd5, remoteMd5, True) <> 0 Then Throw New Exception($"Check Packet Fail!localMd5:{localMd5},remoteMd5:{remoteMd5}") End If End Sub ''' ''' 判断本地与云端版本号是否一致,不一致则代表需要更新数据服务 ''' ''' 本地数据服务版本号 ''' 远端数据服务版本号 ''' Private Function NeedToUpdateService(localVer As String, remoteVer As String) As Boolean If String.IsNullOrWhiteSpace(localVer) OrElse String.IsNullOrWhiteSpace(remoteVer) Then Return False If String.Compare(localVer, remoteVer) = 0 Then Return False Return True End Function #End Region ''' ''' 取消关闭窗体 ''' ''' ''' Private Sub BtnCancel_Click(sender As Object, e As EventArgs) Handles BtnCancel.Click DialogResult = DialogResult.No End Sub Private Sub rb_SyncFloder_FollowRootPath_CheckedChanged(sender As Object, e As EventArgs) Handles rb_SyncFloder_FollowRootPath.CheckedChanged If rb_SyncFloder_FollowRootPath.Checked Then lab_SyncPath.Text = TBoRootPath.Text & "\AUTS_Sync" If rb_SyncFloder_Spicfied.Checked Then lab_SyncPath.Text = tb_SyncFolder_BySelected.Text & "\AUTS_Sync" End Sub Private Sub rb_SyncFloder_Spicfied_CheckedChanged(sender As Object, e As EventArgs) Handles rb_SyncFloder_Spicfied.CheckedChanged If rb_SyncFloder_FollowRootPath.Checked Then lab_SyncPath.Text = TBoRootPath.Text & "\AUTS_Sync" If rb_SyncFloder_Spicfied.Checked Then lab_SyncPath.Text = tb_SyncFolder_BySelected.Text & "\AUTS_Sync" End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click tb_SyncFolder_BySelected.Text = SelectSyncFolderString() If rb_SyncFloder_FollowRootPath.Checked Then lab_SyncPath.Text = TBoRootPath.Text & "\AUTS_Sync" If rb_SyncFloder_Spicfied.Checked Then lab_SyncPath.Text = tb_SyncFolder_BySelected.Text & "\AUTS_Sync" End Sub End Class