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