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