Imports System.IO Imports System.Text Imports System.Xml Imports FluentFTP Imports UTS_Core.Database Imports UTS_Core.Security Imports UTS_Core.UTSModule.Station.ProcessStation Imports UTS_Core.UTSModule.Test.StatusMonitor Namespace UTSModule.Station Public Class StationPacket Sub New(processStation As ProcessStation) CurrentImprint = New StationPacketImprint() HistoryImprints = New List(Of StationPacketImprint)() _stationType = processStation.StationType StationPlan = StationPlanManager.CreateStationPlan(_stationType, Me) EditPwd = String.Empty ReleasePwd = String.Empty StationVersion = 0 '项目站版本从一开始 ParentProcessStation = processStation End Sub Private _image As Drawing.Image Private _imageFileName As String Private _fileName As String Private _name As String Private _stationType As StationTypeEnum ''' 测试包文件名称,不含.uts后缀 Public ReadOnly Property Name() As String Get Return _name End Get End Property ''' 测试包文件名称,含.uts后缀 Public Property FileName() As String Get Return _fileName End Get Set(value As String) _fileName = value If String.IsNullOrWhiteSpace(_fileName) Then _name = String.Empty Else _name = Path.GetFileNameWithoutExtension(_fileName) End If End Set End Property ''' ''' 当前站包所属站位类型 ''' ''' Public Property StationType As StationTypeEnum Get Return _stationType End Get Set(value As StationTypeEnum) _stationType = value StationPlan = StationPlanManager.CreateStationPlan(_stationType, Me) End Set End Property ''' 测试站包MD5值 Public Property PacketMD5 As String ''' 测试站包版本 Public Property StationVersion As Integer ''' 修改项目流程时所需密码 Public Property EditPwd As String ''' 发布项目流程时所需密码 Public Property ReleasePwd As String ''' 测试站包有效日期 Public Property ValidDate As Date ''' 测试站包创建时间 Public Property CreateTime As Date ''' 测试站包修改时间 Public Property ModifiedTime As Date ''' 发布测试站包的应用程序版本 Public Property AppVersion() As Version ''' 发布测试站包的图片 Public ReadOnly Property StationImage As Drawing.Image Get Return _image End Get End Property ''' ''' 项目站包历史发布说明 ''' ''' Public Property HistoryImprints() As List(Of StationPacketImprint) ''' ''' 当前版本发布说明 ''' ''' Public Property CurrentImprint() As StationPacketImprint Public Shared Function PacketImprintsToString(imprints As List(Of StationPacketImprint)) As String Dim strReturn As New StringBuilder For Each imprint As StationPacketImprint In imprints strReturn.Append($"{imprint.FileName}{vbNewLine}") strReturn.Append($"{imprint.Creator}{vbNewLine}") strReturn.Append(vbNewLine) strReturn.Append(imprint.ToString()) strReturn.Append(vbNewLine) strReturn.Append(String.Empty.PadRight(40, "-"c)) strReturn.Append(vbNewLine) Next Return strReturn.ToString() '将历史记录转换成文本 End Function Public Property ImageFileName() As String Get Return _imageFileName End Get Set(value As String) _imageFileName = value Try Dim imagePath As String = $"{UtsPath.GetStationPacketResourceDirPath(Name)}\{_imageFileName}" If File.Exists(imagePath) Then _image = ImageProcessor.ImageProcessor.GetBitmapImage(imagePath) Else _image = Nothing End If Catch ex As Exception Console.WriteLine($"ImageName Convert To Image Error:{ex.Message}") End Try End Set End Property ''' 站位流程,不同的站位流程类型不同 Public Property StationPlan() As StationPlan ''' 测试站包所在的测试站信息 Public Property ParentProcessStation() As ProcessStation ''' ''' 创建项目站包 ''' Public Sub CreatePacket() If ParentProcessStation Is Nothing Then Throw New Exception($"项目站包未关联项目站!") If ParentProcessStation.ParentProject Is Nothing Then Throw New Exception($"项目站包未关联项目!") StationVersion = 0 '流程从零开始 EditPwd = "123456" ReleasePwd = "00803" ValidDate = Now.AddMonths(6) '有效期六个月 CreateTime = Now ModifiedTime = Now FileName = NewPacketFileName() '更新文件名,唯一索引 AppVersion = New Version(Windows.Forms.Application.ProductVersion) HistoryImprints = New List(Of StationPacketImprint)() CurrentImprint = New StationPacketImprint() StationPlan = StationPlanManager.CreateStationPlan(_stationType, Me) '新的测试流程 UtsPath.StationPacketDirPath = UtsPath.GetStationPacketDirPath(Name) UtsPath.StationPacketInfoPath = UtsPath.GetStationPacketInfoPath(Name) UtsPath.StationPacketResourceDirPath = UtsPath.GetStationPacketResourceDirPath(Name) UtsPath.StationPacketTestPlanDirPath = UtsPath.GetStationPacketTestPlanDirPath(Name) '创建相关文件夹 Directory.CreateDirectory(UtsPath.StationPacketDirPath) Directory.CreateDirectory(UtsPath.StationPacketResourceDirPath) Directory.CreateDirectory(UtsPath.StationPacketTestPlanDirPath) End Sub Private Function LoadImprintNode(nodeList As XmlNodeList) As List(Of String) Dim imprints As New List(Of String) Dim xe As XmlElement For Each node As XmlNode In nodeList xe = CType(node, XmlElement) Select Case xe.LocalName Case "Imprint" imprints.Add(xe.InnerText) End Select Next Return imprints End Function Private Function LoadImprintsNode(nodeList As XmlNodeList) As List(Of String) Dim imprints As New List(Of String) Dim xe As XmlElement For Each node As XmlNode In nodeList xe = CType(node, XmlElement) Select Case xe.LocalName Case "Imprints" imprints = LoadImprintNode(node.ChildNodes) End Select Next Return imprints End Function Private Function LoadHistoryImprintsNode(nodeList As XmlNodeList) As List(Of StationPacketImprint) Dim packetImprints As New List(Of StationPacketImprint) Dim xe As XmlElement For Each node As XmlNode In nodeList xe = CType(node, XmlElement) Select Case xe.LocalName Case "HistoryImprint" Dim packetImprint As New StationPacketImprint packetImprint.FileName = xe.GetAttribute($"PacketName") packetImprint.Creator = xe.GetAttribute($"Creator") packetImprint.Imprints = LoadImprintsNode(node.ChildNodes) packetImprints.Add(packetImprint) Case Else Console.WriteLine($"LoadHistoryImprintsNode Unknown NodeName:{xe.LocalName}") End Select Next Return packetImprints End Function ''' ''' 加载项目站包信息文件 ''' ''' Private Sub LoadStationPacketInfoFile(packetInfoFilePath As String) Dim xd As New XmlDocument() xd.Load(packetInfoFilePath) Dim nodeList As XmlNodeList = xd.SelectSingleNode("Configs/StationInfo").ChildNodes For Each node As XmlNode In nodeList Dim xe As XmlElement = CType(node, XmlElement) Select Case xe.LocalName Case "AppVersion" If Version.TryParse(xe.InnerText, AppVersion) = False Then '版本转换 Throw New Exception($"AppVersionError!") End If 'If AppVersion.CompareTo(My.Application.Info.Version) > 0 Then '版本比较,应该在加载后校验。 ' Throw New Exception($"AppVersion Is Too Low!") 'End If Case "CreateTime" If Date.TryParse(xe.InnerText, CreateTime) = False Then Throw New Exception($"CreateTimeError!") End If Case "ModifiedTime" If Date.TryParse(xe.InnerText, ModifiedTime) = False Then Throw New Exception($"ModifiedTimeError!") End If Case "PassWord" EditPwd = Aes128.DecryptStr(xe.InnerText, Aes128.ServerAesKey) Case "ReleasePwd" ReleasePwd = Aes128.DecryptStr(xe.InnerText, Aes128.ServerAesKey) Case "ValidDate" If Date.TryParse(Aes128.DecryptStr(xe.InnerText, Aes128.ServerAesKey), ValidDate) = False Then Throw New Exception($"ValidDateError!") End If Case "StationVersion" If IsNumeric(xe.InnerText) = False Then StationVersion = 0 Else StationVersion = CType(xe.InnerText, Integer) End If Case "ImageName" ImageFileName = xe.InnerText Case "HistoryImprints" HistoryImprints = LoadHistoryImprintsNode(xe.ChildNodes) Case Else Console.WriteLine($"LoadStationPacketFile Unknown NodeName:{xe.LocalName}") End Select Next End Sub ''' ''' 加载项目站包时,校验路径 ''' ''' Private Sub LoadCheckPath(packetPath As String) If String.IsNullOrEmpty(FileName) Then Throw New Exception($"未搜索到项目站 {ParentProcessStation.Name} 的项目站包包名,请自行设计发布!") End If If File.Exists(packetPath) = False Then Throw New Exception($"未搜索到项目包 {packetPath},请自行设计发布!") End If End Sub Private Sub LoadCheckMd5(packetPath As String) If String.IsNullOrEmpty(PacketMD5) Then Return If File.Exists(packetPath) = False Then Throw New Exception($"MD5校验失败,未查找到站包文件:{packetPath}") End If Dim srcMd5 As String = UTS_Core.Security.Md5.GetFileMd5(packetPath) If String.Compare(PacketMD5, srcMd5, True) <> 0 Then File.Delete(packetPath) Throw New Exception("MD5校验失败,请重新选择当前站位下载更新包") End If End Sub ''' ''' 加载项目站包时,解压项目文件到指定路径 ''' ''' Private Sub LoadExtractFile(packetPath As String) Dim stationDesignDir As String = UtsPath.StationDesignDirPath() If Directory.Exists(stationDesignDir) = False Then Directory.CreateDirectory(stationDesignDir) Compress.Compress.TarExtractToDirectory(packetPath, stationDesignDir) '解压缩文件到指定路径 End Sub ''' ''' 加载测试站包时,加载项目站包信息 ''' ''' Private Sub LoadFileUpdatePacketInfo(packetName As String) Dim packetInfoPath As String = $"{UtsPath.GetStationPacketInfoPath(packetName)}" LoadStationPacketInfoFile(packetInfoPath) '解析项目站信息内容 Dim stationPlanPath As String = $"{UtsPath.GetStationPacketTestPlanDirPath(packetName)}\Main.xml" StationPlan.LoadFile(stationPlanPath) End Sub ''' ''' 加载测试站包内容 ''' Public Sub LoadPacket() Dim packetPath As String = UtsPath.StationPacketPath(ParentProcessStation.ParentProject.Index, ParentProcessStation.StationID, FileName) '本地不存在压缩包则从FTP上下载 If File.Exists(packetPath) = False Then Dim remotePath As String = UtsPath.RemoteStationPacketPath(ParentProcessStation.ParentProject.Index, ParentProcessStation.StationID, FileName) Dim ftp As UtsFtp = UtsFtp.CreateObject If ftp.FtpFileExists(remotePath) Then ftp.FtpDownload(remotePath, packetPath) End If '加载本地压缩包 LoadCheckPath(packetPath) LoadCheckMd5(packetPath) LoadExtractFile(packetPath) LoadFileUpdatePacketInfo(Name) End Sub ''' ''' 保存项目站历史版本说明 ''' ''' Private Sub SavePacketHistoryImprints(xw As XmlWriter) '写入当前版本信息 xw.WriteStartElement($"HistoryImprint") xw.WriteAttributeString($"PacketName", CurrentImprint.FileName) xw.WriteAttributeString($"Creator", CurrentImprint.Creator) xw.WriteStartElement($"Imprints") For Each imprint As String In CurrentImprint.Imprints xw.WriteElementString("Imprint", imprint) Next xw.WriteEndElement() xw.WriteEndElement() '写入历史版本信息 For Each packetImprint As StationPacketImprint In HistoryImprints xw.WriteStartElement($"HistoryImprint") xw.WriteAttributeString($"PacketName", packetImprint.FileName) xw.WriteAttributeString($"Creator", packetImprint.Creator) xw.WriteStartElement($"Imprints") For Each imprint As String In packetImprint.Imprints xw.WriteElementString("Imprint", imprint) Next xw.WriteEndElement() xw.WriteEndElement() Next End Sub ''' ''' 保存项目站信息节点内容 ''' ''' Private Sub SavePacketInfoNode(xw As XmlWriter) xw.WriteElementString("AppVersion", AppVersion.ToString) xw.WriteElementString("CreateTime", $"{CreateTime:yyyy-MM-dd HH:mm:ss}") xw.WriteElementString("ModifiedTime", $"{ModifiedTime:yyyy-MM-dd HH:mm:ss}") xw.WriteElementString("PassWord", Aes128.EncryptStr(EditPwd, Aes128.ServerAesKey)) xw.WriteElementString("ReleasePwd", Aes128.EncryptStr(ReleasePwd, Aes128.ServerAesKey)) xw.WriteElementString("ValidDate", Aes128.EncryptStr(ValidDate.ToString("yyyy-MM-dd"), Aes128.ServerAesKey)) xw.WriteElementString("StationVersion", StationVersion.ToString()) xw.WriteElementString("ImageName", ImageFileName) xw.WriteStartElement($"HistoryImprints") SavePacketHistoryImprints(xw) xw.WriteEndElement() End Sub ''' ''' 保存项目站包信息文件 ''' ''' Private Sub SavePacketInfoFile(configPath As String) Dim xws As New XmlWriterSettings With xws .Indent = True .NewLineOnAttributes = False .Encoding = New UTF8Encoding(False) End With Using xw As XmlWriter = XmlWriter.Create(configPath, xws) xw.WriteStartDocument() xw.WriteStartElement($"Configs") '创建跟节点 xw.WriteStartElement($"StationInfo") '创建一级子节点 SavePacketInfoNode(xw) xw.WriteEndElement() xw.WriteEndElement() xw.WriteEndDocument() End Using Return End Sub ''' ''' 发布项目时,校验路径合法性 ''' Private Sub ReleaseCheckPath() Directory.CreateDirectory(UtsPath.StationReleaseDirPath) Directory.CreateDirectory(UtsPath.StationProjectReleaseDirPath(ParentProcessStation.ParentProject.Index)) Directory.CreateDirectory(UtsPath.StationPacketReleaseDirPath(ParentProcessStation.ParentProject.Index, ParentProcessStation.StationID)) Dim designDirPath As String = UtsPath.StationDesignDirPath() If Directory.Exists(designDirPath) = False Then Throw New Exception($"未搜索到项目站包文件夹 {designDirPath}") End If Directory.CreateDirectory(UtsPath.GetStationPacketResourceDirPath(Name)) Directory.CreateDirectory(UtsPath.GetStationPacketTestPlanDirPath(Name)) End Sub ''' ''' 发布项目时,将原项目包文件夹名重命名为预发布项目包文件夹名 ''' ''' 预发布项目站包名 Private Sub ReleaseRenamePacketDir(revPacketName As String) Dim revPacketDirPath As String = UtsPath.GetStationPacketDirPath(revPacketName) If String.IsNullOrWhiteSpace(Name) Then If Directory.Exists(revPacketDirPath) = False Then Directory.CreateDirectory(revPacketDirPath) Directory.CreateDirectory(UtsPath.GetStationPacketResourceDirPath(revPacketName)) Directory.CreateDirectory(UtsPath.GetStationPacketTestPlanDirPath(revPacketName)) End If Else Dim curPacketDirPath As String = UtsPath.StationPacketDirPath Directory.Move(curPacketDirPath, revPacketDirPath) End If End Sub ''' ''' 发布项目时,将缓存信息保存到本地文件中 ''' ''' 预发布项目站包名 Private Sub ReleaseSaveFile(revPacketName As String) Dim revPacketInfoPath As String = $"{UtsPath.GetStationPacketInfoPath(revPacketName)}" SavePacketInfoFile(revPacketInfoPath) '生成项目站包信息文件 Dim revStationPlanPath As String = $"{UtsPath.GetStationPacketTestPlanDirPath(revPacketName)}\Main.xml" StationPlan.SaveFile(revStationPlanPath) StationEditStatusMonitor.StationEditStatus = StationEditStatusMonitor.StationEditStatusEnum.Saved End Sub ''' ''' 发布项目时,压缩项目文件夹至发布路径 ''' ''' 预发布项目站包名 ''' 预发布项目站包文件名 Private Sub ReleaseTarFile(revPacketName As String, revFileName As String) Dim tarFileList As New List(Of String) Dim revDirPath As String = UtsPath.StationPacketDirPath Compress.Compress.FillFileList(tarFileList, revDirPath, revPacketName) '获取压缩文件列表 Dim revTarFilePath As String = $"{UtsPath.StationDesignDirPath}\{revFileName}" Compress.Compress.TarFiles(tarFileList, revTarFilePath, UtsPath.StationDesignDirPath) '压缩到临时文件夹 Dim revFilePath As String = $"{UtsPath.StationPacketPath(ParentProcessStation.ParentProject.Index, ParentProcessStation.StationID, revFileName)}" If File.Exists(revFilePath) Then File.Delete(revFilePath) File.Move(revTarFilePath, revFilePath) '压缩文件成功后,从临时文件夹移动到发布文件夹 Dim ftpPath As String = $"{UtsPath.RemoteStationPacketPath(ParentProcessStation.ParentProject.Index, ParentProcessStation.StationID, revFileName)}" UtsFtp.CreateObject.FtpUpload(ftpPath, revFilePath) End Sub ''' ''' 发布项目成功后,更新数据库数据 ''' ''' Private Sub ReleaseUpdateDatabase(revFileName As String) '获取站包Md5值 Dim revFilePath As String = $"{UtsPath.StationPacketPath(ParentProcessStation.ParentProject.Index, ParentProcessStation.StationID, revFileName)}" Dim md5 As String = UTS_Core.Security.Md5.GetFileMd5(revFilePath) ReleaseUpdatePacketLogTable(revFileName, md5) '更新发布历史 ReleaseUpdateStationTable(revFileName, md5) '更新站位表 PacketMD5 = md5 End Sub ''' ''' 发布站包时,更新站位表信息 ''' ''' ''' Private Sub ReleaseUpdateStationTable(revFileName As String, md5 As String) Dim saved As Boolean = False '更新最新包名,编辑密码与发布密码 Dim tableName As String = DbTableModel.Customer.StationListTable.TableName Dim colNames As New Dictionary(Of String, String) colNames.Add(DbTableModel.Customer.StationListTable.ColNames.PacketName.ToString(), revFileName) colNames.Add(DbTableModel.Customer.StationListTable.ColNames.PacketMd5.ToString(), md5) colNames.Add(DbTableModel.Customer.StationListTable.ColNames.EditPwd.ToString(), EditPwd) colNames.Add(DbTableModel.Customer.StationListTable.ColNames.ReleasePwd.ToString(), ReleasePwd) Dim condition As String = $"{DbTableModel.Customer.StationListTable.ColNames.ID} = {ParentProcessStation.StationID}" '保存至云端 Dim remoteCmd As String Using db As New DbExecutor(UtsDb.RemoteDbType, UtsDb.RemoteConnString) remoteCmd = db.CmdHelper.DbUpdate(UtsDb.RemotePrivateDb, tableName, colNames, condition) Try db.Open() db.ExecuteNonQuery(remoteCmd) db.Close() saved = True Catch ex As Exception Console.WriteLine($"Release Packet To Update Station Table Fail,{ex.Message}") saved = False End Try End Using '保存至本地库 Using db As New DbExecutor(UtsDb.LocalDbType, UtsDb.LocalConnString) '存至本地 db.Open() Dim localCmd As String = db.CmdHelper.Update(tableName, colNames, condition) db.ExecuteNonQuery(localCmd) '更新缓存日志表 If saved = False Then DbConnect.DbConnector.SaveCmdStringToCacheTable(db, remoteCmd) End If db.Close() End Using End Sub ''' ''' 发布站包时,更新站包发布记录表信息 ''' ''' ''' Private Sub ReleaseUpdatePacketLogTable(revFileName As String, md5 As String) Dim saved As Boolean = False Dim tableName As String = DbTableModel.Customer.StationPacketReleaseLogTable.TableName Dim colNames As New Dictionary(Of String, String) colNames.Add(DbTableModel.Customer.StationPacketReleaseLogTable.ColNames.ProjectID.ToString(), ParentProcessStation.ParentProject.Index.ToString) colNames.Add(DbTableModel.Customer.StationPacketReleaseLogTable.ColNames.StationID.ToString(), ParentProcessStation.StationID.ToString) colNames.Add(DbTableModel.Customer.StationPacketReleaseLogTable.ColNames.CreateTime.ToString(), DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss")) colNames.Add(DbTableModel.Customer.StationPacketReleaseLogTable.ColNames.UpdateTime.ToString(), DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss")) colNames.Add(DbTableModel.Customer.StationPacketReleaseLogTable.ColNames.PacketName.ToString(), revFileName) colNames.Add(DbTableModel.Customer.StationPacketReleaseLogTable.ColNames.PacketMd5.ToString(), md5) colNames.Add(DbTableModel.Customer.StationPacketReleaseLogTable.ColNames.Description.ToString(), CurrentImprint.ToString()) colNames.Add(DbTableModel.Customer.StationPacketReleaseLogTable.ColNames.Remark.ToString(), "") colNames.Add(DbTableModel.Customer.StationPacketReleaseLogTable.ColNames.IsValid.ToString(), "1") colNames.Add(DbTableModel.Customer.StationPacketReleaseLogTable.ColNames.UserID.ToString(), ParentProcessStation.ParentProject.UserId.ToString()) colNames.Add(DbTableModel.Customer.StationPacketReleaseLogTable.ColNames.UserName.ToString(), ParentProcessStation.ParentProject.UserName.ToString()) colNames.Add(DbTableModel.Customer.StationPacketReleaseLogTable.ColNames.PublicIP.ToString(), "") 'todo:填充信息 colNames.Add(DbTableModel.Customer.StationPacketReleaseLogTable.ColNames.ComputerName.ToString(), "") colNames.Add(DbTableModel.Customer.StationPacketReleaseLogTable.ColNames.SID.ToString(), "") '保存至云端 Dim remoteCmd As String Using db As New DbExecutor(UtsDb.RemoteDbType, UtsDb.RemoteConnString) remoteCmd = db.CmdHelper.DbInsert(UtsDb.RemotePrivateDb, tableName, colNames) Try db.Open() db.ExecuteNonQuery(remoteCmd) db.Close() saved = True Catch ex As Exception Console.WriteLine($"Release Packet To Update Packet Log Table Fail,{ex.Message}") saved = False End Try End Using '保存至本地库 Using db As New DbExecutor(UtsDb.LocalDbType, UtsDb.LocalConnString) '存至本地 db.Open() Dim localCmd As String = db.CmdHelper.Insert(tableName, colNames) db.ExecuteNonQuery(localCmd) '更新缓存日志表 If saved = False Then DbConnect.DbConnector.SaveCmdStringToCacheTable(db, remoteCmd) End If db.Close() End Using End Sub ''' ''' 发布项目成功后,更新项目包信息 ''' Private Sub ReleaseUpdatePacketInfo() HistoryImprints.Insert(0, CurrentImprint) CurrentImprint = New StationPacketImprint() End Sub Private Function NewPacketName() As String Return $"TP_{ParentProcessStation.ParentProject.Index}_{ParentProcessStation.StationID}_REV_{StationVersion.ToString.PadLeft(2, "0"c)}_{ModifiedTime:yyyyMMddHHmmss}" End Function Private Function NewPacketFileName() As String Return $"{NewPacketName()}.uts" End Function ''' ''' 发布项目站包 ''' Public Sub ReleasePacket() ReleaseCheckPath() '新建文件夹 Dim revPacketName As String = NewPacketName() Dim revFileName As String = $"{revPacketName}.uts" CurrentImprint.Creator = ParentProcessStation.UserId.ToString() CurrentImprint.FileName = revFileName ReleaseRenamePacketDir(revPacketName) FileName = revFileName '更新包名,以及路径信息 UtsPath.StationPacketDirPath = UtsPath.GetStationPacketDirPath(Name) UtsPath.StationPacketInfoPath = UtsPath.GetStationPacketInfoPath(Name) UtsPath.StationPacketResourceDirPath = UtsPath.GetStationPacketResourceDirPath(Name) UtsPath.StationPacketTestPlanDirPath = UtsPath.GetStationPacketTestPlanDirPath(Name) ReleaseSaveFile(revPacketName) '保存 ReleaseTarFile(revPacketName, revFileName) ReleaseUpdateDatabase(revFileName) ReleaseUpdatePacketInfo() GC.Collect() '回收资源 End Sub End Class End Namespace