Imports System.Data.SQLite Imports System.IO Imports System.Text Imports System.Xml Imports FlexCell Imports UTS_Core.Security Imports UTS_Core.Database.Sqlite Imports UTS_Core.UTSModule.DatabaseTable Namespace UTSModule.Project Public Class ProjectStationPacket Sub New(station As StationInfo) CurrentImprint = New StationPacketImprint() HistoryImprints = New List(Of StationPacketImprint)() StationPlan = New ProjectStationPlan(Me) StationVersion = 1 '项目站版本从一开始 ParentStation = station End Sub Private _image As Drawing.Image Private _imageFileName As String Private _fileName As String Private _name As String ''' 测试包文件名称,不含.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 _name = Path.GetFileNameWithoutExtension(_fileName) End Set End Property ''' 测试站包版本 Public Property StationVersion As Integer ''' 修改项目流程时所需密码 Public Property PassWord 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.StationPacketResourceDirPath(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 ProjectStationPlan ''' 测试站包所在的测试站信息 Public Property ParentStation() As StationInfo ''' ''' 创建项目站包 ''' Public Sub CreatePacket() If ParentStation Is Nothing Then Throw New Exception($"项目站包未关联项目站!") If ParentStation.ParentProject Is Nothing Then Throw New Exception($"项目站包未关联项目!") '更新文件名,唯一索引 FileName = NewPacketFileName() StationVersion = 1 '流程从一开始 PassWord = String.Empty ValidDate = Now.AddMonths(1) '有效期一个月 CreateTime = Now ModifiedTime = Now AppVersion = New Version(Windows.Forms.Application.ProductVersion) HistoryImprints = New List(Of StationPacketImprint)() CurrentImprint = New StationPacketImprint() '创建相关文件夹 Directory.CreateDirectory(UtsPath.StationPacketDirPath(Name)) Directory.CreateDirectory(UtsPath.StationPacketResourceDirPath(Name)) Directory.CreateDirectory(UtsPath.StationPacketTestPlanDirPath(Name)) 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" PassWord = 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 = 1 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 LoadGridProperties(nodeList As XmlNodeList, grdTestPlan As Grid) Dim xe As XmlElement For Each node As XmlNode In nodeList xe = CType(node, XmlElement) Select Case xe.LocalName Case "Rows" grdTestPlan.Rows = Integer.Parse(xe.InnerText) + 1 Case "Cols" grdTestPlan.Cols = Integer.Parse(xe.InnerText) + 1 End Select Next Return End Sub ''' ''' 加载项目流程表格单元格内容 ''' ''' ''' Private Sub LoadGridCells(nodeList As XmlNodeList, grdTestPlan As Grid) Dim row, col As Integer Dim xe As XmlElement For Each node As XmlNode In nodeList xe = CType(node, XmlElement) Select Case xe.LocalName Case "Cells" row = CType(xe.GetAttribute($"Row"), Integer) col = CType(xe.GetAttribute($"Col"), Integer) grdTestPlan.Cell(row, col).Text = xe.InnerText End Select Next End Sub ''' ''' 加载项目流程文件 ''' ''' Private Sub LoadStationPlanFile(stationPlanFilePath As String) Dim xd As New XmlDocument() xd.Load(stationPlanFilePath) Dim xe As XmlElement Dim nodeList As XmlNodeList = xd.SelectSingleNode($"FlexCell.NET").ChildNodes For Each node As XmlNode In nodeList xe = CType(node, XmlElement) Select Case xe.LocalName Case "GridProperties" LoadGridProperties(node.ChildNodes, StationPlan.StationPlanGrid) Case "Cells" LoadGridCells(node.ChildNodes, StationPlan.StationPlanGrid) End Select Next End Sub ''' ''' 加载项目站包时,校验路径 ''' ''' Private Sub LoadCheckPath(packetPath As String) If String.IsNullOrEmpty(FileName) Then Throw New Exception($"未搜索到项目站 {ParentStation.Name} 的项目站包包名,请自行设计发布!") End If If File.Exists(packetPath) = False Then Console.WriteLine($"UpdateStationInfo, {packetPath} File Not Exists") Throw New Exception($"未搜索到项目包 {packetPath},请自行设计发布!") 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.StationPacketInfoPath(packetName)}" LoadStationPacketInfoFile(packetInfoPath) '解析项目站信息内容 Dim stationPlanPath As String = $"{UtsPath.StationPacketTestPlanDirPath(packetName)}\Main.xml" LoadStationPlanFile(stationPlanPath) '解析项目站流程内容 End Sub ''' ''' 加载测试站包内容 ''' Public Sub LoadPacket() Dim packetPath As String = UtsPath.StationPacketPath(ParentStation.ParentProject.Index, ParentStation.Index, FileName) LoadCheckPath(packetPath) LoadExtractFile(packetPath) LoadFileUpdatePacketInfo(Name) End Sub ''' ''' 保存项目站流程问文件 ''' ''' ''' Private Sub SaveStationPlanFile(path As String, grdTestPlan As Grid) Dim xws As New XmlWriterSettings With xws .Indent = True .NewLineOnAttributes = False .Encoding = New UTF8Encoding(False) End With Using xw As XmlWriter = XmlWriter.Create(path, xws) xw.WriteStartDocument() xw.WriteStartElement($"FlexCell.NET") '创建跟节点 xw.WriteStartElement($"GridProperties") '创建表属性节点 xw.WriteElementString("Rows", CType(grdTestPlan.Rows - 1, String)) xw.WriteElementString("Cols", CType((grdTestPlan.Cols - 1), String)) xw.WriteEndElement() xw.WriteStartElement($"Cells") '创建单元格节点 For row As Integer = 0 To grdTestPlan.Rows - 1 For col As Integer = 0 To grdTestPlan.Cols - 1 xw.WriteStartElement($"Cells") xw.WriteAttributeString($"Row", CType(row, String)) xw.WriteAttributeString($"Col", CType(col, String)) xw.WriteString(grdTestPlan.Cell(row, col).Text) xw.WriteEndElement() Next Next xw.WriteEndElement() xw.WriteEndElement() xw.WriteEndDocument() End Using 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(PassWord, 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() 'xw.Flush() 'xw.Close() End Using 'Dim xw As XmlWriter = XmlWriter.Create(configPath, xws) 'xw.WriteStartDocument() 'xw.WriteStartElement($"Configs") '创建跟节点 'xw.WriteStartElement($"StationInfo") '创建一级子节点 'SavePacketInfoNode(xw) 'xw.WriteEndElement() 'xw.WriteEndElement() 'xw.WriteEndDocument() 'xw.Flush() 'xw.Close() Return End Sub ''' ''' 发布项目成功时,新增一条项目站站发布记录 ''' 由于本地未下载站发布记录,则将命令添加至缓存待上传表中 ''' ''' Private Sub InsertReleaseLogTable(sqliteComm As SQLiteCommand, packetFileName As String) Dim keyValue As New Dictionary(Of String, String) From { {ReleaseLogTable.ColNamesEnum.机型.ToString(), ParentStation.ParentProject.Index}, {ReleaseLogTable.ColNamesEnum.栈位.ToString(), ParentStation.Index}, {ReleaseLogTable.ColNamesEnum.最新包名.ToString(), packetFileName}, {ReleaseLogTable.ColNamesEnum.更新者.ToString(), ParentStation.UserId}, {ReleaseLogTable.ColNamesEnum.更新时间.ToString(), $"{ModifiedTime:yyyy-MM-dd HH:mm:ss}"} } Dim commandText As String = Executor.CommandHelper.Insert(ReleaseLogTable.TableName(ParentStation.ParentProject.Index), keyValue) 'Executor.ExecuteNonQuery(sqliteComm, commandText)‘本地数据库没有该表,不执行数据表操作 CacheTable.SaveCommandToCacheTable(sqliteComm, CacheTable.TableName, commandText) '记录到本地缓存表 End Sub ''' ''' 发布项目成功时,更新项目站表对应项目站最新项目站包文件名 ''' ''' ''' 项目站包文件名 Private Sub UpdateStationTable(sqliteComm As SQLiteCommand, packetFileName As String) Dim keyValue As New Dictionary(Of String, String) From { {StationTable.ColNamesEnum.测试版本包名.ToString(), packetFileName} } Dim condition As String = $"`{StationTable.ColNamesEnum.Index}` = '{ParentStation.Index}'" Dim commandText As String = Executor.CommandHelper.Update(StationTable.TableName(ParentStation.ParentProject.Index), keyValue, condition) Executor.ExecuteNonQuery(sqliteComm, commandText) CacheTable.SaveCommandToCacheTable(sqliteComm, CacheTable.TableName, commandText) '记录到本地缓存表 End Sub ''' ''' 发布项目时,校验路径合法性 ''' Private Sub ReleaseCheckPath() Dim releaseDirPath As String = UtsPath.StationReleaseDirPath If Directory.Exists(releaseDirPath) = False Then Throw New Exception($"未搜索到项目站包发布文件夹 {releaseDirPath}") End If Dim designDirPath As String = UtsPath.StationDesignDirPath() If Directory.Exists(designDirPath) = False Then Throw New Exception($"未搜索到项目站包文件夹 {designDirPath}") End If Directory.CreateDirectory(UtsPath.StationPacketResourceDirPath(Name)) Directory.CreateDirectory(UtsPath.StationPacketTestPlanDirPath(Name)) End Sub ''' ''' 发布项目时,将原项目包文件夹名重命名为预发布项目包文件夹名 ''' ''' 预发布项目站包名 Private Sub ReleaseRenamePacketDir(revPacketName As String) Dim curPacketDirPath As String = UtsPath.StationPacketDirPath(Name) Dim revPacketDirPath As String = UtsPath.StationPacketDirPath(revPacketName) Directory.Move(curPacketDirPath, revPacketDirPath) End Sub ''' ''' 发布项目时,将缓存信息保存到本地文件中 ''' ''' 预发布项目站包名 Private Sub ReleaseSaveFile(revPacketName As String) Dim revPacketInfoPath As String = $"{UtsPath.StationPacketInfoPath(revPacketName)}" SavePacketInfoFile(revPacketInfoPath) '生成项目站包信息文件 Dim revStationPlanPath As String = $"{UtsPath.StationPacketTestPlanDirPath(revPacketName)}\Main.xml" SaveStationPlanFile(revStationPlanPath, StationPlan.StationPlanGrid) '生成项目站流程文件 End Sub ''' ''' 发布项目时,压缩项目文件夹至发布路径 ''' ''' 预发布项目站包名 ''' 预发布项目站包文件名 Private Sub ReleaseTarFile(revPacketName As String, revFileName As String) Dim tarFileList As New List(Of String) Dim revDirPath As String = UtsPath.StationPacketDirPath(revPacketName) 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(ParentStation.ParentProject.Index, ParentStation.Index, revFileName)}" If File.Exists(revFilePath) Then File.Delete(revFilePath) File.Move(revTarFilePath, revFilePath) '压缩文件成功后,从临时文件夹移动到发布文件夹 End Sub ''' ''' 发布项目成功后,更新数据库数据 ''' ''' Private Sub ReleaseUpdateDatabase(revFileName As String) Dim connectString As String = CommandHelpers.ConnectionString(ConnectionParams.Path, ConnectionParams.Password) Using sqliteConn As New SQLiteConnection(connectString) sqliteConn.Open() Using sqliteComm As SQLiteCommand = sqliteConn.CreateCommand() InsertReleaseLogTable(sqliteComm, revFileName) '更新数据库,项目站发布记录表,新增发布记录 UpdateStationTable(sqliteComm, revFileName) '更新数据库,测试站表,最新包名 End Using sqliteConn.Close() End Using End Sub ''' ''' 发布项目成功后,更新项目包信息 ''' ''' Private Sub ReleaseUpdatePacketInfo(revFileName As String) FileName = revFileName HistoryImprints.Insert(0, CurrentImprint) CurrentImprint = New StationPacketImprint() End Sub Private Function NewPacketName() As String Return $"TP_{ParentStation.ParentProject.Index}_{ParentStation.Index}_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 = ParentStation.UserId CurrentImprint.FileName = revFileName ReleaseRenamePacketDir(revPacketName) ReleaseSaveFile(revPacketName) ReleaseTarFile(revPacketName, revFileName) ReleaseUpdateDatabase(revFileName) ReleaseUpdatePacketInfo(revFileName) GC.Collect()'回收资源 End Sub End Class End Namespace