Files
Desktop_BLVStudio_EN/BLV_Studio/FrmMain.vb
2025-12-11 14:22:51 +08:00

4918 lines
204 KiB
VB.net
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
Imports System.IO
Imports System.Net
Imports System.Security.Cryptography
Imports System.Text
Imports System.Threading
Imports BLV_Studio.GridModel
Imports BLV_Studio.GridModel.DeviceEventModel
Imports BLV_Studio.UTSModule
Imports Newtonsoft.Json
Public Class FrmMain
''' <summary>
''' 配置信息这些信息将会被编译到配置文件的0x01数据块
''' </summary>
Dim _ConfigInfo As ConfigInfoStuct
''' <summary>
''' 项目信息
''' </summary>
Public _project As ProjectInfo
''' <summary>
''' 模型表格
''' </summary>
Private _grdModel As GridModel.DeviceEventModel
''' <summary>
''' 账号
''' </summary>
Public Property Account As String
''' <summary>
''' 账号
''' </summary>
Public Property Pawss As String
''' <summary>
''' 账号权限
''' </summary>
Public Property AccountAuth As AccountAuth
''' <summary>
''' 基类信息
''' </summary>
Private _basicClass As DeviceObjectClasses
''' <summary>
''' 条件信息
''' </summary>
Private _condictions As ConfigActionConcitons
''' <summary>
''' 当前编辑的酒店房型 node index等同于在 _project.RoomType list列表中的位置
''' </summary>
Private g_CurrentTreeNodeRoomTypeItemIndex As Integer = 0
''' <summary>
''' 根据酒店组+酒店ID+酒店名称 确定XML文件存放目录
''' </summary>
Public g_Xml_FullPath_BasedOnTempFolder As String
''' <summary>
''' 主文件夹路径
''' </summary>
Public g_DataDir_Path As String = Application.StartupPath.Substring(0, Application.StartupPath.IndexOf("\")) & "\BLV_Studio"
''' <summary>
''' 模型文件夹名称
''' </summary>
Public g_ModelDir_Path As String = "\Data\Model\"
''' <summary>
''' 模型文件夹名称
''' </summary>
Public g_ModelDirEN_Path As String = "\Data\Model_EN\"
''' <summary>
''' 配置文件夹名称
''' </summary>
Public g_ConfigDir_Path As String = "\Data\Config\"
''' <summary>
''' 固件文件夹名称
''' </summary>
Public g_Firmware_Path As String = "\Data\Firmware\"
''' <summary>
''' XML 临时文件文件名
''' </summary>
Public g_Xml_FullName As String '当前编辑中的文件名含完整路径
Public g_Xml_Name As String '当前编辑中的文件名,不含路径
Public g_Xml_FilePath As String '当前编辑中的文件路径
Public g_Last_Edit_Xml_FileName As String '上次关闭程序前编辑的文件名,下次打开程序后恢复该文件
'Public DbConnString As String = "Data Source=blv-oa.com;Initial Catalog=BLV_RCU_DB;User ID=sa;Password=9S844fK3;Integrated Security=false"
'Public DbConnString As String = "Server=122.152.232.170;Database=blv_rcu_db;Uid=uts_manager;Pwd=WoUts*#082k;charset=utf8;"
Public DbConnString As String = "Server=blv-cloud-db.mysql.rds.aliyuncs.com;Port=3307;Database=blv_rcu_db;Uid=blv_rcu;Pwd=fnadiaJDIJ7546;charset=utf8;"
Public DbConnString2 As String = "Server=blv-cloud-db.mysql.rds.aliyuncs.com;Port=3307;Database=engineering_db;Uid=blv_rcu;Pwd=fnadiaJDIJ7546;charset=utf8;"
'项目视图 true = 显示’
Public g_IsProjectTreeView_Visible = False
Private _blvSync As blvFtpServer
Private _isHidDisableItem As Boolean = True '禁用项是否显示 T= 显示 F=隐藏
Public Enum EnumTreeLevel
HotelName = 0
RoomType
RCU
Device
End Enum
Public Delegate Sub setFtpIcon_lab(ftpFlag As Integer)
Public Sub SetFtpIcon_labImage(ftpFlag As Integer)
If InvokeRequired Then
Dim dev As New setFtpIcon_lab(AddressOf SetFtpIcon_labImage)
Try
Me.Invoke(dev, ftpFlag)
Catch ex As Exception
Return
End Try
Else
If ImgLstMain.Images.Count = 0 Then Return
Dim imgindex As Integer = -1
Select Case ftpFlag
Case 0
imgindex = ImgLstMain.Images.IndexOfKey(Syncing.png)
If imgindex = -1 Then Return
FtpIcon_lab.Image = ImgLstMain.Images.Item(imgindex)
Case 1
imgindex = ImgLstMain.Images.IndexOfKey(Syncerror.png)
If imgindex = -1 Then Return
FtpIcon_lab.Image = ImgLstMain.Images.Item(imgindex)
Case 2
imgindex = ImgLstMain.Images.IndexOfKey(SyncTrue.png)
If imgindex = -1 Then Return
FtpIcon_lab.Image = ImgLstMain.Images.Item(imgindex)
End Select
End If
End Sub
Public ricLabelGrb_li As New List(Of Control)
Private Sub FrmMain_Load(sender As Object, e As EventArgs) Handles Me.Load
Me.Text = ""
'未处理的异常捕捉
AddHandler AppDomain.CurrentDomain.UnhandledException, Sub(s As Object, arg As UnhandledExceptionEventArgs)
Dim ex As Exception = CType(arg.ExceptionObject, Exception)
AppLog.WriteFatalLog($"{Application.ProductName} {Application.ProductVersion}未处理异常,{ex}")
MsgBox($"{Application.ProductName} {Application.ProductVersion}未处理异常,{ex}")
End Sub
'AddHandler Application.ThreadException, Sub(s As Object, arg As System.Threading.ThreadExceptionEventArgs)
' AppLog.WriteFatalLog($"{Application.ProductName} {Application.ProductVersion}线程异常,{arg.Exception}")
' MsgBox($"{Application.ProductName} {Application.ProductVersion}线程异常,{arg.Exception}")
' End Sub
_blvSync = New blvFtpServer(g_DataDir_Path & g_ModelDir_Path, DbConnString)
_blvSync._SyncLoadDirENPath = g_DataDir_Path & g_ModelDirEN_Path
_blvSync._SyncFTPDirENPath = g_ModelDirEN_Path
AddStationDesignFormToTabControl("FrmCSeriesConfig", "FrmCSeriesConfig")
tab_Pojermanag.Parent = Nothing
tab_Actions.Parent = Nothing
TabPage2.Parent = Nothing
TabPage3.Parent = Nothing
TabPage4.Parent = Nothing
'读取项目信息
'FtpIcon_lab.Image = Image.FromFile(Application.StartupPath & “\Images\Syncing.png”)
'FtpIcon_lab.Image = Image.FromFile(Application.StartupPath & “\Images\Syncerror.png”)
'权限判断用户
ricLabelGrb_li.Add(Addlabel_btn)
ricLabelGrb_li.Add(dellabel_btn)
_project = New ProjectInfo
'发布先锁,当选择酒店是再根据酒店权限开放
tsb_ReleaseToProjcet.Enabled = False
Dim tmpResult As Boolean = LoadSettings()
If tmpResult = False Then
MsgBox("开始工作前请选择酒店项目!")
End If
'检测酒店发布权限,并载入酒店节点
CheckHotelCodePublishedPer()
'初始化模型表格
_grdModel = New GridModel.DeviceEventModel(CompileSchedule)
If _grdModel.Grid Is Nothing Then _grdModel.Grid = GrdEvent
If _grdModel.BasicClasses Is Nothing Then _grdModel.BasicClasses = _basicClass
AddHandler _grdModel.TipChanged, AddressOf EventGridTipChanged
AddHandler _grdModel.OutputPrint, AddressOf GridModelOutputPrint
'初始化treeview控件
If _grdModel.TV Is Nothing Then _grdModel.TV = tv_ResourceTree
'初始化Errlist grid控件
If _grdModel.GridErrList Is Nothing Then _grdModel.GridErrList = Grid_ErrList
_grdModel.InitGridErrList()
UpdateHotelAndRoomtypeLab_text()
'生成文件夹
'CreateXmlPath()
'同步文件
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf _blvSync.FtpfileMain))
AddHandler _blvSync.updateIcon, Sub(ftpFlag As Integer)
Dim serlab As New setFtpIcon_lab(AddressOf SetFtpIcon_labImage)
serlab(ftpFlag)
End Sub
'恢复上次编辑的文件
g_Xml_FullName = g_Last_Edit_Xml_FileName
If Not String.IsNullOrEmpty(g_Xml_FullName) Then
If FileExist(g_Xml_FullName) Then
If _grdModel.Load(g_Xml_FullName) = True Then
'加载基类
Dim tmpBasicClassFilename As String = _grdModel.BasicClassFilename
If LoadBasicClass(tmpBasicClassFilename) = False Then Return
'加载条件
Dim tmpCondictionFilename As String = _grdModel.ConditionFileName
If LoadCondiction(tmpCondictionFilename) = False Then Return
_grdModel.BasicClasses = _basicClass
_grdModel.Condictions = _condictions
Else
g_Xml_FullName = ""
End If
Else
g_Xml_FullName = ""
End If
Else
g_Xml_FullName = ""
End If
UpdateWindowTitle()
tsb_DefaultView.PerformClick()
tsb_UpdateAllResourceList.PerformClick()
Dim tmpErrCnt As Integer
Dim tmpWarningCnt As Integer
_grdModel.StartGobleRuleCheck(tmpErrCnt, tmpWarningCnt)
PojerFrominit()
End Sub
''' <summary>
''' 添加项目设计窗体到分页控件中
''' </summary>
Public CSeriesConfigobj As Object
Private Sub AddStationDesignFormToTabControl(pageName As String, pageText As String)
If TabControl3.TabPages.ContainsKey(pageName) Then Return
If ConnLoginDataSourse() = False Then
MsgBox("Msql连接失败")
Me.Close()
End If
InitmultiLanguage()
ComboBox1_SelectedIndexChanged()
Dim page As New TabPage With {.Name = pageText, .Text = "Logic Delivery"}
Dim frm As New FrmCSeriesConfig(_blvSync)
CSeriesConfigobj = frm
OK_Click(Account, Pawss)
AddHandler Me.Closing, AddressOf frm.FrmCSeriesConfig_Closing
frm.ShowForm(page)
TabControl3.TabPages.Add(page)
End Sub
''' <summary>
''' 点击登录
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
Private Sub OK_Click(username As String password As String)
'MsgBox("0")
DealHotelListInterfaceInfo()
'DealHostListInterfaceInfo()
'DealSetHostMACInterfaceInfo()
'MsgBox("1")
Static time As Date = Now
While True
If DealLoginInfo(username password) = False Then
Return
Else
Exit While
End If
If (Now - time).TotalMilliseconds > 2000 Then
MsgBox($"{LanguageData.StringList(MultiLanguageDAL.StringEnum.LoginTimeout)}")
Return
End If
Threading.Thread.Sleep(100)
End While
'MsgBox("2")
Try
_userNames = username
'If AccountLogin() = False Then '从云端获取用户信息
' Exit Sub
'End If
'DialogResult = DialogResult.OK
'FrmCSeriesConfig.Show()
'Me.Close() '登录完成关闭登录页面
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.OkOnly, $"{LanguageData.StringList(MultiLanguageDAL.StringEnum.LoginFailed)}") ''登录失败
End Try
'MsgBox("3")
'_isLogging = False
End Sub
Public _countIndex As Integer = 0
''' <summary>
''' 处理登录信息
''' </summary>
Private Function DealLoginInfo(username As String password As String) As Boolean
Dim user As String = username
Dim pwd As String = password
user = user.Trim()
pwd = pwd.Trim()
' MsgBox("1.1")
Dim jsonString As String = String.Empty
Try
jsonString = PostData("http://auth.blv-oa.com/OTApi/Login", $"Uid={user}&Pwd={pwd}&appid=1")
'jsonString = PostData("http://47.119.147.104:90/OTApi/Login", $"Uid={user}&Pwd={pwd}&appid=1")
' MsgBox("1.2")
Catch ex As Exception
MsgBox($"{ex.Message}!请联系管理员")
' MsgBox("1.3")
End Try
Console.WriteLine(jsonString)
If jsonString = Nothing Then
Return False
End If
'MsgBox("1.4")
Dim login As LoginBLL = JsonConvert.DeserializeObject(Of LoginBLL)(jsonString)
If login Is Nothing Then
MsgBox($"{LanguageData.StringList(MultiLanguageDAL.StringEnum.LoginFailed)}{LanguageData.StringList(MultiLanguageDAL.StringEnum.NoLoginInformationIsDisplayed)}")
Return False
End If
'MsgBox("1.5")
Console.WriteLine($"解析登录数据:{login.Status} {login.Message}")
If login.Status <> 200 Then
MsgBox($"登陆错误:{login.Status}-" & login.Message)
Return False
End If
' MsgBox("1.6")
'取数据
Dim index As Integer = 0
_loginData.Clear()
_countIndex = 0
'MsgBox("1.7")
For i = 0 To login.Data.HotelData.Count - 1
'组ID, 组名
For j = 0 To login.Data.HotelData.Item(i).Hotels.Count - 1
'酒店ID, 酒店编码, 酒店名称
For k = 0 To login.Data.HotelData.Item(i).Hotels.Item(j).Auth.Count - 1
'权限状态权限ID, 权限名称
index += 1
Dim data As New LoginReturnDataBLL
data.HotelGroupsId = login.Data.HotelData.Item(i).HotelGroupsId
data.HotelGroupsName = login.Data.HotelData.Item(i).HotelGroupsName
data.HotelId = login.Data.HotelData.Item(i).Hotels.Item(j).HotelId
data.Code = login.Data.HotelData.Item(i).Hotels.Item(j).Code
data.HotelName = login.Data.HotelData.Item(i).Hotels.Item(j).HotelName
data.AuthotypeId = login.Data.HotelData.Item(i).Hotels.Item(j).Auth(k).AuthotypeId
data.AuthorityId = login.Data.HotelData.Item(i).Hotels.Item(j).Auth(k).AuthorityId
data.AuthorityName = login.Data.HotelData.Item(i).Hotels.Item(j).Auth(k).AuthorityName
_countIndex += 1
Dim key As String = $"{login.Data.HotelData.Item(i).Hotels.Item(j).HotelName}{login.Data.HotelData.Item(i).Hotels.Item(j).Code}-{_countIndex}"
_loginData.Add(key, data)
Next
Next
' MsgBox("1.8")
Next
'MsgBox("1.9")
Return True
End Function
''' <summary>
''' 下拉选择语言
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
Private Sub ComboBox1_SelectedIndexChanged()
Dim SName As String = "English"
Dim path As String = $"{SName}.xml"
If String.IsNullOrEmpty(SName) Then Return
If IO.File.Exists(path) Then
LanguageData = MultiLanguageDAL.DeserializeFormXml(Of MultiLanguageDAL)(path)
If LanguageData.Version <> dicNC(SName) Then
LanguageData.Version = dicNC(SName)
LanguageData.InitializeByDataTable(GetCloudDataInfo(SName))
MultiLanguageDAL.SerializeToXml(Of MultiLanguageDAL)($"{SName}.xml", LanguageData)
End If
Else
LanguageData = New MultiLanguageDAL
LanguageData.Name = SName
LanguageData.Version = dicNC(SName)
LanguageData.InitializeByDataTable(GetCloudDataInfo(SName))
MultiLanguageDAL.SerializeToXml(Of MultiLanguageDAL)($"{SName}.xml", LanguageData)
End If
'设置到控件上
'InitMultiLanguageInfo()
End Sub
''' <summary>
''' 获取云端数据
''' </summary>
''' <returns></returns>
Private Function GetCloudDataInfo(languageName As String) As DataTable
Dim dtData As DataTable = _SqlLogin.GetCloudDataInfo(languageName)
Return dtData
End Function
''' <summary>
''' 获取云端数据版本
''' </summary>
''' <returns></returns>
Private Function GetCloudVersionInfo() As DataTable
Dim dtVer As DataTable = _SqlLogin.GetCloudVersionInfo()
Return dtVer
End Function
''' <summary> 语言名称和版本信息 </summary>
Public dicNC As New Dictionary(Of String, Integer)
''' <summary>
''' 初始化多语种
''' </summary>
Private Sub InitmultiLanguage()
Dim lag As DataTable = GetCloudVersionInfo()
For index = 0 To lag.Rows.Count - 1
dicNC.Add(lag(index)(0), lag(index)(1))
Next
'ComboBox1.Items.AddRange(dicNC.Keys.ToArray)
'If ComboBox1.Items.Count > 0 Then ComboBox1.SelectedIndex = 0
End Sub
''' <summary>
''' 刷新编辑表
''' </summary>
Public Sub UpdateEditTable(filePath As String)
g_Xml_FullName = filePath
If Not String.IsNullOrEmpty(g_Xml_FullName) Then
If FileExist(g_Xml_FullName) Then
'加载节点数据
If _grdModel.Load(g_Xml_FullName) = True Then
'加载基类
Dim tmpBasicClassFilename As String = _grdModel.BasicClassFilename
If LoadBasicClass(tmpBasicClassFilename) = False Then Return
'加载条件
Dim tmpCondictionFilename As String = _grdModel.ConditionFileName
If LoadCondiction(tmpCondictionFilename) = False Then Return
_grdModel.BasicClasses = _basicClass
_grdModel.Condictions = _condictions
Else
g_Xml_FullName = ""
End If
Else
g_Xml_FullName = ""
End If
Else
g_Xml_FullName = ""
End If
UpdateWindowTitle()
If _grdModel Is Nothing Then Return
_grdModel.SetDefaultView()
_grdModel.UpdateAllResourceList()
_grdModel.ExpandTreeView()
End Sub
Public Sub UpdateBLVEditTable(filePath As String)
g_Xml_FullName = filePath
If IsNothing(_TableInteraction) Then
_TableInteraction = New TableInteraction(CompileSchedule)
If _TableInteraction.Grid Is Nothing Then _TableInteraction.Grid = Table_action
End If
If Not String.IsNullOrEmpty(g_Xml_FullName) Then
If FileExist(g_Xml_FullName) Then
'加载节点数据
If _TableInteraction.LoadFile(g_Xml_FullName) = True Then
'加载基类
Dim tmpBasicClassFilename As String = _TableInteraction.BasicClassFilename
If LoadBasicClass(tmpBasicClassFilename) = False Then Return
'加载条件
Dim tmpCondictionFilename As String = _TableInteraction.ConditionFileName
If LoadCondiction(tmpCondictionFilename) = False Then Return
_TableInteraction.ConfigInfo = _ConfigInfo
_TableInteraction.BasicClasses = _basicClass
_TableInteraction.Condictions = _condictions
Else
g_Xml_FullName = ""
End If
Else
g_Xml_FullName = ""
End If
Else
g_Xml_FullName = ""
End If
UpdateWindowTitle()
'If _grdModel Is Nothing Then Return
'_grdModel.SetDefaultView()
'_grdModel.UpdateAllResourceList()
'_grdModel.ExpandTreeView()
End Sub
Private Sub TsmiChangeUser_Click(sender As Object, e As EventArgs) Handles TsmiChangeUser.Click
Dim frm As New BFrmLogin
frm.Show()
Me.Close()
End Sub
Private Sub TsmiQuit_Click(sender As Object, e As EventArgs) Handles TsmiQuit.Click
Me.Close()
End Sub
'Private Sub TsBtnReadModel_Click(sender As Object, e As EventArgs) Handles TsBtnLoadModel.Click
' If TvwMain.SelectedNode Is Nothing Then Return
' If TvwMain.SelectedNode.Level <> 1 Then Return
' Dim path As String
' Using dlg As New OpenFileDialog
' dlg.Filter = "模型信息(*.xml)|*.xml"
' If dlg.ShowDialog <> DialogResult.OK Then Return
' path = dlg.FileName
' End Using
' Try
' Dim model As DeviceModel = LoadModelFromXml(path)
' model.HotelName = _project.HotelName
' model.VerdorName = _project.VerdorName
' model.HotelRoomType = TvwMain.SelectedNode.Text
' 'Dim node As TreeNode = FillModelNode(model)
' ''只添加RCU型号不添加子设备
' 'TvwMain.SelectedNode.Nodes.Clear()
' 'TvwMain.SelectedNode.Nodes.Add(node)
' Catch ex As Exception
' MsgBox($"加载模型错误,{ex.Message}")
' End Try
'End Sub
'Private Sub TsBtnSaveModel_Click(sender As Object, e As EventArgs) Handles TsBtnSaveModel.Click
' If TvwMain.SelectedNode Is Nothing Then Return
' If TvwMain.SelectedNode.Level <> 2 Then Return
' Dim path As String
' Using dlg As New SaveFileDialog
' dlg.Filter = "模型信息(*.xml)|*.xml"
' If dlg.ShowDialog <> DialogResult.OK Then Return
' path = dlg.FileName
' End Using
' Try
' SaveModelToXml(path, TvwMain.SelectedNode.Tag)
' MsgBox($"保存模型完成")
' Catch ex As Exception
' MsgBox($"保存模型错误,{ex.Message}")
' End Try
'End Sub
Public Sub FillTreView()
TvwMain.Nodes.Clear()
If AccountAuth Is Nothing Then Return
Dim nodes As New List(Of TreeNode)
For Each hotelGroup As HotelGroup In AccountAuth.HotelData
Dim pNode As TreeNode = New TreeNode(hotelGroup.HotelGroupsName) With {.Tag = hotelGroup}
nodes.Add(pNode)
For Each hotel As Hotel In hotelGroup.Hotels
pNode.Nodes.Add(New TreeNode(hotel.HotelName) With {.Tag = hotel})
Next
Next
TvwMain.Nodes.AddRange(nodes.ToArray)
End Sub
Public Function LoadModelFromXml(path As String) As DeviceModel
Return BXmlSerializer.DeserializeFormXml(Of DeviceModel)(path)
End Function
Public Sub SaveModelToXml(path As String, model As DeviceModel)
BXmlSerializer.SerializeToXml(path, model)
End Sub
Public Sub SaveProjectToXml(fullFileName As String, project As ProjectInfo)
BXmlSerializer.SerializeToXml(fullFileName, project)
End Sub
Public Function FillModelNode(devModel As DeviceModel) As TreeNode
Dim modelNode As New TreeNode($"{devModel.Name}({devModel.Desc.Brand}-{devModel.Desc.Model})") With {.ForeColor = Color.Black, .ImageKey = "09664", .SelectedImageKey = .ImageKey}
Dim classNode As TreeNode
Dim objectNode As TreeNode
With modelNode
.Tag = devModel
For Each devClass As DeviceChildNodeClass In devModel.Nodes
classNode = New TreeNode(devClass.Name) With {.Tag = devClass, .ForeColor = Color.Black, .ImageKey = "09664", .SelectedImageKey = .ImageKey}
.Nodes.Add(classNode)
For Each devObj As DeviceChildNode In devClass.Nodes
objectNode = New TreeNode(devObj.Name) With {.Tag = devObj, .ForeColor = Color.Black, .ImageKey = "03716", .SelectedImageKey = .ImageKey}
classNode.Nodes.Add(objectNode)
Next
Next
End With
Return modelNode
End Function
Private Sub TsBtnChangeProject_Click(sender As Object, e As EventArgs) Handles Button1.Click
Using frmHotel As New FrmChangeHotel
frmHotel.VerderIndex = _project.VerderIndex
frmHotel.VerderName = _project.VerdorName
frmHotel.HotelIndex = _project.HotelIndex
frmHotel.HotelName = _project.HotelName
frmHotel.HotelCode = _project.HotelCode
frmHotel.AccountAuth = AccountAuth
If frmHotel.ShowDialog() <> DialogResult.OK Then Return
_project.VerderIndex = frmHotel.VerderIndex
_project.VerdorName = frmHotel.VerderName
_project.HotelIndex = frmHotel.HotelIndex
_project.HotelName = frmHotel.HotelName
_project.HotelCode = frmHotel.HotelCode
'检测酒店发布权限,并载入酒店节点
CheckHotelCodePublishedPer()
'更新右上角项目和房型标签显示内容
g_CurrentTreeNodeRoomTypeItemIndex = 0
UpdateHotelAndRoomtypeLab_text()
''Momo 2022-04-03 创建FTP文件夹
'CreateXmlPath()
End Using
End Sub
''' <summary>
''' '检测酒店发布权限,并载入酒店节点
''' </summary>
Public Sub CheckHotelCodePublishedPer(Optional Selectednode As String = "")
If String.IsNullOrEmpty(_project.HotelCode) = False Then
For Each hotels In AccountAuth.HotelData
For Each hotel In hotels.Hotels
If hotel.Code.Equals(_project.HotelCode) Then
'CZH 2024 03 02 取消 项目锁 判断
'If PermissionsDetect(hotel.Auth, PermissionTypes.PerID.ProjectLock) = 5 Then
If PermissionsDetect(hotel.Auth, PermissionTypes.PerID.PublishProject) = 5 Then
tsb_ReleaseToProjcet.Enabled = True
Else
tsb_ReleaseToProjcet.Enabled = False
End If
'读取房型
Dim roomtypes As List(Of RoomType) = GetRoomType(_project.HotelIndex)
'填充酒店节点
If String.IsNullOrEmpty(Selectednode) Then
FillTreeView(_project.HotelName, roomtypes)
Else
FillTreeView(_project.HotelName, roomtypes, Selectednode)
End If
'End If
'发布锁
Exit Sub
End If
Next
Next
End If
End Sub
''' <summary>
''' 获取权限ID 对应权限
''' </summary>
''' <param name="Auth">酒店权限集合</param>
''' <param name="AuthorityId">权限ID</param>
''' <returns></returns>
Public Function PermissionsDetect(Auth As List(Of HotelAuth), AuthorityId As Integer) As Integer
'默认禁止
Dim AuthBool As Integer = PermissionTypes.PerType.Per_Ban
For Each AuthIten In Auth
If AuthIten.AuthorityId = AuthorityId Then
AuthBool = AuthIten.AuthotypeId
Return AuthBool
End If
Next
Return AuthBool
End Function
Private Sub FillTreeView(hotel As String, RoomTypes As List(Of RoomType), Optional Selectednode As String = "")
TvwMain.Nodes.Clear()
TvwMain.ItemHeight = 21
TvwMain.CheckBoxes = False
TvwMain.HideSelection = True
TvwMain.SelectedImageKey = TvwMain.ImageKey
Dim pNode As TreeNode = TvwMain.Nodes.Add(hotel)
pNode.ForeColor = Color.DarkGreen
pNode.NodeFont = New Font("宋体", 9, FontStyle.Bold)
pNode.ImageKey = "09664.ico"
pNode.SelectedImageKey = "09664.ico"
Dim i As Integer = 0
Dim tmpRoomType As New ProjectInfo.StrutRoomType
Dim retryCnt As Integer = 0
If RoomTypes.Count >= 1 Then
_project.ReDim_RoomType(RoomTypes.Count - 1)
For Each room_type As RoomType In RoomTypes
retryCnt = 0
Dim typeNode As TreeNode = pNode.Nodes.Add(room_type.RoomType)
typeNode.ForeColor = Color.Black 'Color.DeepPink
typeNode.NodeFont = New Font("宋体", 9 FontStyle.Bold)
Dim tmpPath As String = g_ConfigDir_Path _
& _project.VerdorName & "\" _
& _project.HotelCode & "-" _
& _project.HotelName
Dim tmp_Local_XmlFullName As String = g_DataDir_Path & tmpPath & "\" & room_type.XmlFile
Dim tmp_FTP_Xml_FullName As String = tmpPath & "\" & room_type.XmlFile
Dim tmp_APP_filepath As String = g_DataDir_Path & g_Firmware_Path
tmpRoomType.structRoomType_ID = room_type.RoomTypeIdx
tmpRoomType.structRoomType_Name = room_type.RoomType
tmpRoomType.structRoomType_XML_Filename = room_type.XmlFile
tmpRoomType.structRoomType_Passwread = room_type.PassWord
tmpRoomType.structRoomType_CfgCurrVer = room_type.CfgCurrVer
tmpRoomType.structRoomType_HotelID = room_type.HotelID
tmpRoomType.structRoomType_App_Cfg_For_L2 = room_type.App_Cfg_For_L2
tmpRoomType.structRoomType_App_Cfg_For_L4 = room_type.App_Cfg_For_L4
'tmpRoomType.structRoomType_OldID = room_type.RoomType_OldID
_project.RoomType(i) = tmpRoomType
i += 1
If String.IsNullOrEmpty(room_type.XmlFile) And String.IsNullOrEmpty(room_type.App_Cfg_For_L4) And String.IsNullOrEmpty(room_type.App_Cfg_For_L2) Then
typeNode.ImageKey = "03716-gary.ico"
typeNode.SelectedImageKey = "03716-gary.ico"
Else
If Not room_type.APP_Type.Trim.Equals("Hex_Code") Then
typeNode.ImageKey = "03716.ico"
typeNode.SelectedImageKey = "03716.ico"
Else
typeNode.ImageKey = "09770.ico"
typeNode.SelectedImageKey = "09770.ico"
End If
End If
AddtypeNode(typeNode, room_type.XmlFile, tmp_Local_XmlFullName, "无配置文件", True, Selectednode)
AddtypeNode(typeNode, room_type.App_Cfg_For_L2, tmp_APP_filepath & room_type.App_Cfg_For_L2.Trim, "无launch2固件文件", False, Selectednode)
AddtypeNode(typeNode, room_type.App_Cfg_For_L4, tmp_APP_filepath & room_type.App_Cfg_For_L4.Trim, "无launch4固件文件", False, Selectednode)
'If String.IsNullOrEmpty(room_type.XmlFile) Then
' typeNode.ImageKey = "03716-gary.ico"
' typeNode.SelectedImageKey = "03716-gary.ico"
' typeNode.Nodes.Add("无配置文件") '增加一个空节点’
' typeNode.Nodes(0).ImageKey = "Others_gray.ico" '本地文件存在
' typeNode.Nodes(0).SelectedImageKey = "Others_gray.ico"
'Else
' typeNode.ImageKey = "03716.ico"
' typeNode.SelectedImageKey = "03716.ico"
' typeNode.Nodes.Add(room_type.XmlFile)
' If Selectednode.Equals(room_type.XmlFile) Then
' typeNode.Expand()
' TvwMain.SelectedNode = typeNode.Nodes(0)
' End If
'End If
''lab_CheckFileExist:
'If FileExist(tmp_Local_XmlFullName) Then
' typeNode.Nodes(0).ImageKey = "01087.ico" '本地文件存在
' typeNode.Nodes(0).SelectedImageKey = "01087.ico"
' typeNode.Nodes(0).ForeColor = Color.Black
'Else
' typeNode.Nodes(0).ImageKey = "01088.ico" '本地文件不存在’
' typeNode.Nodes(0).SelectedImageKey = "01088.ico" '本地文件不存在’
' typeNode.Nodes(0).ForeColor = Color.LightGray
' 'If retryCnt < 2 Then
' ' 'DownloadXmlFile(_project.VerdorName, _project.HotelCode, _project.HotelName, room_type.XmlFile)
' ' Console.WriteLine("Download XML: " & room_type.XmlFile & " ,Retry = " & retryCnt)
' ' retryCnt += 1
' ' GoTo lab_CheckFileExist
' 'End If
'End If
Next
TvwMain.Nodes(0).Expand()
Else
Return
End If
End Sub
Public Sub AddtypeNode(ByRef typeNode As TreeNode, nodename As String, filepath As String, hint As String, Isxml As Boolean, Optional Selectednode As String = "")
If String.IsNullOrEmpty(nodename) Then
'typeNode.ImageKey = "03716-gary.ico"
'typeNode.SelectedImageKey = "03716-gary.ico"
typeNode.Nodes.Add(hint) '增加一个空节点’
typeNode.Nodes(typeNode.Nodes.Count - 1).ImageKey = "Others_gray.ico" '本地文件存在
typeNode.Nodes(typeNode.Nodes.Count - 1).SelectedImageKey = "Others_gray.ico"
Else
'typeNode.ImageKey = "03716.ico"
'typeNode.SelectedImageKey = "03716.ico"
typeNode.Nodes.Add(nodename)
If Selectednode.Equals(nodename) Then
typeNode.Expand()
TvwMain.SelectedNode = typeNode.Nodes(typeNode.Nodes.Count - 1)
End If
End If
If Isxml Then
If FileExist(filepath) Then
typeNode.Nodes(typeNode.Nodes.Count - 1).ImageKey = "01087.ico" '本地文件存在
typeNode.Nodes(typeNode.Nodes.Count - 1).SelectedImageKey = "01087.ico"
typeNode.Nodes(typeNode.Nodes.Count - 1).ForeColor = Color.Black
Else
typeNode.Nodes(typeNode.Nodes.Count - 1).ImageKey = "01088.ico" '本地文件不存在’
typeNode.Nodes(typeNode.Nodes.Count - 1).SelectedImageKey = "01088.ico" '本地文件不存在’
typeNode.Nodes(typeNode.Nodes.Count - 1).ForeColor = Color.LightGray
'If retryCnt < 2 Then
' 'DownloadXmlFile(_project.VerdorName, _project.HotelCode, _project.HotelName, room_type.XmlFile)
' Console.WriteLine("Download XML: " & room_type.XmlFile & " ,Retry = " & retryCnt)
' retryCnt += 1
' GoTo lab_CheckFileExist
'End If
End If
Else
If Not String.IsNullOrEmpty(nodename) Then
typeNode.Nodes(typeNode.Nodes.Count - 1).ImageKey = "01087.ico" '本地文件存在
typeNode.Nodes(typeNode.Nodes.Count - 1).SelectedImageKey = "01087.ico"
typeNode.Nodes(typeNode.Nodes.Count - 1).ForeColor = Color.Black
Else
typeNode.Nodes(typeNode.Nodes.Count - 1).ImageKey = "01088.ico" '本地文件不存在’
typeNode.Nodes(typeNode.Nodes.Count - 1).SelectedImageKey = "01088.ico" '本地文件不存在’
typeNode.Nodes(typeNode.Nodes.Count - 1).ForeColor = Color.LightGray
'If retryCnt < 2 Then
' 'DownloadXmlFile(_project.VerdorName, _project.HotelCode, _project.HotelName, room_type.XmlFile)
' Console.WriteLine("Download XML: " & room_type.XmlFile & " ,Retry = " & retryCnt)
' retryCnt += 1
' GoTo lab_CheckFileExist
'End If
End If
End If
End Sub
Private Function GetRoomType(strHotelId As String) As List(Of RoomType)
Dim result As New List(Of RoomType)
Dim dt As DataTable
'Using db As New DbExecutor(DbExecutor.DbTypeEnum.Mssql, DbConnString)
Using db As New DbExecutor(DbExecutor.DbTypeEnum.Mysql, DbConnString)
db.Open()
dt = db.ExecuteDataTable(db.CmdHelper.SearchAll("tbl_room_type_list", $" `HOTEL_OLD_ID` = '{strHotelId}'"))
db.Close()
End Using
Dim roomtype As RoomType
For Each dtRow As DataRow In dt.Rows
roomtype = New RoomType
roomtype.RoomTypeIdx = dtRow("ROOM_TYPE_OLD_ID").ToString
roomtype.HotelID = dtRow("HOTEL_OLD_ID").ToString
roomtype.RoomType = dtRow("ROOM_TYPE_NAME").ToString
roomtype.BinFile = dtRow("CONFIG_BIN").ToString
roomtype.BinFileMd5 = dtRow("CONFIG_BIN_MD5").ToString
roomtype.XmlFile = dtRow("CONFIG_XML").ToString
roomtype.CfgVersion = dtRow("CFG_CURR_VER").ToString
roomtype.PassWord = dtRow("PASSWORD").ToString
roomtype.CfgCurrVer = dtRow("CFG_CURR_VER").ToString
roomtype.APP_Type = dtRow.Item("APPTYPE").ToString
roomtype.IsDel = dtRow.Item("IsDel").ToString
If Not roomtype.APP_Type.Trim.Equals("Hex_Code") Then
roomtype.App_Cfg_For_L2 = dtRow("App_Cfg_For_L2").ToString
roomtype.App_Cfg_For_L4 = dtRow("App_Cfg_For_L4").ToString
Else
roomtype.App_Cfg_For_L2 = dtRow("Hex_Code_For_L2").ToString
roomtype.App_Cfg_For_L4 = dtRow("Hex_Code_For_L4").ToString
End If
'roomtype.RoomType_OldID = dtRow("ROOM_TYPE_OLD_ID").ToString
If roomtype.IsDel.Equals("1") Then Continue For
result.Add(roomtype)
Next
Return result
End Function
Private Function GetNodesRoomTypeItemIdx(argTreeNode As TreeNode, ByRef argRoomTypeNodeIdx As Integer) As Boolean
Try
Dim tmpTreeNode As TreeNode = argTreeNode
'S1:获取当前节点级数
Dim tmpNodeLevel As Integer = tmpTreeNode.Level
Console.WriteLine("tmpNodeLevel = " & tmpNodeLevel)
'S2一直递归到第二级
If tmpNodeLevel >= 2 Then
Do
tmpTreeNode = tmpTreeNode.Parent
tmpNodeLevel = tmpTreeNode.Level
argRoomTypeNodeIdx = tmpTreeNode.Index
Console.WriteLine("tmpNodeLevel = " & tmpNodeLevel & " , node name = " & tmpTreeNode.Text)
Loop While tmpNodeLevel > 1
End If
Console.WriteLine("argRoomTypeNodeIdx = " & argRoomTypeNodeIdx)
Return True
Catch ex As Exception
Return False
End Try
End Function
Private Sub SetTreeNodeBackColor(argRoomTypeItemIdx As Integer)
For i = 0 To TvwMain.Nodes(0).GetNodeCount(False) - 1
TvwMain.Nodes(0).Nodes(i).BackColor = Color.White
TvwMain.Nodes(0).Nodes(i).ForeColor = Color.Black 'Color.DeepPink
Next
TvwMain.Nodes(0).Nodes(argRoomTypeItemIdx).BackColor = Color.CornflowerBlue
TvwMain.Nodes(0).Nodes(argRoomTypeItemIdx).ForeColor = Color.White
End Sub
Private Sub TvwMain_AfterSelect(sender As Object, e As TreeViewEventArgs) Handles TvwMain.AfterSelect
Dim tmpRoomTypeNodeIdx As Integer = 0
Dim tmpXmlFullName As String = ""
'根据点击的级数确定对应的操作’
Select Case e.Node.Level
Case EnumTreeLevel.HotelName
g_CurrentTreeNodeRoomTypeItemIndex = 0 '0 = error
Return
Case EnumTreeLevel.RoomType
_project.CurrentSelectedRoomTypeIdx = e.Node.Index
SetTreeNodeBackColor(e.Node.Index)
g_CurrentTreeNodeRoomTypeItemIndex = e.Node.Index
Case EnumTreeLevel.RCU
'获取当前房型item idx
If (GetNodesRoomTypeItemIdx(e.Node, tmpRoomTypeNodeIdx) = True) Then
SetTreeNodeBackColor(tmpRoomTypeNodeIdx)
g_CurrentTreeNodeRoomTypeItemIndex = tmpRoomTypeNodeIdx
UpdateHotelAndRoomtypeLab_text()
Else
Return
End If
Return
Case EnumTreeLevel.Device
GetNodesRoomTypeItemIdx(e.Node, tmpRoomTypeNodeIdx)
If (GetNodesRoomTypeItemIdx(e.Node, tmpRoomTypeNodeIdx) = True) Then
SetTreeNodeBackColor(tmpRoomTypeNodeIdx)
g_CurrentTreeNodeRoomTypeItemIndex = tmpRoomTypeNodeIdx
End If
Case Else
GetNodesRoomTypeItemIdx(e.Node, tmpRoomTypeNodeIdx)
If (GetNodesRoomTypeItemIdx(e.Node, tmpRoomTypeNodeIdx) = True) Then
SetTreeNodeBackColor(tmpRoomTypeNodeIdx)
g_CurrentTreeNodeRoomTypeItemIndex = tmpRoomTypeNodeIdx
End If
End Select
UpdateHotelAndRoomtypeLab_text()
End Sub
Private Function DealPasteData(str As String) As List(Of List(Of String))
Dim result As New List(Of List(Of String))
Dim tmpStrings() As String = str.Split(New String() {vbCrLf}, StringSplitOptions.None)
For Each tmpStr As String In tmpStrings
Dim lst As New List(Of String)
lst.AddRange(tmpStr.Split(vbTab))
result.Add(lst)
Next
Return result
End Function
Private Sub TsBtnAddDev_Click(sender As Object, e As EventArgs) Handles TsBtnAddDev.Click
If _grdModel Is Nothing Then Return
'RS-485 Model full path
'E:\Sync\UTS\BLV_Studio\SourceCode\BLV_Studio\bin\Debug\Data\Model\485Model\
Dim path As String
Using dlg As New OpenFileDialog
dlg.InitialDirectory = g_DataDir_Path & g_ModelDir_Path & "485Model\"
dlg.Title = "请选择设备模型文件!"
dlg.Filter = "设备模型信息(*.xml)|*.xml"
If dlg.ShowDialog <> DialogResult.OK Then Return
path = dlg.FileName
End Using
Dim model As DeviceModel
Try
model = LoadModelFromXml(path)
Catch ex As Exception
MsgBox($"加载设备模型错误,{ex.Message}")
Return
End Try
Try
If model Is Nothing Then Throw New Exception("无效的设备模型信息")
_grdModel.AddDeviceObject(model, 1, True)
Catch ex As Exception
MsgBox($"添加节点失败,{ex.Message}")
End Try
End Sub
Private Sub TsBtnAddCondition_Click(sender As Object, e As EventArgs) Handles TsBtnAddCondition.Click
If _grdModel Is Nothing Then Return
Try
_grdModel.AddEventCondition()
Catch ex As Exception
MsgBox($"添加节点失败,{ex.Message}")
End Try
End Sub
Private Sub TsBtnAddAction_Click(sender As Object, e As EventArgs) Handles TsBtnAddAction.Click
If _grdModel Is Nothing Then Return
Try
_grdModel.AddEventAction()
Catch ex As Exception
MsgBox($"添加节点失败,{ex.Message}")
End Try
End Sub
Private Sub TsmiAppDev_Click(sender As Object, e As EventArgs) Handles TsmiAppDev.Click
TsBtnAddDev_Click(Nothing, Nothing)
End Sub
Private Sub TsmiAddCondition_Click(sender As Object, e As EventArgs) Handles TsmiAddCondition.Click
TsBtnAddCondition_Click(Nothing, Nothing)
End Sub
Private Sub TsmiAddAction_Click(sender As Object, e As EventArgs) Handles TsmiAddAction.Click
TsBtnAddAction_Click(Nothing, Nothing)
End Sub
Private Sub TsBtnSaveAs_Click(sender As Object, e As EventArgs) Handles TsBtnSaveAs.Click
SaveFileAs()
End Sub
Private Sub TsBtnLoad_Click(sender As Object, e As EventArgs) Handles TsBtnLoad.Click
Dim tmpMsgReslut As MsgBoxResult '弹出消息框的选定值
Me.Cursor = System.Windows.Forms.Cursors.WaitCursor '光标变成漏斗状
'加载耗时较长的函数
'Me.Cursor = System.Windows.Forms.Cursors.Default '光标恢复正常
Try
If _grdModel IsNot Nothing Then
_grdModel.DebugPrintTimeSpent("1 Press Load button")
_grdModel.CreateErrHightTimer(False)
_grdModel._gIsEnableGobleRuleCheck = False
If _grdModel._isCellChanged = True Then
Dim msgPromopt As String = "The current file has not been saved, please save it and open a new file" & vbCrLf & vbCrLf &
"Yes : Save the file you are currently editing and create a new project。" & vbCrLf &
"No :Do not save the file currently being edited and create a new project。" & vbCrLf &
"Cancel Cancel the current operation and continue editing the current file" & vbCrLf
Dim msgTitle As String = "当前文件尚未保存"
tmpMsgReslut = MsgBox(msgPromopt, MsgBoxStyle.YesNoCancel + MsgBoxStyle.Critical, "请先保存当前编辑的文件!")
'根据选择结果进行对应的操作
Select Case tmpMsgReslut
Case MsgBoxResult.Yes
'保存操作
If FileExist(g_Xml_FullName) Then
If _grdModel.Save(g_Xml_FullName) = False Then '如果当前文件存在则保存配置文件
MsgBox("保存文件失败!将返回正在编辑的项目,保存成功后再打开项目!", vbOKOnly + MsgBoxStyle.Information, "文件保存失败")
Return
End If
Else
If (SaveFileAs()) = False Then '如果文件名不存在则启动“另存为”
MsgBox("保存文件失败!将返回正在编辑的项目,保存成功后再打开项目!", vbOKOnly + MsgBoxStyle.Information, "文件保存失败")
Return
End If
End If
Case MsgBoxResult.No
'不保存,继续新建项目操作
Case MsgBoxResult.Cancel
'不保存,返回继续编辑操作
Return
Case Else
Return
End Select
End If
Else
_grdModel = New GridModel.DeviceEventModel(CompileSchedule)
If _grdModel.Grid Is Nothing Then _grdModel.Grid = GrdEvent
'初始化treeview控件
If _grdModel.TV Is Nothing Then _grdModel.TV = tv_ResourceTree
End If
Using openFileDialog As New OpenFileDialog
Dim tmpInitDir As String = g_DataDir_Path & g_ConfigDir_Path
openFileDialog.InitialDirectory = tmpInitDir
openFileDialog.RestoreDirectory = True
openFileDialog.Title = "打开文件"
openFileDialog.Filter = $"配置文件(*.xml)|*.xml"
_grdModel.DebugPrintTimeSpent("2 Start Open File")
If openFileDialog.ShowDialog() = DialogResult.OK Then
g_Xml_Name = openFileDialog.SafeFileName
g_Xml_FullName = openFileDialog.FileName
_grdModel.DebugPrintTimeSpent("3 Start Load XML")
If _grdModel.Load(g_Xml_FullName) = False Then g_Xml_FullName = ""
'加载基类tsb_DefaultView_
_grdModel.DebugPrintTimeSpent("Start Load BasicClass")
Dim tmpBasicClassFilename As String = _grdModel.BasicClassFilename
If LoadBasicClass(tmpBasicClassFilename) = False Then Return
'加载条件
_grdModel.DebugPrintTimeSpent("Start Load Condiction")
Dim tmpCondictionFilename As String = _grdModel.ConditionFileName
If LoadCondiction(tmpCondictionFilename) = False Then Return
_grdModel.BasicClasses = _basicClass
_grdModel.Condictions = _condictions
_grdModel.DebugPrintTimeSpent("Load file complete!")
End If
End Using
UpdateWindowTitle()
tsb_UpdateAllResourceList.PerformClick()
tsb_DefaultView.PerformClick()
Dim tmpErrCnt As Integer
Dim tmpWarningCnt As Integer
_grdModel.StartGobleRuleCheck(tmpErrCnt, tmpWarningCnt)
_grdModel.CreateErrHightTimer(True)
_grdModel._gIsEnableGobleRuleCheck = True
Me.Cursor = System.Windows.Forms.Cursors.Default '光标恢复正常
Catch ex As Exception
Me.Cursor = System.Windows.Forms.Cursors.Default '光标恢复正常
End Try
End Sub
Private Sub TsBtnNewFile_Click(sender As Object, e As EventArgs) Handles TsBtnNewFile.Click
Dim tmpMsgReslut As MsgBoxResult '弹出消息框的选定值
Try
If _grdModel IsNot Nothing Then
_grdModel.CreateErrHightTimer(False)
If _grdModel._isCellChanged = True Then
Dim msgPromopt As String = "The current file has not been saved, please save it and open a new file" & vbCrLf & vbCrLf &
"Yes : Save the file you are currently editing and create a new project。" & vbCrLf &
"No :Do not save the file currently being edited and create a new project。" & vbCrLf &
"Cancel Cancel the current operation and continue editing the current file" & vbCrLf
Dim msgTitle As String = "当前文件尚未保存"
tmpMsgReslut = MsgBox(msgPromopt, MsgBoxStyle.YesNoCancel + MsgBoxStyle.Critical, "请先保存当前编辑的文件!")
'根据选择结果进行对应的操作
Select Case tmpMsgReslut
Case MsgBoxResult.Yes
'保存操作
If FileExist(g_Xml_FullName) Then
If _grdModel.Save(g_Xml_FullName) = False Then '如果当前文件存在则保存配置文件
MsgBox("保存文件失败!将返回正在编辑的项目,保存成功后再新建项目!", vbOKOnly + MsgBoxStyle.Information, "文件保存失败")
Return
End If
Else
If (SaveFileAs()) = False Then '如果文件名不存在则启动“另存为”
MsgBox("保存文件失败!将返回正在编辑的项目,保存成功后再新建项目!", vbOKOnly + MsgBoxStyle.Information, "文件保存失败")
Return
End If
End If
Case MsgBoxResult.No
'不保存,继续新建项目操作
Case MsgBoxResult.Cancel
'不保存,返回继续编辑操作
Return
Case Else
Return
End Select
End If
Else
_grdModel = New GridModel.DeviceEventModel(CompileSchedule)
If _grdModel.Grid Is Nothing Then _grdModel.Grid = GrdEvent
'初始化treeview控件
If _grdModel.TV Is Nothing Then _grdModel.TV = tv_ResourceTree
End If
' _grdModel.InitGrid()
'初始化表格
'If TvwMain.SelectedNode Is Nothing Then Return
'If TvwMain.SelectedNode.Level <> 1 Then Return
'RCU full path
'E:\Sync\UTS\BLV_Studio\SourceCode\BLV_Studio\bin\Debug\Data\Model\RCUModel
Dim tmpRcuModelFile As String
Using dlg As New OpenFileDialog
dlg.InitialDirectory = g_DataDir_Path & g_ModelDir_Path & "RCUModel\"
dlg.Title = "请选择 RCU 模型文件!"
dlg.Filter = "RCU模型信息(*.xml)|*(高级配置版).xml"
If dlg.ShowDialog <> DialogResult.OK Then Return
tmpRcuModelFile = dlg.FileName
End Using
Try
Dim model As DeviceModel = LoadModelFromXml(tmpRcuModelFile)
'model.HotelName = _project.HotelName
'model.VerdorName = _project.VerdorName
'model.HotelRoomType = TvwMain.SelectedNode.Text
'加载基类
If LoadBasicClass(model.Desc.DevBasicClassFilename) = False Then
Return
End If
'加载条件
If LoadCondiction(model.Desc.DevCondictionFilename) = False Then
Return
End If
_grdModel._RcuModelName = model.Desc.Name
_grdModel.BasicClassFilename = model.Desc.DevBasicClassFilename
_grdModel.ConditionFileName = model.Desc.DevCondictionFilename
_grdModel.BasicClasses = _basicClass
_grdModel.Condictions = _condictions
_grdModel.InitGrid(model)
Catch ex As Exception
MsgBox($"加载RCU模型错误{ex.Message}")
End Try
g_Xml_FullName = ""
UpdateWindowTitle()
tsb_UpdateAllResourceList.PerformClick()
tsb_DefaultView.PerformClick()
Dim tmpErrCnt As Integer
Dim tmpWarningCnt As Integer
_grdModel.StartGobleRuleCheck(tmpErrCnt, tmpWarningCnt)
_grdModel.CreateErrHightTimer(True)
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "新建文件错误")
End Try
End Sub
Private Function LoadCondiction(xmlFileName As String) As Boolean
Try
'根据XML文件格式确定的基类
Dim tmpCondictionClassFilename = g_DataDir_Path & g_ModelDirEN_Path & "BaseModel\" & xmlFileName
_condictions = BXmlSerializer.DeserializeFormXml(Of ConfigActionConcitons)(tmpCondictionClassFilename)
Catch ex As Exception
MsgBox($"加载条件文件失败!{ex.Message}")
Return False
End Try
Return True
End Function
Public Sub AddLog(ByVal logMessage As String)
Dim logFilePath As String = "C:\Logs\MyAppLog.txt"
Try
' 确保日志目录存在
Dim logDirectory As String = Path.GetDirectoryName(logFilePath)
If Not Directory.Exists(logDirectory) Then
Directory.CreateDirectory(logDirectory)
End If
' 打开日志文件并追加日志消息
Using writer As New StreamWriter(logFilePath, True)
writer.WriteLine(DateTime.Now.ToString("yyyy-MM-dd HH:mm:ss") & " - " & logMessage)
End Using
Catch ex As Exception
' 如果写入日志时发生错误,输出错误信息到控制台
Console.WriteLine("Error writing to log file: " & ex.Message)
End Try
End Sub
Private Function LoadBasicClass(xmlFileName As String) As Boolean
Try
'根据XML文件格式确定的基类
Dim tmpBasicClassFilename = g_DataDir_Path & g_ModelDirEN_Path & "BaseModel\" & xmlFileName
_basicClass = BXmlSerializer.DeserializeFormXml(Of DeviceObjectClasses)(tmpBasicClassFilename)
AddLog($"加载基类文件成功")
Catch ex As Exception
AddLog($"加载基类文件失败!{ex.Message}")
MsgBox($"加载基类文件失败!{ex.Message}")
Return False
End Try
Return True
End Function
Private Sub EventGridTipChanged(sender As Object, e As TipChangedEventArgs)
RtxColTip.SuspendLayout()
RtxColTip.Clear()
RtxColTip.SelectionColor = Color.Black
RtxColTip.AppendText(e.Title & vbCrLf)
RtxColTip.SelectionColor = Color.Gray
RtxColTip.AppendText(e.TipString)
RtxColTip.ResumeLayout(False)
End Sub
Private Sub GridModelOutputPrint(sender As Object, e As OutputPrintEventArgs)
With RtxOutput
.SuspendLayout()
.SelectionColor = Color.Black
.AppendText($"[{e.Type,-6}]:")
Select Case e.Type
Case OutputPrintEventArgs.Types.Info
.SelectionColor = Color.Green
Case OutputPrintEventArgs.Types.Warn
.SelectionColor = Color.OrangeRed
Case OutputPrintEventArgs.Types.Error
.SelectionColor = Color.Red
End Select
.AppendText(e.Text & vbCrLf)
.ResumeLayout(False)
End With
End Sub
Private Sub TsBtnAddActions_Click(sender As Object, e As EventArgs) Handles TsBtnAddActions.Click
If _grdModel Is Nothing Then Return
Try
_grdModel.AddActions()
Catch ex As Exception
MsgBox($"添加节点失败,{ex.Message}")
End Try
End Sub
Private Sub TsBtnAddModel_Click(sender As Object, e As EventArgs) Handles TsBtnAddModel.Click
If _grdModel Is Nothing Then Return
Try
_grdModel.AddModel()
Catch ex As Exception
MsgBox($"添加节点失败,{ex.Message}")
End Try
End Sub
#Region "数据库操作"
Private Sub ReleaseConfigXmlToDB(tmpPath As String, tmpXmlName As String, cfgVer As String, newcfgVer As String, dic As List(Of Dictionary(Of String String)))
Dim tmpMsgBoxString As String = "Please confirm the release item and room type" & vbCrLf & vbCrLf & vbCrLf &
"Item grouping " & _project.VerdorName & vbCrLf &
"Item number " & _project.HotelCode & vbCrLf &
"Project name " & _project.HotelName & vbCrLf &
"Room type " & _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_Name & vbCrLf &
"Room type ID " & _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID & vbCrLf & vbCrLf &
"Configuration file name : " & tmpXmlName & vbCrLf & vbCrLf &
"Version number : " & cfgVer & "==>" & newcfgVer & vbCrLf
Dim Password As String = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_Passwread
Dim ReleaseControlFrom As New ReleaseControl_frn
ReleaseControlFrom.FirmwareList = GetRoonConfigHistoryVersion("tbl_firmware_upload_logs", "`AppType` ='App_Cfg' and `IsValid`='1'", DbConnString)
ReleaseControlFrom.Firmware_txt = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_App_Cfg_For_L2
ReleaseControlFrom.ComboBox1_txt = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_App_Cfg_For_L4
ReleaseControlFrom.tmpMsgBox = tmpMsgBoxString
'ReleaseControlFrom.ShowDialog()
'Me.Enabled = False
'Me.Hide()
If ReleaseControlFrom.ShowDialog() <> DialogResult.OK Then Return
Dim ReleasePassword As String = ReleaseControlFrom.ReleasePassword_txt.Text
Dim ReleaseNote As String = ReleaseControlFrom.ReleaseNotes_txt.Text
Dim Firmwarefilename = ReleaseControlFrom.FromDic
If Not Password.Equals(ReleasePassword) Then
MsgBox($"Publish password error")
Else
If CreateXmlPath() Then
'If MsgBox(tmpMsgBoxString, MsgBoxStyle.OkCancel + vbExclamation, "请确认发布信息!") = MsgBoxResult.Ok Then
''保存配置文件到本地
'创建本地和FTP文件夹
_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_App_Cfg_For_L2 = ReleaseControlFrom.Firmware_box.Text
_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_App_Cfg_For_L4 = ReleaseControlFrom.ComboBox1.Text
'保存文件’
Dim tmp_Local_XmlFullName As String = g_DataDir_Path & tmpPath & "\" & tmpXmlName
Dim tmp_FTP_Xml_FullName As String = tmpPath & "\" & tmpXmlName
If _grdModel.Save(tmp_Local_XmlFullName) = True Then '保存配置文件成功
g_Xml_FullName = tmp_Local_XmlFullName
End If
''上传配置文件到FTP site
If UtsFtp.CreateObject.FtpUpload(tmp_FTP_Xml_FullName, tmp_Local_XmlFullName) = 1 Then
Else
MsgBox("Upload file error")
Return
End If
Dim datfilepath As String = tmp_Local_XmlFullName.Replace(".xml", ".dat"
Dim tmppDatMd5 As String = GetStringMd5(datfilepath)
Dim tmpCondiction As String = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID
Dim xmlmd5 As String = GetStringMd5(tmp_Local_XmlFullName)
If UpdateDatabase(tmpXmlName, xmlmd5, tmppDatMd5, newcfgVer, ReleaseNote, Firmwarefilename, tmpCondiction, tmpPath) Then
MsgBox($"Release complete")
Else
Return
End If
Dim TrNode As TreeNode = TvwMain.SelectedNode
TrNode.Text = tmpXmlName
'更新窗口标题
UpdateWindowTitle()
'Dim DoubleClick As New TreeNodeMouseClickEventArgs(TvwMain.SelectedNode, MouseButtons.Left, 2, 0, 0)
'TvwMain.PerformNodeMouseDoubleClick(DoubleClick)
''''更新treeview
UpdateTreeView(tmpXmlName)
Dim DoubleClick As New TreeNodeMouseClickEventArgs(TvwMain.SelectedNode, MouseButtons.Left, 2, 0, 0)
TvwMain.PerformNodeMouseDoubleClick(DoubleClick)
Else
End If
End If
End Sub
Private Sub ReleaseConfigBLVToDB(tmpPath As String, tmpXmlName As String, cfgVer As String, newcfgVer As String, dic As List(Of Dictionary(Of String String)))
Dim tmpMsgBoxString As String = "Please confirm the release item and room type" & vbCrLf & vbCrLf & vbCrLf &
"Item grouping " & _project.VerdorName & vbCrLf &
"Item number " & _project.HotelCode & vbCrLf &
"Project name " & _project.HotelName & vbCrLf &
"Room type " & _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_Name & vbCrLf &
"Room type ID " & _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID & vbCrLf & vbCrLf &
"Configuration file name : " & tmpXmlName & vbCrLf & vbCrLf &
"Version number : " & cfgVer & "==>" & newcfgVer & vbCrLf
Dim Password As String = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_Passwread
Dim ReleaseControlFrom As New ReleaseControl_frn
ReleaseControlFrom.FirmwareList = GetRoonConfigHistoryVersion("tbl_firmware_upload_logs", "`AppType` ='App_Cfg' and `IsValid`='1'", DbConnString)
ReleaseControlFrom.Firmware_txt = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_App_Cfg_For_L2
ReleaseControlFrom.ComboBox1_txt = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_App_Cfg_For_L4
ReleaseControlFrom.tmpMsgBox = tmpMsgBoxString
'ReleaseControlFrom.ShowDialog()
'Me.Enabled = False
'Me.Hide()
If ReleaseControlFrom.ShowDialog() <> DialogResult.OK Then Return
_TableInteraction.TestReportingScenario(Account, _project.HotelCode, _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID, tmpXmlName, _TableInteraction.ConfigInfo.CfgFileVersion)
Dim ReleasePassword As String = ReleaseControlFrom.ReleasePassword_txt.Text
Dim ReleaseNote As String = ReleaseControlFrom.ReleaseNotes_txt.Text
Dim Firmwarefilename = ReleaseControlFrom.FromDic
If Not Password.Equals(ReleasePassword) Then
MsgBox($"Publish password error")
Else
If CreateXmlPath() Then
'If MsgBox(tmpMsgBoxString, MsgBoxStyle.OkCancel + vbExclamation, "请确认发布信息!") = MsgBoxResult.Ok Then
''保存配置文件到本地
'创建本地和FTP文件夹
_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_App_Cfg_For_L2 = ReleaseControlFrom.Firmware_box.Text
_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_App_Cfg_For_L4 = ReleaseControlFrom.ComboBox1.Text
'保存文件’
Dim tmp_Local_XmlFullName As String = g_DataDir_Path & tmpPath & "\" & tmpXmlName
Dim tmp_FTP_Xml_FullName As String = tmpPath & "\" & tmpXmlName
If _TableInteraction.Save(tmp_Local_XmlFullName) = True Then '保存配置文件成功
g_Xml_FullName = tmp_Local_XmlFullName
End If
''上传配置文件到FTP site
If UtsFtp.CreateObject.FtpUploadBlv(tmp_FTP_Xml_FullName, tmp_Local_XmlFullName) = 1 Then
Else
MsgBox("Upload file error")
Return
End If
Dim datfilepath As String = tmp_Local_XmlFullName.Replace(".blv", ".dat"
Dim tmppDatMd5 As String = GetStringMd5(datfilepath)
Dim tmpCondiction As String = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID
Dim xmlmd5 As String = GetStringMd5(tmp_Local_XmlFullName)
If UpdateDatabaseBlv(tmpXmlName, xmlmd5, tmppDatMd5, newcfgVer, ReleaseNote, Firmwarefilename, tmpCondiction, tmpPath) Then
'获取上传无卡取电回路别名数据库语句
Dim dbstr As String = _TableInteraction.tbl_room_ble_devlistInsert(_project.HotelCode, tmpCondiction)
If dbstr.Length > 0 Then
Using db As New DbExecutor(DbExecutor.DbTypeEnum.Mysql, DbConnString)
db.Open()
db.ExecuteDataTable(dbstr)
db.Close()
' Return True
End Using
End If
'执行数据库语句
MsgBox($"Publication completed")
Else
Return
End If
Dim TrNode As TreeNode = TvwMain.SelectedNode
TrNode.Text = tmpXmlName
'更新窗口标题
UpdateWindowTitle()
'Dim DoubleClick As New TreeNodeMouseClickEventArgs(TvwMain.SelectedNode, MouseButtons.Left, 2, 0, 0)
'TvwMain.PerformNodeMouseDoubleClick(DoubleClick)
''''更新treeview
UpdateTreeView(tmpXmlName)
Dim DoubleClick As New TreeNodeMouseClickEventArgs(TvwMain.SelectedNode, MouseButtons.Left, 2, 0, 0)
TvwMain.PerformNodeMouseDoubleClick(DoubleClick)
Else
End If
End If
End Sub
Public Sub tbl_room_ble_devlistInsert(HotelID As String, RoomTypeID As String, RoomID As String, tablename As String li As List(Of Dictionary(Of String, String)))
If RoomID.Length < 1 Then
MsgBox("未选择房号")
Return
End If
Dim hid As Integer = -1
Dim RTid As Integer = -1
Dim Rid As Integer = -1
Dim roonkey As New List(Of Byte)
Integer.TryParse(HotelID.Trim, hid)
Integer.TryParse(RoomTypeID.Trim, RTid)
Integer.TryParse(RoomID.Trim, Rid)
Dim selectstr As String = $"SELECT BleKey FROM {tablename} WHERE HotelID ='{HotelID}'and RoomTypeID='{RoomTypeID}' and RoomID='{RoomID}' ORDER BY `ID` DESC LIMIT 1"
Dim delete As String = $"DELETE FROM {tablename} WHERE HotelID ='{HotelID}'and RoomTypeID='{RoomTypeID}' and RoomID='{RoomID}'"
Dim dt As DataTable
Dim devkey As String = String.Empty
Using db As New DbExecutor(DbExecutor.DbTypeEnum.Mysql, DbConnString)
db.Open()
dt = db.ExecuteDataTable(selectstr)
If IsNothing(dt) OrElse dt.Rows.Count = 0 OrElse dt.Columns.Count = 0 Then
Dim keybuff(15) As Byte
roonkey.AddRange(BitConverter.GetBytes(hid))
roonkey.AddRange(BitConverter.GetBytes(RTid))
roonkey.AddRange(BitConverter.GetBytes(Rid))
If roonkey.Count < 16 Then
roonkey.AddRange(keybuff)
End If
Array.Copy(roonkey.ToArray, keybuff, keybuff.Length)
devkey = GetbyteTohex(keybuff)
Else
devkey = dt(0)(0)
End If
db.ExecuteDataTable(delete)
For Each dic In li
dic.Add("HotelID", HotelID)
dic.Add("RoomTypeID", RoomTypeID)
dic.Add("RoomID", RoomID)
dic.Add("BleKey", devkey)
dt = db.ExecuteDataTable(db.CmdHelper.Insert(tablename, dic))
Next
db.Close()
If IsNothing(dt) Then
MsgBox($"上传{tablename}BLE设备列表失败,请重新发布")
Return
End If
End Using
End Sub
Public Function GetbyteTohex(buff() As Byte) As String
Dim result As String = String.Empty
Dim h As String = String.Empty
For Each b In buff
h = Hex(b)
If h.Length = 1 Then
h = "0" & h
End If
result = $"{result}{h}-"
Next
If result.Length > 0 Then
Return result.Substring(0, result.Length - 1)
Else
Return result
End If
End Function
Public Function getOrderSeq(str As String) As String
Dim orderSeq As String = str.GetHashCode().ToString.Replace("-", "")
Dim rd As New Random
While orderSeq.Length < 16
orderSeq = orderSeq & rd.Next(0, 9)
'(Int())(Math.random() * 10)
End While
Return orderSeq
End Function
Public Function GetStringMd5(filePath As String) As String
Dim dataFile() As Byte = File.ReadAllBytes(filePath)
Dim databuff As Byte() = MD5.Create().ComputeHash(dataFile)
Dim MD5str As String = BitConverter.ToString(databuff)
' Console.WriteLine($"md5-1:{MD5str}")
Return MD5str.Replace("-", "")
End Function
Public Function GetMACaddress() As String
Dim netAddress As String = ""
Dim netName As String = ""
Dim searcher As New Management.ManagementObjectSearcher("select * from win32_NetworkAdapterConfiguration")
Dim moc2 As Management.ManagementObjectCollection = searcher.Get()
For Each mo As Management.ManagementObject In moc2
If CBool(mo("IPEnabled")) Then '判断是否是网卡
netName = mo.Properties("caption").Value.ToString '网卡名称
netAddress = mo.Properties("MACAddress").Value.ToString 'mac地址
End If
Next
Return netAddress
End Function
#End Region
#Region "MISC"
Private Sub UpdateWindowTitle()
If String.IsNullOrEmpty(g_Xml_FullName) Then
lab_EditingFileNale.Text = "未命名"
Else
If FileExist(g_Xml_FullName) Then
lab_EditingFileNale.Text = g_Xml_Name
g_Xml_Name = GetFileName(g_Xml_FullName)
g_Xml_FilePath = GetFilePath(g_Xml_FullName)
Text = $"{Application.ProductName} {Application.ProductVersion} Account:{Account}" & "-(" & g_Xml_Name & ")"
Return
End If
End If
Text = $"{Application.ProductName} {Application.ProductVersion} Account:{Account}"
End Sub
Private Sub UpdateHotelAndRoomtypeLab_text()
lab_HotelGroup_And_Hotel.Text = _project.VerdorName & ":" & _project.HotelCode & "-" & _project.HotelName & " |" & Account & " |"
If _project.RoomType Is Nothing Then
lab_RoomType.Text = "未选择房型"
Else
lab_RoomType.Text = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID & "-" &
_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_Name & "(" &
_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_CfgCurrVer & ")"
UpdateConfigInfo(Now)
End If
End Sub
'从完整的文件名中分理出文件名
Public Function GetFileName(FilePathFileName As String) As String '获取文件名 aaa.txt
Dim i As Integer, J As Integer
i = Len(FilePathFileName)
J = InStrRev(FilePathFileName, "\")
Return Mid(FilePathFileName, J + 1, i)
End Function
'从完整的文件名中分理出路径
Public Function GetFilePath(FilePathFileName As String) As String '获取路径路径 c:\dir1001\
On Error Resume Next
Dim J As Integer
J = InStrRev(FilePathFileName, "\")
Return Mid(FilePathFileName, 1, J)
End Function
'判断目录是否存在的函数 传入String值 返回Boolean值
Private Function DirExist(ByVal Str_Path As String) As Boolean
Return System.IO.Directory.Exists(Str_Path)
End Function
'判断文件是否存在的函数 传入String值 返回Boolean值
Private Function FileExist(ByVal Str_File As String) As Boolean
Return System.IO.File.Exists(Str_File)
End Function
'当房型数据发生变化时刷新tree view
Private Sub UpdateTreeView(Selectednode As String)
'检测酒店发布权限,并载入酒店节点
CheckHotelCodePublishedPer(Selectednode)
End Sub
''' <summary>
''' 刷新配置文件信息这些信息将会被编译到配置文件的0x01数据块
''' </summary>
Private Function UpdateConfigInfo(date_now As DateTime, Optional IfCfgVerPlusPlus As Boolean = False) As Boolean
Try
'填充配置信息
_ConfigInfo.Author = Account '配置发布作者
_ConfigInfo.ConfigToolVersion = Application.ProductVersion '配置软件版本号’
_ConfigInfo.ReleaseDate = date_now '发布日期
_ConfigInfo.HotelName = _project.HotelName '项目名称’
_ConfigInfo.HotelCode = _project.HotelCode '项目代号
_ConfigInfo.HotelGroupName = _project.VerdorName '项目分组
_ConfigInfo.RoomTypeName = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_Name '房型别名
'_ConfigInfo.CfgFileVersion = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ConfigVersion + 1 '配置版本号加一
If IfCfgVerPlusPlus Then
_ConfigInfo.CfgFileVersion = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_CfgCurrVer + 1 '配置版本号
Else
_ConfigInfo.CfgFileVersion = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_CfgCurrVer '配置版本号
End If
_grdModel._ConfigInfo = _ConfigInfo '复制到类变量,供编译时调用
If Not IsNothing(_TableInteraction) Then
_TableInteraction.ConfigInfo = _ConfigInfo
End If
Catch ex As Exception
MsgBox("Cannot compile without specifying the project name and room type" MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "No item name or room type is specified")
Return False
End Try
Return True
End Function
'文件另存为
Private Function SaveFileAs() As Boolean
Try
Using saveFileDialog As New SaveFileDialog
Dim tmpXmlFullName As String = ""
Dim tmpInitDir As String = g_DataDir_Path & g_ConfigDir_Path
With saveFileDialog
.InitialDirectory = tmpInitDir
.RestoreDirectory = True
.OverwritePrompt = True
.AddExtension = True
.DefaultExt = ".xml"
.Title = "保存文件"
.Filter = $"配置文件(*.xml)|*.xml"
End With
If saveFileDialog.ShowDialog() = DialogResult.OK Then
tmpXmlFullName = saveFileDialog.FileName
'2022 07 07 stater
If File.Exists(g_Xml_FullName.Replace(".xml", ".dat")) Then
If File.Exists(tmpXmlFullName.Replace(".xml", ".dat")) Then
File.Delete(tmpXmlFullName.Replace(".xml", ".dat"))
End If
File.Copy(g_Xml_FullName.Replace(".xml", ".dat"), tmpXmlFullName.Replace(".xml", ".dat"))
End If
'2022 07 07 end
If _grdModel.Save(tmpXmlFullName) = True Then
g_Xml_FullName = tmpXmlFullName '只有保存成功才会更新全局变量,确保全局变量的正确性
UpdateWindowTitle()
Return True
End If
End If
End Using
UpdateWindowTitle()
Return False
Catch ex As Exception
Return False
End Try
End Function
Private Function SaveFileAsBlv() As Boolean
Try
Using saveFileDialog As New SaveFileDialog
Dim tmpXmlFullName As String = ""
Dim tmpInitDir As String = g_DataDir_Path & g_ConfigDir_Path
With saveFileDialog
.InitialDirectory = tmpInitDir
.RestoreDirectory = True
.OverwritePrompt = True
.AddExtension = True
.DefaultExt = ".xml"
.Title = "保存文件"
.Filter = $"配置文件(*.blv)|*.blv"
End With
If saveFileDialog.ShowDialog() = DialogResult.OK Then
tmpXmlFullName = saveFileDialog.FileName
'2022 07 07 stater
If File.Exists(g_Xml_FullName.Replace(".blv", ".dat")) Then
If File.Exists(tmpXmlFullName.Replace(".blv", ".dat")) Then
File.Delete(tmpXmlFullName.Replace(".blv", ".dat"))
End If
File.Copy(g_Xml_FullName.Replace(".blv", ".dat"), tmpXmlFullName.Replace(".blv", ".dat"))
End If
'2022 07 07 end
If _TableInteraction.Save(tmpXmlFullName) = True Then
g_Xml_FullName = tmpXmlFullName '只有保存成功才会更新全局变量,确保全局变量的正确性
UpdateWindowTitle()
Return True
End If
End If
End Using
UpdateWindowTitle()
Return False
Catch ex As Exception
Return False
End Try
End Function
#End Region
#Region "SaveSetting"
Private Sub SaveSettings()
My.Settings.HotelName = _project.HotelName
My.Settings.HotelCode = _project.HotelCode
My.Settings.VerdorName = _project.VerdorName
My.Settings.HotelId = _project.HotelIndex
My.Settings.VenderIndex = _project.VerderIndex
My.Settings.LastEditXmlFile = g_Xml_FullName
My.Settings.Save()
End Sub
Private Function LoadSettings() As Boolean
Try
If Account.Equals(My.Settings.UserName) Then
My.Settings.Reload()
_project.HotelName = My.Settings.HotelName
_project.HotelCode = My.Settings.HotelCode
_project.VerdorName = My.Settings.VerdorName
_project.HotelIndex = My.Settings.HotelId
_project.VerderIndex = My.Settings.VenderIndex
g_Last_Edit_Xml_FileName = My.Settings.LastEditXmlFile
End If
Catch ex As Exception
Return False
End Try
Return True
End Function
#End Region
#Region "文件和目录操作"
'FTP地址'blv-oa.com
'账号BLV_Studio
'pw37f5675t6R&5*
'端口50
Public FtpHost As String = "blv-oa.com"
Public FtpPort As Integer = 50
Public FtpUser As String = "BLV_Studio"
Public FtpPwd As String = "37f5675t6R&5*"
'下载xml文件
Private Function DownloadXmlFile(strVendorName As String, strHotelCode As String, strHotelName As String, strFileName As String) As Boolean
Try
Dim retry As Integer = 0
Dim tmpPath As String = g_ConfigDir_Path _
& strVendorName & "\" _
& strHotelCode & "-" _
& strHotelName
Dim tmp_Local_XmlFullName As String = g_DataDir_Path & tmpPath & "\" & strFileName
Dim tmp_FTP_Xml_FullName As String = tmpPath & "\" & strFileName
Console.WriteLine("tmp_Local_XmlFullName: " & tmp_Local_XmlFullName)
Console.WriteLine("tmp_FTP_Xml_FullName: " & tmp_FTP_Xml_FullName)
UtsFtp.InitConnectParams(FtpPort, FtpUser, FtpPwd)
Dim ftp As UtsFtp = UtsFtp.CreateObject()
ftp.FtpHost = FtpHost
ftp.FtpDownload(tmp_FTP_Xml_FullName, tmp_Local_XmlFullName)
Console.WriteLine("Function:DownloadXmlFile: " & strFileName & " ,Retry = " & retry)
Return True
Catch ex As Exception
Return False
End Try
End Function
'根据酒店组和酒店名称信息创建XML文件保存目录同时创建FTP目录和本地目录
Private Function CreateXmlPath() As Boolean
'System.IO.Directory.CreateDirectory(g_DataDir_Path & g_ModelDir_Path & "BaseModel")
'System.IO.Directory.CreateDirectory(g_DataDir_Path & g_ModelDir_Path & "RCUModel\")
System.IO.Directory.CreateDirectory(g_DataDir_Path & g_ConfigDir_Path)
If String.IsNullOrEmpty(_project.HotelCode) Then
MsgBox("请选择有效的酒店组")
Return False
End If
If String.IsNullOrEmpty(_project.VerdorName) Then
MsgBox("请选择有效的酒店组")
Return False
End If
If String.IsNullOrEmpty(_project.HotelName) Then
MsgBox("请选择有效的酒店名称")
Return False
End If
'拼接文件名
g_Xml_FullPath_BasedOnTempFolder = g_ConfigDir_Path _
& _project.VerdorName & "\" _
& _project.HotelCode & "-" _
& _project.HotelName
'创建本地文件夹
System.IO.Directory.CreateDirectory(g_DataDir_Path & g_Xml_FullPath_BasedOnTempFolder)
'创建FTP文件夹
UtsFtp.InitConnectParams(FtpPort, FtpUser, FtpPwd)
Dim ftp As UtsFtp = UtsFtp.CreateObject()
ftp.FtpHost = FtpHost
Try
ftp.CreateDir(g_Xml_FullPath_BasedOnTempFolder) '创建文件夹
Catch ex As Exception
Throw New Exception($"创建客户Ftp文件夹失败,{ex.Message}")
Return False
End Try
Return True
End Function
Private Sub FrmMain_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
Dim tmpMsgReslut As MsgBoxResult '弹出消息框的选定值
_blvSync.IsRuning = False
If _grdModel._isCellChanged = True Then
Dim msgPromopt As String = "The current file has not been saved, please save it and open a new file" & vbCrLf & vbCrLf &
"Yes : Save the file you are currently editing and create a new project。" & vbCrLf &
"No :Do not save the file currently being edited and create a new project。" & vbCrLf &
"Cancel Cancel the current operation and continue editing the current file" & vbCrLf
Dim msgTitle As String = "当前文件尚未保存"
tmpMsgReslut = MsgBox(msgPromopt, MsgBoxStyle.YesNoCancel + MsgBoxStyle.Critical, "请先保存当前编辑的文件!")
'根据选择结果进行对应的操作
Select Case tmpMsgReslut
Case MsgBoxResult.Yes
'保存操作
If FileExist(g_Xml_FullName) Then
If _grdModel.Save(g_Xml_FullName) = False Then '如果当前文件存在则保存配置文件
MsgBox("保存文件失败!将返回正在编辑的项目,保存成功后再关闭程序!", vbOKOnly + MsgBoxStyle.Information, "文件保存失败")
e.Cancel = True
Return
End If
Else
If (SaveFileAs()) = False Then '如果文件名不存在则启动“另存为”
MsgBox("保存文件失败!将返回正在编辑的项目,保存成功后再关闭程序!", vbOKOnly + MsgBoxStyle.Information, "文件保存失败")
e.Cancel = True
Return
End If
End If
Case MsgBoxResult.No
'不保存,继续关闭软件
Case MsgBoxResult.Cancel
'不保存,返回继续编辑操作
e.Cancel = True
Return
Case Else
e.Cancel = True
Return
End Select
End If
If Not (IsNothing(_TableInteraction)) AndAlso _TableInteraction._isCellChanged = True Then
Dim msgPromopt As String = "The current file has not been saved, please save it and open a new file" & vbCrLf & vbCrLf &
"Yes : Save the file you are currently editing and create a new project。" & vbCrLf &
"No :Do not save the file currently being edited and create a new project。" & vbCrLf &
"Cancel Cancel the current operation and continue editing the current file" & vbCrLf
Dim msgTitle As String = "当前文件尚未保存"
tmpMsgReslut = MsgBox(msgPromopt, MsgBoxStyle.YesNoCancel + MsgBoxStyle.Critical, "请先保存当前编辑的文件!")
'根据选择结果进行对应的操作
Select Case tmpMsgReslut
Case MsgBoxResult.Yes
'保存操作
If FileExist(g_Xml_FullName) Then
If _TableInteraction.Save(g_Xml_FullName) = False Then '如果当前文件存在则保存配置文件
MsgBox("保存文件失败!将返回正在编辑的项目,保存成功后再关闭程序!", vbOKOnly + MsgBoxStyle.Information, "文件保存失败")
e.Cancel = True
Return
End If
Else
If (SaveFileAs()) = False Then '如果文件名不存在则启动“另存为”
MsgBox("保存文件失败!将返回正在编辑的项目,保存成功后再关闭程序!", vbOKOnly + MsgBoxStyle.Information, "文件保存失败")
e.Cancel = True
Return
End If
End If
Case MsgBoxResult.No
'不保存,继续关闭软件
Case MsgBoxResult.Cancel
'不保存,返回继续编辑操作
e.Cancel = True
Return
Case Else
e.Cancel = True
Return
End Select
End If
SaveSettings()
End Sub
Public Releaseflag As Boolean = True
Private Sub tsb_ReleaseToProjcet_Click(sender As Object, e As EventArgs) Handles tsb_ReleaseToProjcet.Click
If Releaseflag And Not IsNothing(TvwMain.SelectedNode) Then
Releaseflag = False
Dim tmpModifiedTime As Date = DateAndTime.Now
Dim strModifiedTime As String = Format(tmpModifiedTime, "yyMMddHHmmss") ' yyyyMMddHHmmss
'更新Model信息
'_grdModel.HotelName = _project.HotelName
'_grdModel.VerdorName = _project.VerdorName
'_grdModel.HotelRoomType = TvwMain.SelectedNode.Text
'配置文件保存地址
Dim tmpPath As String = g_ConfigDir_Path _
& _project.VerdorName & "\" _
& _project.HotelCode & "-" _
& _project.HotelName
''文件名
Dim cfgVer As Integer = Integer.Parse(_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_CfgCurrVer)
Dim newcfgVer As Integer = cfgVer + 1
Dim tmpXmlName = newcfgVer & "_Config-" &
_project.HotelCode & "-" &
_project.HotelName & "-" &
_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_Name & "-" &
strModifiedTime & ".xml"
Dim tmp_Local_XmlFullName As String = g_DataDir_Path & tmpPath & "\" & tmpXmlName
Dim devdic As New List(Of Dictionary(Of String, String))
If projectCompile(tmp_Local_XmlFullName, False, True, devdic) Then
'取当前时间
ReleaseConfigXmlToDB(tmpPath, tmpXmlName, cfgVer, newcfgVer, devdic)
Else
End If
Releaseflag = True
Else
MsgBox("请选择发布节点")
End If
End Sub
Private Sub tsb_SetTreeViewVisableOrNot_Click(sender As Object, e As EventArgs) Handles tsb_SetTreeViewVisableOrNot.Click
g_IsProjectTreeView_Visible = Not g_IsProjectTreeView_Visible
SplitContainer1.Panel1Collapsed = g_IsProjectTreeView_Visible
End Sub
Private Sub tsb_SaveFile_Click(sender As Object, e As EventArgs) Handles tsb_SaveFile.Click
If FileExist(g_Xml_FullName) Then
If _grdModel.Save(g_Xml_FullName) Then
MsgBox($"保存成功!{g_Xml_FullName}")
End If '保存配置文件
Else
SaveFileAs() '如果文件名不存在则启动“另存为”
End If
End Sub
Private Sub tsb_OpenFileFolder_Click(sender As Object, e As EventArgs) Handles tsb_OpenFileFolder.Click
If FileExist(g_Xml_FullName) Then
g_Xml_FilePath = GetFilePath(g_Xml_FullName)
Shell("explorer.exe /select," & g_Xml_FullName, vbNormalFocus)
Else
MsgBox("文件尚未保存,必须保存后才能通过目录打开!", MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "文件尚未保存")
End If
End Sub
Private Sub tsb_ExportToExcel_Click(sender As Object, e As EventArgs) Handles tsb_ExportToExcel.Click
Using saveFileDialog As New SaveFileDialog
Dim tmpInitDir As String = g_DataDir_Path & g_ConfigDir_Path
Dim tmpExcelFileName As String = ""
With saveFileDialog
.InitialDirectory = tmpInitDir
.RestoreDirectory = True
.OverwritePrompt = True
.AddExtension = True
.DefaultExt = ".xls"
.Title = "导出到Excel文件"
.Filter = $"Excel文件(*.xls)|*.xls"
End With
If saveFileDialog.ShowDialog() = DialogResult.OK Then
tmpExcelFileName = saveFileDialog.FileName
_grdModel.ExportToXls(tmpExcelFileName)
End If
End Using
UpdateWindowTitle()
End Sub
Private Sub tsb_SyncConfigFiles_Click(sender As Object, e As EventArgs)
'DownloadXmlFile(_project.VerdorName, _project.HotelCode, _project.HotelName, _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_XML_Filename)
frm_ProjectSync._project = _project
frm_ProjectSync.Show()
End Sub
Private Sub tsb_InsertRows_Click(sender As Object, e As EventArgs) Handles tsb_InsertRows.Click
If _grdModel Is Nothing Then Return
Try
_grdModel.InsertRows()
Catch ex As Exception
MsgBox($"插入行失败,{ex.Message}")
End Try
End Sub
Private Sub tsb_DeleteRows_Click(sender As Object, e As EventArgs) Handles tsb_DeleteRows.Click
If _grdModel Is Nothing Then Return
Try
_grdModel.DeleteRows()
Catch ex As Exception
MsgBox($"删除行失败,{ex.Message}")
End Try
End Sub
Private Sub tsb_MoveUp_Click(sender As Object, e As EventArgs) Handles tsb_MoveUp.Click
If _grdModel Is Nothing Then Return
Try
_grdModel.MoveUpRows()
Catch ex As Exception
MsgBox($"上移行失败,{ex.Message}")
End Try
End Sub
Private Sub tsb_MoveDown_Click(sender As Object, e As EventArgs) Handles tsb_MoveDown.Click
If _grdModel Is Nothing Then Return
Try
_grdModel.MoveDownRows()
Catch ex As Exception
MsgBox($"下移行失败,{ex.Message}")
End Try
End Sub
Private Sub tsb_CellCopy_Click(sender As Object, e As EventArgs) Handles tsb_CellCopy.Click
If _grdModel Is Nothing Then Return
Try
_grdModel.CopyRows()
Catch ex As Exception
MsgBox($"拷贝行失败,{ex.Message}")
End Try
End Sub
Private Sub tsb_CellPaste_Click(sender As Object, e As EventArgs) Handles tsb_CellPaste.Click
If _grdModel Is Nothing Then Return
Try
_grdModel.PasteRows()
Catch ex As Exception
MsgBox($"粘贴行失败,{ex.Message}")
End Try
End Sub
Private Sub tsb_Redo_Click(sender As Object, e As EventArgs) Handles tsb_Redo.Click
If _grdModel Is Nothing Then Return
Try
_grdModel.Redo()
Catch ex As Exception
MsgBox($"重做失败,{ex.Message}")
End Try
End Sub
Private Sub tsb_CellCut_Click(sender As Object, e As EventArgs) Handles tsb_CellCut.Click
If _grdModel Is Nothing Then Return
Try
_grdModel.CutRows()
Catch ex As Exception
MsgBox($"剪切行失败,{ex.Message}")
End Try
End Sub
Private Sub tsb_Undo_Click(sender As Object, e As EventArgs) Handles tsb_Undo.Click
If _grdModel Is Nothing Then Return
Try
_grdModel.Undo()
Catch ex As Exception
MsgBox($"撤销失败,{ex.Message}")
End Try
End Sub
Private Sub tsb_RowsDisable_Click(sender As Object, e As EventArgs) Handles tsb_RowsDisable.Click
If _grdModel Is Nothing Then Return
Try
_grdModel.DisableRows()
Catch ex As Exception
MsgBox($"禁用失败,{ex.Message}")
End Try
End Sub
Private Sub tsb_RowsEnable_Click(sender As Object, e As EventArgs) Handles tsb_RowsEnable.Click
If _grdModel Is Nothing Then Return
Try
_grdModel.EnableRows()
Catch ex As Exception
MsgBox($"启用失败,{ex.Message}")
End Try
End Sub
Private Sub tsb_RuleCheck_Click(sender As Object, e As EventArgs) Handles tsb_RuleCheck.Click
If _grdModel Is Nothing Then Return
Dim ruleCheck_ErrCnt As Integer = 0
Dim ruleCheck_WarningCnt As Integer = 0
Dim ruleCheckReslut As Boolean
Try
ruleCheckReslut = _grdModel.StartGobleRuleCheck(ruleCheck_ErrCnt, ruleCheck_WarningCnt)
TabProject.SelectedTab = TabProject.TabPages(2)
Catch ex As Exception
MsgBox($"规则检查错误,{ex.Message}")
End Try
End Sub
Private Sub tsb_Compile_Click(sender As Object, e As EventArgs) Handles tsb_Compile.Click
If FileExist(g_Xml_FullName) Then
If _grdModel.Save(g_Xml_FullName) = False Then
MsgBox($"保存文件失败{g_Xml_FullName}")
Exit Sub
End If '保存配置文件
MsgBox($"保存文件成功{g_Xml_FullName}")
Else
SaveFileAs() '如果文件名不存在则启动“另存为”
End If
projectCompile("", True) 'False: 编译成功后弹窗
End Sub
Public Function projectCompile(Optional savePath As String = "",
Optional ByVal IsShowCompileResult As Boolean = False,
Optional ByVal ifCfgVerPlusPlus As Boolean = False
Optional ByVal dic As List(Of Dictionary(Of String String)) = Nothing) As Boolean
If String.IsNullOrEmpty(savePath) Then
savePath = g_Xml_FullName
End If
RtxOutput.Clear()
If _grdModel Is Nothing Then
MsgBox($"未选择模型")
Return False
End If
Dim compileErrMsg As String = ""
Dim ruleCheck_ErrCnt As Integer = 0
Dim ruleCheck_WarningCnt As Integer = 0
Dim ruleCheckReslut As Boolean
Dim tmpReleasedDateTime As Date = DateAndTime.Now
If UpdateConfigInfo(tmpReleasedDateTime, ifCfgVerPlusPlus) = False Then
MsgBox($"配置刷新失败")
Return False
End If
'MsgBox("_grdModel._RcuModelName :" & _grdModel._rootNode.DeviceName)
' Try
'生成文件夹
If CreateXmlPath() Then
'先运行规则检查
ruleCheckReslut = _grdModel.StartGobleRuleCheck(ruleCheck_ErrCnt, ruleCheck_WarningCnt)
'如果规则检查有错误则不允许编译
If ruleCheck_ErrCnt > 0 Then
MsgBox("规则检测不通过,请逐项处理后重新编译!", MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "编译失败..")
Return False
Else
'填充配置信息
'_grdModel._ConfigInf
If _grdModel.Compile(compileErrMsg, savePath dic) = True Then
_grdModel.Save(savePath) '保存配置文件
If IsShowCompileResult Then MsgBox($"编译完成, 配置版本号:" & _grdModel._ConfigInfo.CfgFileVersion)
Return True
Else
MsgBox(compileErrMsg, MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "编译失败.")
Return False
End If
End If
End If
'Catch ex As Exception
' MsgBox($"编译失败,{ex.Message}")
' Return False
'End Try
Return True
End Function
Private Sub tsb_HideAttributesRows_Click(sender As Object, e As EventArgs) Handles tsb_HideAttributesRows.Click
_grdModel._isVisible_Attributes = Not _grdModel._isVisible_Attributes
_grdModel.SetRowsVisible(RowNode.RowTypeEnum.DeviceAttribute, _grdModel._isVisible_Attributes)
tsb_HideAttributesRows.Checked = Not _grdModel._isVisible_Attributes
End Sub
Private Sub tsb_HideCondictions_Click(sender As Object, e As EventArgs) Handles tsb_HideCondictions.Click
_grdModel._isVisible_Conditions = Not _grdModel._isVisible_Conditions
_grdModel.SetRowsVisible(RowNode.RowTypeEnum.DeviceEventAllConditions, _grdModel._isVisible_Conditions)
tsb_HideCondictions.Checked = Not _grdModel._isVisible_Conditions
End Sub
Private Sub tsb_FoldAll_Click(sender As Object, e As EventArgs) Handles tsb_ShowObject.Click
If _grdModel Is Nothing Then Return
_grdModel.SetRowsShowObject()
End Sub
Private Sub tsb_DefaultView_Click(sender As Object, e As EventArgs) Handles tsb_DefaultView.Click
If _grdModel Is Nothing Then Return
_grdModel.SetDefaultView()
End Sub
Private Sub tbn_ExpandAll_Click(sender As Object, e As EventArgs) Handles tbn_ExpandAll.Click
If _grdModel Is Nothing Then Return
_grdModel.ExpandAllNodes()
End Sub
Private Sub tsb_CellNav_Prev_Click(sender As Object, e As EventArgs) Handles tsb_CellNav_Prev.Click
If _grdModel Is Nothing Then Return
_grdModel.CellNav_Prev()
End Sub
Private Sub tsb_CellNav_Next_Click(sender As Object, e As EventArgs) Handles tsb_CellNav_Next.Click
If _grdModel Is Nothing Then Return
_grdModel.CellNav_Next()
End Sub
Private Sub tsb_Serach_Click(sender As Object, e As EventArgs) Handles tsb_UpdateAllResourceList.Click
If _grdModel Is Nothing Then Return
_grdModel.UpdateAllResourceList()
_grdModel.ExpandTreeView()
End Sub
Private Sub 更新RCU模型ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 更新RCU模型ToolStripMenuItem.Click
Try
Dim path As String
Using dlg As New OpenFileDialog
dlg.InitialDirectory = g_DataDir_Path & g_ModelDir_Path & "RCUModel\"
dlg.Title = "请选择 RCU 模型文件!"
dlg.Filter = "RCU模型信息(*.xml)|*.xml"
If dlg.ShowDialog <> DialogResult.OK Then Return
path = dlg.FileName
End Using
_grdModel.UpdateRCUModel(g_DataDir_Path, path)
MsgBox($"更新RCU模型完成")
Catch ex As Exception
MsgBox($"更新RCU模型错误{ex.Message}")
End Try
End Sub
Private Sub 更新外设模型ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 更新外设模型ToolStripMenuItem.Click
Try
Dim path As String
Using dlg As New OpenFileDialog
dlg.InitialDirectory = g_DataDir_Path & g_ModelDir_Path & "485Model\"
dlg.Title = "请选择 外设 模型文件!"
dlg.Filter = "外设模型信息(*.xml)|*.xml"
If dlg.ShowDialog <> DialogResult.OK Then Return
path = dlg.FileName
End Using
_grdModel.UpdateRCUModel(g_DataDir_Path, path, True)
MsgBox($"更新外设模型完成")
Catch ex As Exception
MsgBox($"更新外设模型错误:{ex.Message}")
End Try
End Sub
Private Sub 更新基类ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 更新基类ToolStripMenuItem.Click
Try
Dim path As String
Using dlg As New OpenFileDialog
dlg.InitialDirectory = g_DataDir_Path & g_ModelDir_Path & "BaseModel\"
dlg.Title = "请选择 基类 模型文件!"
dlg.Filter = "基类模型信息(*.xml)|*.xml"
If dlg.ShowDialog <> DialogResult.OK Then Return
path = dlg.FileName
End Using
_grdModel.UpdateBaseClass(path)
MsgBox($"更新基类模型完成")
Catch ex As Exception
MsgBox($"更新基类模型错误:{ex.Message}")
End Try
End Sub
Private Sub 更新条件ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 更新条件ToolStripMenuItem.Click
Try
Dim path As String
Using dlg As New OpenFileDialog
dlg.InitialDirectory = g_DataDir_Path & g_ModelDir_Path & "BaseModel\"
dlg.Title = "请选择 执行条件 模型文件!"
dlg.Filter = "执行条件模型信息(*.xml)|*.xml"
If dlg.ShowDialog <> DialogResult.OK Then Return
path = dlg.FileName
End Using
'根据XML文件格式确定的基类
_grdModel.UpdateCondition(path)
MsgBox($"更新条件模型完成")
Catch ex As Exception
MsgBox($"更新条件模型失败!{ex.Message}")
End Try
End Sub
Dim _showActionGroup_Mode As Integer = 1
Private Sub tsb_ActionGroup_Click(sender As Object, e As EventArgs) Handles tsb_ActionGroup.Click
If _grdModel Is Nothing Then Return
If _showActionGroup_Mode = 1 Then
_showActionGroup_Mode = 2 '仅显示分配别名的动作组
Else
_showActionGroup_Mode = 1 '显示全部动作组
End If
_grdModel.SetRowsShowActionGroup(_showActionGroup_Mode)
End Sub
Private Sub 导出节点ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 导出节点ToolStripMenuItem.Click
Try
Dim path As String
Using dlg As New SaveFileDialog
dlg.InitialDirectory = g_DataDir_Path & g_ModelDir_Path & "ExportModel\"
dlg.Title = "导出节点模型文件!"
dlg.Filter = "节点模型文件(*.xml)|*.xml"
If dlg.ShowDialog <> DialogResult.OK Then Return
path = dlg.FileName
End Using
'根据XML文件格式确定的基类
_grdModel.ExportRowNode(path)
MsgBox($"导出节点完成")
Catch ex As Exception
MsgBox($"导出节点失败!{ex.Message}")
End Try
End Sub
Private Sub 导入节点ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 导入节点ToolStripMenuItem.Click
Try
Dim path As String
Using dlg As New OpenFileDialog
dlg.InitialDirectory = g_DataDir_Path & g_ModelDir_Path & "ExportModel\"
dlg.Title = "请选择导入节点模型文件!"
dlg.Filter = "节点模型文件(*.xml)|*.xml"
If dlg.ShowDialog <> DialogResult.OK Then Return
path = dlg.FileName
End Using
'根据XML文件格式确定的基类
_grdModel.ImportRowNode(path)
MsgBox($"导入节点完成")
Catch ex As Exception
MsgBox($"导入节点失败!{ex.Message}")
End Try
End Sub
Private Sub TsBtnNewFile_LocationChanged(sender As Object, e As EventArgs) Handles TsBtnNewFile.LocationChanged
End Sub
Private Sub ToolStripButton1_Click(sender As Object, e As EventArgs)
Dim rcuModelName As String = _grdModel.FindRcuName()
MsgBox(rcuModelName)
End Sub
Private Sub ToolStripStatusLabel1_Click(sender As Object, e As EventArgs) Handles ToolStripStatusLabel1.Click
Dim col As Color = ToolStripStatusLabel1.BackColor
ToolStripStatusLabel1.BackColor = Color.Gray
delay(200)
ToolStripStatusLabel1.BackColor = col
_blvSync.num = 0
SetFtpIcon_labImage(0)
End Sub
'延时
Public Sub delay(ByRef Interval As Double)
Dim time As DateTime = DateTime.Now
Dim Span As Double = Interval * 10000 '因为时间是以100纳秒为单位。
While ((DateTime.Now.Ticks - time.Ticks) < Span)
Application.DoEvents()
End While
End Sub
Private Sub TvwMain_NodeMouseClick(sender As Object, e As TreeNodeMouseClickEventArgs) Handles TvwMain.NodeMouseClick
If e.Button <> MouseButtons.Right Then Return
'根据鼠标指向节点显示右键菜单
'Dim p As Point = TreeView1.PointToClient(MousePosition)
' Dim node As TreeNode = TreeView1.GetNodeAt(p)
'根据选中节点显示右键菜单
Dim node As TreeNode = TvwMain.SelectedNode
If node Is Nothing Then Return
If node.Level <> 2 Then Return
Console.WriteLine($"Text:{node.Text}")
TvNodeRightMenu.Show(TvwMain, e.X, e.Y)
'If e.Node.Level = EnumTreeLevel.RCU Then
' Dim tmpPath As String = g_ConfigDir_Path _
' & _project.VerdorName & "\" _
' & _project.HotelCode & "-" _
' & _project.HotelName & "\" & e.Node.Text
' ' Dim serverdir As String = g_DataDir_Path
' Dim loaddir As String = g_DataDir_Path & tmpPath
' If IO.File.Exists(loaddir) Then
' Return
' End If
' If _blvSync.separateMap.ContainsKey(tmpPath) Then
' Return
' End If
' _blvSync.separateMap.Add(tmpPath, loaddir)
' _blvSync.separateSart = True
' WaitFTPDow(_blvSync.separateSart)
' _blvSync.separateMap.Clear()
' Dim Aft As New TreeViewEventArgsTvwMain.SelectedNode
' TvwMain.PerformAfterCheck(Aft)
' If _blvSync._startFlag = 2 And IO.File.Exists(loaddir) Then
' e.Node.ImageKey = "01087.ico" '本地文件存在
' e.Node.SelectedImageKey = "01087.ico"
' e.Node.ForeColor = Color.Black
' Else
' e.Node.ImageKey = "01088.ico" '本地文件存在
' e.Node.SelectedImageKey = "01088.ico"
' e.Node.ForeColor = Color.Black
' End If
'End If
End Sub
Private Sub TvwMain_NodeMouseDoubleClick(sender As Object, e As TreeNodeMouseClickEventArgs) Handles TvwMain.NodeMouseDoubleClick
If Not e.Node.Level = EnumTreeLevel.RCU Then Return
If Not (e.Node.Text.ToLower.Contains(".xml") OrElse e.Node.Text.ToLower.Contains(".blv")) Then Return
If e.Node.Text.ToLower.Contains(".xml") Then
Dim tmpRoomTypeNodeIdx As Integer = 0
Dim tmpXmlFullName As String = ""
If _grdModel._isCellChanged = True Then
MsgBox("当前文件尚未保存,请保存后再打开新的文件!" MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "请先保存当前编辑的文件!")
Return
End If
TabControl1.SelectedIndex = 1
'文件名
'配置文件保存地址
Dim tmpPath As String = g_ConfigDir_Path _
& _project.VerdorName & "\" _
& _project.HotelCode & "-" _
& _project.HotelName
If Not String.IsNullOrEmpty(_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_XML_Filename) Then
tmpXmlFullName = g_DataDir_Path & tmpPath & "\" &
_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_XML_Filename
Console.WriteLine("tmpFullName = " & tmpXmlFullName)
'获取云文件信息(唯一文件)
Dim FileMysqlRow As List(Of Dictionary(Of String, String))
Dim roomsqlrow As Dictionary(Of String, String)
Dim tabname As String = "tbl_profile_upload_logs"
Dim wherestr As String = $" `RoomTypeID` = '{_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID }' And `XML_FileName` ='{_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_XML_Filename}'"
'查询数据库
FileMysqlRow = GetRoonConfigHistoryVersion(tabname, wherestr, DbConnString)
If FileMysqlRow.Count = 0 Then
MsgBox("数据库数据丢失,无此发布日志。请联系管理员更新发布日志")
Return
End If
roomsqlrow = FileMysqlRow.Item(0)
'本地是否有该文件存在且MD5一样🐏
If _blvSync.VerifyFileMD5(tmpXmlFullName, roomsqlrow.Item("XLM_MD5")) Then
e.Node.ImageKey = "01087.ico" '本地文件存在
e.Node.SelectedImageKey = "01087.ico"
e.Node.ForeColor = Color.Black
'直接打开
Else
If IO.File.Exists(tmpXmlFullName) Then
Dim msgflag As MsgBoxResult = MsgBox("本地文件和云端文件存在差异,是否同步云端文件", MsgBoxStyle.OkCancel, "打开文件:")
If msgflag = MsgBoxResult.Ok Then
VHFromDownFileroomsqlrow
If _blvSync.VerifyFileMD5(tmpXmlFullName, roomsqlrow.Item("XLM_MD5")) Then
e.Node.ImageKey = "01087.ico" '本地文件存在
e.Node.SelectedImageKey = "01087.ico"
e.Node.ForeColor = Color.Black
Else
e.Node.ImageKey = "01088.ico" '本地文件不存在’
e.Node.SelectedImageKey = "01088.ico" '本地文件不存在’
e.Node.ForeColor = Color.LightGray
Return
End If
ElseIf msgflag = 2 Then
Else
Return
End If
'显示弹窗
Else
VHFromDownFileroomsqlrow
If _blvSync.VerifyFileMD5(tmpXmlFullName, roomsqlrow.Item("XLM_MD5")) Then
e.Node.ImageKey = "01087.ico" '本地文件存在
e.Node.SelectedImageKey = "01087.ico"
e.Node.ForeColor = Color.Black
Else
e.Node.ImageKey = "01088.ico" '本地文件不存在’
e.Node.SelectedImageKey = "01088.ico" '本地文件不存在’
e.Node.ForeColor = Color.LightGray
Return
End If
End If
End If
UpdateEditTable(tmpXmlFullName)
End If
'UpdateWindowTitle()
'UpdateHotelAndRoomtypeLab_text()
Else
Dim tmpRoomTypeNodeIdx As Integer = 0
Dim tmpXmlFullName As String = ""
If Not IsNothing(_TableInteraction) Then
If _grdModel._isCellChanged = True Then
MsgBox("当前文件尚未保存,请保存后再打开新的文件!" MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "请先保存当前编辑的文件!")
Return
End If
End If
TabControl1.SelectedIndex = 0
'文件名
'配置文件保存地址
Dim tmpPath As String = g_ConfigDir_Path _
& _project.VerdorName & "\" _
& _project.HotelCode & "-" _
& _project.HotelName
If Not String.IsNullOrEmpty(_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_XML_Filename) Then
tmpXmlFullName = g_DataDir_Path & tmpPath & "\" &
_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_XML_Filename
Console.WriteLine("tmpFullName = " & tmpXmlFullName)
'获取云文件信息(唯一文件)
Dim FileMysqlRow As List(Of Dictionary(Of String, String))
Dim roomsqlrow As Dictionary(Of String, String)
Dim tabname As String = "tbl_profile_upload_logs"
Dim wherestr As String = $" `RoomTypeID` = '{_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID }' And `XML_FileName` ='{_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_XML_Filename}'"
FileMysqlRow = GetRoonConfigHistoryVersion(tabname, wherestr, DbConnString)
If FileMysqlRow.Count = 0 Then
MsgBox("数据库数据丢失,无此发布日志。请联系管理员更新发布日志")
Return
End If
roomsqlrow = FileMysqlRow.Item(0)
If _blvSync.VerifyFileMD5(tmpXmlFullName, roomsqlrow.Item("XLM_MD5")) Then
e.Node.ImageKey = "01087.ico" '本地文件存在
e.Node.SelectedImageKey = "01087.ico"
e.Node.ForeColor = Color.Black
'直接打开
Else
If IO.File.Exists(tmpXmlFullName) Then
Dim msgflag As MsgBoxResult = MsgBox("本地文件和云端文件存在差异,是否同步云端文件", MsgBoxStyle.OkCancel, "打开文件:")
If msgflag = MsgBoxResult.Ok Then
VHFromDownFileBLVroomsqlrow
If _blvSync.VerifyFileMD5(tmpXmlFullName, roomsqlrow.Item("XLM_MD5")) Then
e.Node.ImageKey = "01087.ico" '本地文件存在
e.Node.SelectedImageKey = "01087.ico"
e.Node.ForeColor = Color.Black
Else
e.Node.ImageKey = "01088.ico" '本地文件不存在’
e.Node.SelectedImageKey = "01088.ico" '本地文件不存在’
e.Node.ForeColor = Color.LightGray
Return
End If
ElseIf msgflag = 2 Then
Else
Return
End If
'显示弹窗
Else
VHFromDownFileBLVroomsqlrow
If _blvSync.VerifyFileMD5(tmpXmlFullName, roomsqlrow.Item("XLM_MD5")) Then
e.Node.ImageKey = "01087.ico" '本地文件存在
e.Node.SelectedImageKey = "01087.ico"
e.Node.ForeColor = Color.Black
Else
e.Node.ImageKey = "01088.ico" '本地文件不存在’
e.Node.SelectedImageKey = "01088.ico" '本地文件不存在’
e.Node.ForeColor = Color.LightGray
Return
End If
End If
End If
UpdateBLVEditTable(tmpXmlFullName)
Me.Cursor = System.Windows.Forms.Cursors.Default '光标恢复正常
End If
End If
End Sub
Public Sub WaitFTPDow(ByRef Interval As Boolean)
'Dim time As DateTime = DateTime.Now
'Dim Span As Double = Interval * 10000 '因为时间是以100纳秒为单位。
While (Interval)
Application.DoEvents()
End While
End Sub
Private Sub ToolStripMenuItem3_Click(sender As Object, e As EventArgs) Handles ToolStripMenuItem3.Click
'Dim DoubleClick As New TreeNodeMouseClickEventArgs(TvwMain.SelectedNode, MouseButtons.Left, 2, 0, 0)
'TvwMain.PerformNodeMouseDoubleClick(DoubleClick)
If Not TvwMain.SelectedNode.Text.ToLower.Contains("xml") Then Return
Dim roomsqlrow As Dictionary(Of String, String)
Dim tabname As String = "tbl_profile_upload_logs"
Dim wherestr As String = $" `RoomTypeID` = '{_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID }' And `XML_FileName` ='{_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_XML_Filename}'"
'查询数据库
Dim FileMysqlRow = GetRoonConfigHistoryVersion(tabname, wherestr, DbConnString)
roomsqlrow = FileMysqlRow.Item(0)
Dim icom As Image = ImgLstMain.Images.Item(51)
VHFromDownFileroomsqlrow
End Sub
Private Sub ToolStripMenuItem4_Click(sender As Object, e As EventArgs) Handles ToolStripMenuItem4.Click
Dim DoubleClick As New TreeNodeMouseClickEventArgs(TvwMain.SelectedNode, MouseButtons.Left, 2, 0, 0)
TvwMain.PerformNodeMouseDoubleClick(DoubleClick)
End Sub
Private Sub 版本历史ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ToolStripMenuItem.Click
Dim FileMysqlRow As List(Of Dictionary(Of String, String))
Dim tabname As String = "tbl_profile_upload_logs"
Dim wherestr As String = $" `RoomTypeID` = '{ _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID }' order by `ConfigFile_ID` desc"
'查询数据库
FileMysqlRow = GetRoonConfigHistoryVersion(tabname, wherestr, DbConnString)
Dim VHFrom As New VersionHistory
VHFrom.DataList = FileMysqlRow
Dim VHFromstate As Integer = VHFrom.ShowDialog()
If VHFromstate = DialogResult.Cancel Then Return
'加载到控件
If VHFromstate = DialogResult.OK Then
If IsNothing(VHFrom.RowData) Then Return
VHFromDownFile(VHFrom.RowData)
End If
If VHFromstate = DialogResult.Abort Then
If IsNothing(VHFrom.RowData) Then Return
VHFromDownFile(VHFrom.RowData, False)
End If
If VHFromstate = DialogResult.Yes Then
If IsNothing(VHFrom.RowData) Then Return
VHFromDownFile(VHFrom.RowData)
Dim tmpPath As String = g_ConfigDir_Path _
& _project.VerdorName & "\" _
& _project.HotelCode & "-" _
& _project.HotelName & "\" & VHFrom.RowData.Item("XML_FileName")
' Dim serverdir As String = g_DataDir_Path
Dim loaddir As String = g_DataDir_Path & tmpPath
''查询数据库
FileMysqlRow = GetRoonConfigHistoryVersion(tabname, wherestr, DbConnString)
VHFrom.DataList.Clear()
VHFrom.DataList = FileMysqlRow
VHFrom.FillTable()
'刷新编辑部
UpdateEditTable(loaddir)
End If
ToolStripMenuItem.PerformClick()
End Sub
''' <summary>
''' 单文件下载
''' </summary>
''' <param name="DownFile"></param>
Public Sub VHFromDownFile(DownFile As Dictionary(Of String, String), Optional issue As Boolean = True
If DownFile.Count > 0 Then
Dim tmpPath As String = g_ConfigDir_Path _
& _project.VerdorName & "\" _
& _project.HotelCode & "-" _
& _project.HotelName & "\" & DownFile.Item("XML_FileName")
' Dim serverdir As String = g_DataDir_Path
Dim loaddir As String = g_DataDir_Path & tmpPath
If issue Then
If _blvSync.VerifyFileMD5(loaddir, DownFile.Item("XLM_MD5")) Then
MsgBox($"{DownFile.Item("XML_FileName")}文件已存在")
Return
End If
Dim downloading As New Downoading
downloading.Show()
Dim ftp As UtsFtp = UtsFtp.CreateObject()
ftp.FtpHost = FtpHost
If ftp.FtpDownload(tmpPath, loaddir) = 1 Then
If ftp.FtpDownload(tmpPath.Replace(".xml", ".dat"), loaddir.Replace(".xml", ".dat")) = 1 Then
If _blvSync.VerifyFileMD5(loaddir, DownFile.Item("XLM_MD5")) Then
If _blvSync.VerifyFileMD5(loaddir.Replace(".xml", ".dat"), DownFile.Item("DAT_MD5")) Then
downloading.Close()
MsgBox($"文件下载成功")
If TvwMain.SelectedNode.Text.Equals(DownFile.Item("XML_FileName")) Then
TvwMain.SelectedNode.ImageKey = "01087.ico" '本地文件存在
TvwMain.SelectedNode.SelectedImageKey = "01087.ico"
TvwMain.SelectedNode.ForeColor = Color.Black
End If
Else
downloading.Close()
MsgBox($"dat文件校验失败")
End If
Else
downloading.Close()
MsgBox($"XML文件校验失败")
End If
Else
downloading.Close()
MsgBox($"dat文件下载失败")
End If
Else
downloading.Close()
MsgBox($"XML文件下载失败")
End If
Else
If _blvSync.VerifyFileMD5(loaddir, DownFile.Item("XLM_MD5")) AndAlso
_blvSync.VerifyFileMD5(loaddir.Replace(".xml", ".dat"), DownFile.Item("DAT_MD5")) Then
UpdateFileLatestDownFile, loaddir
Else
Dim downloading As New Downoading
downloading.Show()
Dim ftp As UtsFtp = UtsFtp.CreateObject()
ftp.FtpHost = FtpHost
If ftp.FtpDownload(tmpPath, loaddir) = 1 Then
If ftp.FtpDownload(tmpPath.Replace(".xml", ".dat"), loaddir.Replace(".xml", ".dat")) = 1 Then
If _blvSync.VerifyFileMD5(loaddir, DownFile.Item("XLM_MD5")) Then
If _blvSync.VerifyFileMD5(loaddir.Replace(".xml", ".dat"), DownFile.Item("DAT_MD5")) Then
'MsgBox($"文件下载成功")
downloading.Close()
UpdateFileLatestDownFile, loaddir
Else
downloading.Close()
MsgBox($"本地无此文件,dat文件校验失败,更新为最新失败")
End If
Else
downloading.Close()
MsgBox($"本地无此文件,XML文件校验失败,更新为最新失败")
End If
Else
downloading.Close()
MsgBox($"本地无此文件,dat文件下载失败,更新为最新失败")
End If
Else
downloading.Close()
MsgBox($"本地无此文件,XML文件下载失败,更新为最新失败")
End If
End If
End If
End If
End Sub
''' <summary>
''' 单文件下载
''' </summary>
''' <param name="DownFile"></param>
Public Sub VHFromDownFileBLV(DownFile As Dictionary(Of String, String), Optional issue As Boolean = True
If DownFile.Count > 0 Then
Dim tmpPath As String = g_ConfigDir_Path _
& _project.VerdorName & "\" _
& _project.HotelCode & "-" _
& _project.HotelName & "\" & DownFile.Item("XML_FileName")
' Dim serverdir As String = g_DataDir_Path
Dim loaddir As String = g_DataDir_Path & tmpPath
If issue Then
If _blvSync.VerifyFileMD5(loaddir, DownFile.Item("XLM_MD5")) Then
MsgBox($"{DownFile.Item("XML_FileName")}File already exists")
Return
End If
Dim downloading As New Downoading
downloading.Show()
Dim ftp As UtsFtp = UtsFtp.CreateObject()
ftp.FtpHost = FtpHost
If ftp.FtpDownload(tmpPath, loaddir) = 1 Then
If ftp.FtpDownload(tmpPath.Replace(".blv", ".dat"), loaddir.Replace(".blv", ".dat")) = 1 Then
If _blvSync.VerifyFileMD5(loaddir, DownFile.Item("XLM_MD5")) Then
If _blvSync.VerifyFileMD5(loaddir.Replace(".blv", ".dat"), DownFile.Item("DAT_MD5")) Then
downloading.Close()
MsgBox($"File download successful")
If TvwMain.SelectedNode.Text.Equals(DownFile.Item("XML_FileName")) Then
TvwMain.SelectedNode.ImageKey = "01087.ico" '本地文件存在
TvwMain.SelectedNode.SelectedImageKey = "01087.ico"
TvwMain.SelectedNode.ForeColor = Color.Black
End If
Else
downloading.Close()
MsgBox($".dat file verification failed")
End If
Else
downloading.Close()
MsgBox($".blv file verification failed")
End If
Else
downloading.Close()
MsgBox($".dat File download failure")
End If
Else
downloading.Close()
MsgBox($".blv File download failure")
End If
Else
If _blvSync.VerifyFileMD5(loaddir, DownFile.Item("XLM_MD5")) AndAlso
_blvSync.VerifyFileMD5(loaddir.Replace(".blv", ".dat"), DownFile.Item("DAT_MD5")) Then
UpdateFileLatestBlvDownFile, loaddir
Else
Dim downloading As New Downoading
downloading.Show()
Dim ftp As UtsFtp = UtsFtp.CreateObject()
ftp.FtpHost = FtpHost
If ftp.FtpDownload(tmpPath, loaddir) = 1 Then
If ftp.FtpDownload(tmpPath.Replace(".blv", ".dat"), loaddir.Replace(".blv", ".dat")) = 1 Then
If _blvSync.VerifyFileMD5(loaddir, DownFile.Item("XLM_MD5")) Then
If _blvSync.VerifyFileMD5(loaddir.Replace(".blv", ".dat"), DownFile.Item("DAT_MD5")) Then
'MsgBox($"文件下载成功")
downloading.Close()
UpdateFileLatestBlvDownFile, loaddir
Else
downloading.Close()
MsgBox($"The file does not exist locally,.dat file verification failed,Update to latest failure")
End If
Else
downloading.Close()
MsgBox($"The file does not exist locally,.blv file verification failed,Update to latest failure")
End If
Else
downloading.Close()
MsgBox($"The file does not exist locally,.dat File download failure,Update to latest failure")
End If
Else
downloading.Close()
MsgBox($"The file does not exist locally,.blv File download failure,Update to latest failure")
End If
End If
End If
End If
End Sub
Public Sub UpdateFileLatest(DownFile As Dictionary(Of String, String), loaddir As String)
Dim strModifiedTime As String = Format(DateAndTime.Now, "yyMMddHHmmss")
Dim cfgVer As Integer = Integer.Parse(_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_CfgCurrVer)
Dim newcfgVer As Integer = cfgVer + 1
Dim tmpXmlName = newcfgVer & "_Config-" &
_project.HotelCode & "-" &
_project.HotelName & "-" &
_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_Name & "-" &
strModifiedTime & ".xml"
Dim LoadPath As String = g_ConfigDir_Path _
& _project.VerdorName & "\" _
& _project.HotelCode & "-" _
& _project.HotelName
Dim tmp_Local_XmlFullName As String = g_DataDir_Path & LoadPath & "\" & tmpXmlName
Dim tmpMsgBoxString As String = "Please confirm the release item and room type" & vbCrLf & vbCrLf & vbCrLf &
"Item grouping " & _project.VerdorName & vbCrLf &
"Item number " & _project.HotelCode & vbCrLf &
"Project name " & _project.HotelName & vbCrLf &
"Room type " & _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_Name & vbCrLf &
"Room type ID " & _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID & vbCrLf & vbCrLf &
"Configuration file name : " & tmpXmlName & vbCrLf & vbCrLf &
"Version number : " & cfgVer & "==>" & newcfgVer & vbCrLf
Dim notegMsgBoxString As String = $"本版本由软件自动产生{vbCrLf}日期:{Date.Now.ToString("yyyy-MM-dd HH:mm:ss.fff")}{vbCrLf}作者:{Account}{vbCrLf}原版本为:{DownFile.Item("XML_FileName")} "
Dim Password As String = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_Passwread
Dim ReleaseControlFrom As New ReleaseControl_frn
ReleaseControlFrom.FirmwareList = GetRoonConfigHistoryVersion("tbl_firmware_upload_logs", "`AppType` ='App_Cfg' and `IsValid`='1'", DbConnString)
ReleaseControlFrom.notegBox = notegMsgBoxString
ReleaseControlFrom.tmpMsgBox = tmpMsgBoxString
ReleaseControlFrom.Firmware_txt = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_App_Cfg_For_L2
ReleaseControlFrom.ComboBox1_txt = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_App_Cfg_For_L4
'ReleaseControlFrom.TextBox2.Text = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_LUNCHER_HEX
'ReleaseControlFrom.ShowDialog()
If ReleaseControlFrom.ShowDialog() <> DialogResult.OK Then Return
Dim ReleasePassword As String = ReleaseControlFrom.ReleasePassword_txt.Text
Dim ReleaseNote As String = ReleaseControlFrom.ReleaseNotes_txt.Text
Dim Firmwarefilename = ReleaseControlFrom.FromDic
If Not Password.Equals(ReleasePassword) Then
MsgBox($"Publish password error")
Else
_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_App_Cfg_For_L2 = ReleaseControlFrom.Firmware_box.Text
_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_App_Cfg_For_L4 = ReleaseControlFrom.ComboBox1.Text
IO.File.Copy(loaddir, tmp_Local_XmlFullName)
IO.File.Copy(loaddir.Replace(".xml", ".dat"), tmp_Local_XmlFullName.Replace(".xml", ".dat"))
If _blvSync.VerifyFileMD5(tmp_Local_XmlFullName, DownFile.Item("XLM_MD5")) AndAlso
_blvSync.VerifyFileMD5(tmp_Local_XmlFullName.Replace(".xml", ".dat"), DownFile.Item("DAT_MD5")) Then
Dim tmp_FTP_Xml_FullName As String = LoadPath & "\" & tmpXmlName
g_Xml_FullName = tmp_Local_XmlFullName
''上传配置文件到FTP site
If UtsFtp.CreateObject.FtpUpload(tmp_FTP_Xml_FullName, tmp_Local_XmlFullName) Then
Else
MsgBox($"发布失败XML文件上传错误")
Return
End If
Dim tmppDatMd5 As String = GetStringMd5(tmp_Local_XmlFullName.Replace(".xml", ".dat"))
Dim tmpCondiction As String = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID
Dim xmlmd5 As String = GetStringMd5(tmp_Local_XmlFullName)
If UpdateDatabase(tmpXmlName, xmlmd5, tmppDatMd5, newcfgVer, ReleaseNote, Firmwarefilename, tmpCondiction, LoadPath) Then
MsgBox($"已更新为最新")
Else
Return
End If
Dim FileMysqlRow As List(Of Dictionary(Of String, String))
Dim tabname As String = "tbl_profile_upload_logs"
Dim wherestr As String = $" `RoomTypeID` = '{ _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID }' order by `ConfigFile_ID` desc"
''查询数据库
'FileMysqlRow = GetRoonConfigHistoryVersion(tabname, wherestr)
'Parent.DataList.Clear()
'Parent.DataList = FileMysqlRow
'Parent.FillTable()
'更新窗口标题
UpdateWindowTitle()
Dim TrNode As TreeNode = TvwMain.SelectedNode
TrNode.Text = tmpXmlName
'''更新treeview
UpdateTreeView(tmpXmlName)
Dim DoubleClick As New TreeNodeMouseClickEventArgs(TvwMain.SelectedNode, MouseButtons.Left, 2, 0, 0)
TvwMain.PerformNodeMouseDoubleClick(DoubleClick)
Else
MsgBox($"文件更新为最新失败,本地检验错误")
End If
End If
End Sub
Public Sub UpdateFileLatestBlv(DownFile As Dictionary(Of String, String), loaddir As String)
Dim strModifiedTime As String = Format(DateAndTime.Now, "yyMMddHHmmss")
Dim cfgVer As Integer = Integer.Parse(_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_CfgCurrVer)
Dim newcfgVer As Integer = cfgVer + 1
Dim tmpXmlName = newcfgVer & "_Config-" &
_project.HotelCode & "-" &
_project.HotelName & "-" &
_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_Name & "-" &
strModifiedTime & ".blv"
Dim LoadPath As String = g_ConfigDir_Path _
& _project.VerdorName & "\" _
& _project.HotelCode & "-" _
& _project.HotelName
Dim tmp_Local_XmlFullName As String = g_DataDir_Path & LoadPath & "\" & tmpXmlName
Dim tmpMsgBoxString As String = "Please confirm the release item and room type" & vbCrLf & vbCrLf & vbCrLf &
"Item grouping " & _project.VerdorName & vbCrLf &
"Item number " & _project.HotelCode & vbCrLf &
"Project name " & _project.HotelName & vbCrLf &
"Room type " & _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_Name & vbCrLf &
"Room type ID " & _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID & vbCrLf & vbCrLf &
"Configuration file name : " & tmpXmlName & vbCrLf & vbCrLf &
"Version number : " & cfgVer & "==>" & newcfgVer & vbCrLf
Dim notegMsgBoxString As String = $"本版本由软件自动产生{vbCrLf}日期:{Date.Now.ToString("yyyy-MM-dd HH:mm:ss.fff")}{vbCrLf}作者:{Account}{vbCrLf}原版本为:{DownFile.Item("XML_FileName")} "
Dim Password As String = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_Passwread
Dim ReleaseControlFrom As New ReleaseControl_frn
ReleaseControlFrom.FirmwareList = GetRoonConfigHistoryVersion("tbl_firmware_upload_logs", "`AppType` ='App_Cfg' and `IsValid`='1'", DbConnString)
ReleaseControlFrom.notegBox = notegMsgBoxString
ReleaseControlFrom.tmpMsgBox = tmpMsgBoxString
ReleaseControlFrom.Firmware_txt = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_App_Cfg_For_L2
ReleaseControlFrom.ComboBox1_txt = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_App_Cfg_For_L4
'ReleaseControlFrom.TextBox2.Text = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_LUNCHER_HEX
'ReleaseControlFrom.ShowDialog()
If ReleaseControlFrom.ShowDialog() <> DialogResult.OK Then Return
Dim ReleasePassword As String = ReleaseControlFrom.ReleasePassword_txt.Text
Dim ReleaseNote As String = ReleaseControlFrom.ReleaseNotes_txt.Text
Dim Firmwarefilename = ReleaseControlFrom.FromDic
If Not Password.Equals(ReleasePassword) Then
MsgBox($"Publish password error")
Else
_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_App_Cfg_For_L2 = ReleaseControlFrom.Firmware_box.Text
_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_App_Cfg_For_L4 = ReleaseControlFrom.ComboBox1.Text
IO.File.Copy(loaddir, tmp_Local_XmlFullName)
IO.File.Copy(loaddir.Replace(".blv", ".dat"), tmp_Local_XmlFullName.Replace(".blv", ".dat"))
If _blvSync.VerifyFileMD5(tmp_Local_XmlFullName, DownFile.Item("XLM_MD5")) AndAlso
_blvSync.VerifyFileMD5(tmp_Local_XmlFullName.Replace(".blv", ".dat"), DownFile.Item("DAT_MD5")) Then
Dim tmp_FTP_Xml_FullName As String = LoadPath & "\" & tmpXmlName
g_Xml_FullName = tmp_Local_XmlFullName
''上传配置文件到FTP site
If UtsFtp.CreateObject.FtpUploadBlv(tmp_FTP_Xml_FullName, tmp_Local_XmlFullName) Then
Else
MsgBox($"发布失败blv文件上传错误")
Return
End If
Dim tmppDatMd5 As String = GetStringMd5(tmp_Local_XmlFullName.Replace(".blv", ".dat"))
Dim tmpCondiction As String = _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID
Dim xmlmd5 As String = GetStringMd5(tmp_Local_XmlFullName)
If UpdateDatabaseBlv(tmpXmlName, xmlmd5, tmppDatMd5, newcfgVer, ReleaseNote, Firmwarefilename, tmpCondiction, LoadPath) Then
MsgBox($"已更新为最新")
Else
Return
End If
Dim FileMysqlRow As List(Of Dictionary(Of String, String))
Dim tabname As String = "tbl_profile_upload_logs"
Dim wherestr As String = $" `RoomTypeID` = '{ _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID }' order by `ConfigFile_ID` desc"
''查询数据库
'FileMysqlRow = GetRoonConfigHistoryVersion(tabname, wherestr)
'Parent.DataList.Clear()
'Parent.DataList = FileMysqlRow
'Parent.FillTable()
'更新窗口标题
UpdateWindowTitle()
Dim TrNode As TreeNode = TvwMain.SelectedNode
TrNode.Text = tmpXmlName
'''更新treeview
UpdateTreeView(tmpXmlName)
Dim DoubleClick As New TreeNodeMouseClickEventArgs(TvwMain.SelectedNode, MouseButtons.Left, 2, 0, 0)
TvwMain.PerformNodeMouseDoubleClick(DoubleClick)
Else
MsgBox($"文件更新为最新失败,本地检验错误")
End If
End If
End Sub
Public Shared Function API_AllocationBarCode(roomNumber As String, hotelID As String) As Boolean
Dim jsonString As String = String.Empty
Dim dic As New Dictionary(Of String String
dic.Add("roomTypeID", roomNumber)
dic.Add("type", "1")
dic.Add("version", hotelID)
Try
jsonString = PostData("https://boonlive-rcu.com/api/PublishupgradePackage", $"jsonData={JsonConvert.SerializeObject(dic)}")
Catch ex As Exception
MsgBox($"网络API调用错误请联系管理员。")
Return Nothing
End Try
'Console.WriteLine(jsonString)
If jsonString = Nothing Then
Return False
End If
Dim login As Dictionary(Of String String)
Try
login = JsonConvert.DeserializeObject(Of Dictionary(Of String String))(jsonString)
If Not IsNothing(login) AndAlso login.ContainsKey("IsSuccess") Then
If login.Item("IsSuccess").Equals("true") Then
Return True
Else
Return False
End If
Return False
Else
Return False
End If
Catch ex As Exception
'MsgBox($"Json数据转换错误请联系管理员。详情 Json data to AllocationAPI error")
Return False
End Try
End Function
Public Shared Function PostData(ByVal url As String, ByVal data As String) As String
ServicePointManager.Expect100Continue = False
Dim request As HttpWebRequest = CType(WebRequest.Create(url), HttpWebRequest)
'//Post请求方式
request.Method = "POST"
'内容类型
request.ContentType = "application/x-www-form-urlencoded"
'将URL编码后的字符串转化为字节
Dim encoding As New UTF8Encoding()
Dim bys As Byte() = encoding.GetBytes(data)
'设置请求的 ContentLength
request.ContentLength = bys.Length
'获得请 求流
Dim newStream As Stream = request.GetRequestStream()
newStream.Write(bys, 0, bys.Length)
newStream.Close()
'获得响应流
Dim sr As StreamReader = New StreamReader(request.GetResponse().GetResponseStream)
Return sr.ReadToEnd
End Function
Public Function UpdateDatabase(tmpDestStr As String, xmlmd5 As String, tmppDatMd5 As String, newcfgVer As String, ReleaseNote As String, Firmwarefilename As Dictionary(Of String, String(), tmpCondiction As String, LoadPath As String) As Boolean
Dim dt As DataTable
Dim App_Cfg_For_L4 As String
If Firmwarefilename.ContainsKey("App_Cfg_For_L4") Then
App_Cfg_For_L4 = Firmwarefilename.Item("App_Cfg_For_L4")
Else
App_Cfg_For_L4 = {"", "", "", ""}
End If
Dim App_Cfg_For_L2 As String
If Firmwarefilename.ContainsKey("App_Cfg_For_L2") Then
App_Cfg_For_L2 = Firmwarefilename.Item("App_Cfg_For_L2")
Else
App_Cfg_For_L2 = {"", "", "", ""}
End If
Dim IsPublishOk As Boolean = API_AllocationBarCode(tmpCondiction.Replace("'", ""), newcfgVer)
Using db As New DbExecutor(DbExecutor.DbTypeEnum.Mysql, DbConnString)
db.Open()
dt = db.ExecuteDataTable(db.CmdHelper.DbUpdate("blv_rcu_db",
"TBL_ROOM_TYPE_LIST",
"CONFIG_XML='" & tmpDestStr &
"',CONFIG_XML_MD5='" & xmlmd5 &
"',CONFIG_BIN='" & tmpDestStr.Replace(".xml", ".dat") &
"',CONFIG_BIN_MD5='" & tmppDatMd5 &
"',CFG_CURR_VER='" & newcfgVer &
"',ConfigUploadDateTime='" & Now.ToString("yyyy-MM-dd HH:mm:ss.fff") &
"',DESCRIPTION='" & ReleaseNote &
"',Cfg_Type='CFG_TYPE_BLV_STUDIO" &
"',App_Cfg_For_L2='" & App_Cfg_For_L2(1) &
"',App_Cfg_For_L2_MD5='" & App_Cfg_For_L2(2) &
"',App_Cfg_For_L4_MD5='" & App_Cfg_For_L4(2) &
"',App_Cfg_For_L4='" & App_Cfg_For_L4(1) &
"',APPTYPE='App_Cfg'",
"ROOM_TYPE_OLD_ID=" & tmpCondiction))
If IsNothing(dt) Then
MsgBox($"更新TBL_ROOM_TYPE_LIST数据表失败,请重新发布")
Return False
End If
'dt = db.ExecuteScalar(db.CmdHelper.Insert("tbl_model_file_data", insertClunm))
Dim insertClunm As New Dictionary(Of String String)
insertClunm.Clear()
insertClunm.Add("Directory", (LoadPath).Replace("\", "\\"))
insertClunm.Add("XML_FileName", tmpDestStr)
insertClunm.Add("DAT_FileName", tmpDestStr.Replace(".xml", ".dat"))
insertClunm.Add("Version", newcfgVer)
insertClunm.Add("UploadDateTime", Now.ToString("yyyy-MM-dd HH:mm:ss.fff"))
insertClunm.Add("XLM_MD5", xmlmd5)
insertClunm.Add("DAT_MD5", tmppDatMd5.Replace("'", ""))
insertClunm.Add("RoomTypeID", tmpCondiction.Replace("'", ""))
insertClunm.Add("Remark", ReleaseNote)
insertClunm.Add("RCU_Model", _grdModel.FindRcuName())
insertClunm.Add("HotelID", _project.HotelCode)
insertClunm.Add("ConfigApp_Ver", Application.ProductVersion)
insertClunm.Add("Author", Account)
insertClunm.Add("PC_NAME", System.Environment.UserName)
insertClunm.Add("PC_MAC", GetMACaddress())
insertClunm.Add("APIUsageRecord", IsPublishOk)
dt = db.ExecuteDataTable(db.CmdHelper.Insert("tbl_profile_upload_logs", insertClunm))
db.Close()
If IsNothing(dt) Then
MsgBox($"上传tbl_profile_upload_logs日志表失败,请重新发布")
Return False
End If
Return True
End Using
End Function
Public Function UpdateDatabaseBlv(tmpDestStr As String, xmlmd5 As String, tmppDatMd5 As String, newcfgVer As String, ReleaseNote As String, Firmwarefilename As Dictionary(Of String, String(), tmpCondiction As String, LoadPath As String) As Boolean
Dim dt As DataTable
Dim App_Cfg_For_L4 As String
If Firmwarefilename.ContainsKey("App_Cfg_For_L4") Then
App_Cfg_For_L4 = Firmwarefilename.Item("App_Cfg_For_L4")
Else
App_Cfg_For_L4 = {"", "", "", ""}
End If
Dim App_Cfg_For_L2 As String
If Firmwarefilename.ContainsKey("App_Cfg_For_L2") Then
App_Cfg_For_L2 = Firmwarefilename.Item("App_Cfg_For_L2")
Else
App_Cfg_For_L2 = {"", "", "", ""}
End If
Dim IsPublishOk As Boolean = API_AllocationBarCode(tmpCondiction.Replace("'", ""), newcfgVer)
Using db As New DbExecutor(DbExecutor.DbTypeEnum.Mysql, DbConnString)
db.Open()
dt = db.ExecuteDataTable(db.CmdHelper.DbUpdate("blv_rcu_db",
"TBL_ROOM_TYPE_LIST",
"CONFIG_XML='" & tmpDestStr &
"',CONFIG_XML_MD5='" & xmlmd5 &
"',CONFIG_BIN='" & tmpDestStr.Replace(".blv", ".dat") &
"',CONFIG_BIN_MD5='" & tmppDatMd5 &
"',CFG_CURR_VER='" & newcfgVer &
"',ConfigUploadDateTime='" & Now.ToString("yyyy-MM-dd HH:mm:ss.fff") &
"',DESCRIPTION='" & ReleaseNote &
"',Cfg_Type='CFG_TYPE_BLV_STUDIO" &
"',App_Cfg_For_L2='" & App_Cfg_For_L2(1) &
"',App_Cfg_For_L2_MD5='" & App_Cfg_For_L2(2) &
"',App_Cfg_For_L4_MD5='" & App_Cfg_For_L4(2) &
"',App_Cfg_For_L4='" & App_Cfg_For_L4(1) &
"',APPTYPE='App_Cfg'",
"ROOM_TYPE_OLD_ID=" & tmpCondiction))
If IsNothing(dt) Then
MsgBox($"更新TBL_ROOM_TYPE_LIST数据表失败,请重新发布")
db.Close()
Return False
End If
'dt = db.ExecuteScalar(db.CmdHelper.Insert("tbl_model_file_data", insertClunm))
Dim insertClunm As New Dictionary(Of String String)
insertClunm.Clear()
insertClunm.Add("Directory", (LoadPath).Replace("\", "\\"))
insertClunm.Add("XML_FileName", tmpDestStr)
insertClunm.Add("DAT_FileName", tmpDestStr.Replace(".blv", ".dat"))
insertClunm.Add("Version", newcfgVer)
insertClunm.Add("UploadDateTime", Now.ToString("yyyy-MM-dd HH:mm:ss.fff"))
insertClunm.Add("XLM_MD5", xmlmd5)
insertClunm.Add("DAT_MD5", tmppDatMd5.Replace("'", ""))
insertClunm.Add("RoomTypeID", tmpCondiction.Replace("'", ""))
insertClunm.Add("Remark", ReleaseNote)
insertClunm.Add("RCU_Model", _grdModel.FindRcuName())
insertClunm.Add("HotelID", _project.HotelCode)
insertClunm.Add("ConfigApp_Ver", Application.ProductVersion)
insertClunm.Add("Author", Account)
insertClunm.Add("PC_NAME", System.Environment.UserName)
insertClunm.Add("PC_MAC", GetMACaddress())
insertClunm.Add("APIUsageRecord", IsPublishOk)
dt = db.ExecuteDataTable(db.CmdHelper.Insert("tbl_profile_upload_logs", insertClunm))
db.Close()
If IsNothing(dt) Then
MsgBox($"上传tbl_profile_upload_logs日志表失败,请重新发布")
db.Close()
Return False
End If
db.Close()
Return True
End Using
End Function
''' <summary>
''' 获取表数据
''' </summary>
''' <param name="tabname">表名</param>
''' <param name="wherestr">条件</param>
''' <returns></returns>
Public Function GetRoonConfigHistoryVersion(tabname As String wherestr As String, Optional DbConnStr As String = "") As List(Of Dictionary(Of String, String))
Dim FileMysqlRow As New List(Of Dictionary(Of String, String))
Try
Dim dt As DataTable
Using db As New DbExecutor(DbExecutor.DbTypeEnum.Mysql, DbConnString)
db.Open()
dt = db.ExecuteDataTable(db.CmdHelper.SearchAll(tabname, wherestr))
db.Close()
End Using
For Each dtrow As DataRow In dt.Rows
Dim clunm As New Dictionary(Of String, String)
For i As Integer = 0 To dt.Columns.Count - 1
'Console.WriteLine("argRoomTypeNodeIdx = " & dtrow.Item(i))
'If dtrow.Item(i).GetType = "DbNull" Then
' clunm.Add(dt.Columns(i).ColumnName, "")
' Continue For
'End If
clunm.Add(dt.Columns(i).ColumnName, dtrow.Item(i).ToString)
Next
FileMysqlRow.Add(clunm)
Next
Catch ex As Exception
End Try
Return FileMysqlRow
End Function
''' <summary>
''' 固件上传
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
Private Sub ToolStripButton1_Click_1(sender As Object, e As EventArgs) Handles UploadFirmware_btn.Click
'If String.IsNullOrEmpty(_project.VerdorName) Then
' MsgBox("未选择酒店!")
' Return
'End If
'If String.IsNullOrEmpty(_project.HotelCode) Then
' MsgBox("未选择酒店房型!")
' Return
'End If
'If String.IsNullOrEmpty(_project.HotelName) Then
' MsgBox("未选择酒店房型名称!")
' Return
'End If
Dim strInputMsg As String = InputBox("请输入固件发布密码", "密码确认")
If strInputMsg <> "Cc2022OK" Then Return
Dim from As New FrmReleaseFirmware2
If from.ShowDialog() = DialogResult.OK Then
Dim dic = from.InsertFirmware
Dim dicv4 = from.InsertFirmwareV4
Dim uploadfile As String = from.FileName
Dim uploadfilename As String = from.SafeFileName
Dim uploadfilev4 As String = from.FileNameV4
Dim uploadfilenamev4 As String = from.SafeFileNameV4
Dim serverPath As String = g_Firmware_Path
Dim tmpPath As String = serverPath & "\" & uploadfilename
Dim tmpPathv4 As String = serverPath & "\" & uploadfilenamev4
dic.Add("Handler", Account)
dic.Add("PC_MAC", GetMACaddress())
dic.Add("PC_NAME", System.Environment.UserName)
dicv4.Add("Handler", Account)
dicv4.Add("PC_MAC", GetMACaddress())
dicv4.Add("PC_NAME", System.Environment.UserName)
'上传文件 键值对 必须包含上传的文件 【两个版本的键值对都为空在固件发布页面已做过滤】
If firmwareIsFtpUpload2dic, tmpPath, uploadfile And firmwareIsFtpUpload2dicv4, tmpPathv4, uploadfilev4 Then
'判断FTP服务器端文件是否存在 【在只传一个文件情况下另一文件为空也为true】
If IsFtpFileExists(tmpPath, dic) And IsFtpFileExists(tmpPathv4, dicv4) Then
If UploadFirmwareToSql(dic, "Hex_Code_For_L2") And UploadFirmwareToSql(dicv4, "Hex_Code_For_L4") Then
MsgBox("固件上传完成!")
If IsNothing(TvwMain.SelectedNode) Then
UpdateTreeView("")
Return
End If
If String.IsNullOrEmpty(TvwMain.SelectedNode.Text) Then
UpdateTreeView("")
Return
End If
UpdateTreeView(TvwMain.SelectedNode.Text)
Else
MsgBox("更新数据库失败!")
Return
End If
End If
Else
MsgBox("上传文件错误!")
Return
End If
End If
End Sub
Public Function IsFtpFileExists(filePath As String, dicv2 As Dictionary(Of String, String) As Boolean
'判断是否是上传文件【单一文件上传时,两个键值对中某一个会没有该关键字】
If dicv2.ContainsKey("FileName") Then
Return UtsFtp.CreateObject.FtpFileExists(filePath)
End If
Return True
End Function
Public Function firmwareIsFtpUpload2(dicv2 As Dictionary(Of String, String tmpPath As String uploadfile As String) As Boolean
If dicv2.ContainsKey("FileName") Then
If UtsFtp.CreateObject.FtpFileExists(tmpPath) Then
MsgBox("云端已存在同名文件")
Return False
End If
If Not UtsFtp.CreateObject.FtpUpload2(tmpPath, uploadfile) = 1 Then Return False
End If
Return True
End Function
Public Function UploadFirmwareToSql(insertClunm As Dictionary(Of String String), lv As String) As Boolean
'Dim tmpCondiction As String = "'" & _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID & "'"
'Dim uploadfileMD5 As String = GetStringMd5(uploadfile)
Dim udt As DataTable
Dim idt As DataTable
Using db As New DbExecutor(DbExecutor.DbTypeEnum.Mysql, DbConnString)
db.Open()
If insertClunm.ContainsKey("HOTEL_ID") AndAlso insertClunm.ContainsKey("FileName") Then
udt = db.ExecuteDataTable(db.CmdHelper.DbUpdate("blv_rcu_db",
"TBL_ROOM_TYPE_LIST",
$"`Cfg_Type`='CFG_TYPE_BLV_STUDIO',`{lv}`='{insertClunm.Item("FileName")}',`{lv}_MD5`='{insertClunm.Item("MD5Val")}',`Hex_Code_For_Model`='{insertClunm.Item("AppForModel")}',`APPTYPE` = '{insertClunm.Item("AppType")}'",
$"`ROOM_TYPE_OLD_ID`='{insertClunm.Item("ROOM_TYPE_ID")}'"))
If IsNothing(udt) Then
db.Close()
Return False
Else
End If
End If
If insertClunm.ContainsKey("FileName") Then
idt = db.ExecuteDataTable(db.CmdHelper.Insert("tbl_firmware_upload_logs", insertClunm))
Else
db.Close()
Return True
End If
db.Close()
End Using
If IsNothing(idt) Then
Return False
Else
Return True
End If
End Function
Public Function TableUploadFirmwareToSql(insertClunm As Dictionary(Of String String), lv As String) As Boolean
'Dim tmpCondiction As String = "'" & _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID & "'"
'Dim uploadfileMD5 As String = GetStringMd5(uploadfile)
Dim udt As DataTable
Using db As New DbExecutor(DbExecutor.DbTypeEnum.Mysql, DbConnString)
db.Open()
If insertClunm.ContainsKey("ROOM_TYPE_ID") AndAlso insertClunm.ContainsKey("FileName") Then
udt = db.ExecuteDataTable(db.CmdHelper.DbUpdate("blv_rcu_db",
"TBL_ROOM_TYPE_LIST",
$"`Cfg_Type`='CFG_TYPE_BLV_STUDIO',`{lv}`='{insertClunm.Item("FileName")}',`{lv}_MD5`='{insertClunm.Item("MD5Val")}',`APPTYPE` = '{insertClunm.Item("AppType")}'",
$"`ROOM_TYPE_OLD_ID`='{insertClunm.Item("ROOM_TYPE_ID")}'"))
If IsNothing(udt) Then
db.Close()
Return False
Else
End If
End If
db.Close()
End Using
Return True
End Function
Private Sub tsb_IsDisableItemShow_Click(sender As Object, e As EventArgs) Handles tsb_IsDisableItemShow.Click
_isHidDisableItem = Not _isHidDisableItem
If _isHidDisableItem = True Then
tsb_IsDisableItemShow.Text = "隐藏禁用"
Else
tsb_IsDisableItemShow.Text = "显示禁用"
End If
_grdModel.SetDisableItemView(_isHidDisableItem)
End Sub
#Region "项目管理"
Private Sub CreateProject_btn_Click(sender As Object, e As EventArgs) Handles CreateProject_btn.Click
Dim CreatePro As New CreateProject
CreatePro.AppUser = Account
CreatePro.AccountAuth = AccountAuth
CreatePro.VerderIndex = _project.VerderIndex
CreatePro.HotelIndex = _project.HotelIndex
CreatePro.RoomIndex = _project.HotelCode
CreatePro.DbConnString2 = DbConnString2
If CreatePro.ShowDialog = DialogResult.OK Then
initPojermanager()
RefurbishEventITable_tbl(FileMysqlRow)
InsertIntoEvenLog(FileMysqlRow, CreatePro.NStartTime, 2, 2)
End If
End Sub
Private Sub InsertIntoEvenLog(FileRow As List(Of Dictionary(Of String, String)), datetime As String, AfterStatus As String, ProcessType As String)
Dim dic As New Dictionary(Of String, String
For Each index In FileRow
Dim Stime As String = Date.Parse(index.Item("DateTime")).ToString("yyyy-MM-dd HH:mm:ss")
If Stime.Equals(datetime) Then
dic.Add("EventID", index.Item("ID"))
dic.Add("BeforeStatus", index.Item("CurrentStatus"))
dic.Add("AfterStatus", AfterStatus)
dic.Add("ProcessType", ProcessType)
dic.Add("DateTime", Now.ToString("yyyy-MM-dd HH:mm:ss"))
dic.Add("Handle", Account)
InsertIntoSqlTable("tbl_event_process_logs", dic)
Exit Sub
End If
Next
End Sub
Public Function InsertIntoSqlTable(tablename As String, sqlval As Dictionary(Of String, String)) As Boolean
Dim dt As DataTable
Using db As New DbExecutor(DbExecutor.DbTypeEnum.Mysql, DbConnString2)
db.Open()
dt = db.ExecuteDataTable(db.CmdHelper.Insert(tablename, sqlval))
db.Close()
If IsNothing(dt) Then
MsgBox($"发布事务失败,请查看数据表:{tablename},或联系开发者。")
Return False
End If
Return True
End Using
End Function
Private Sub TabControl1_Selected(sender As Object, e As TabControlEventArgs) Handles TabControl1.Selected
If TabControl1.SelectedIndex = 4 Then
'PojerFrominit()
'获取部门
Setdepartment_cbo()
End If
End Sub
Public Sub Userconfiginit()
PUserName_lab.Text = Account
PUserHolte_lab.Text = lab_HotelGroup_And_Hotel.Text
PUserVar_lab.Text = "软件版本:" & Application.ProductVersion
End Sub
Public Sub PojerFrominit()
'获取事务
initPojermanager()
'初始化表
InitEventITable_tbl()
'表格加载
RefurbishEventITable_tbl(FileMysqlRow)
End Sub
Private Sub ManageUser_cbo_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ManageUser_cbo.SelectedIndexChanged
ManageUser_cbo.Tag = ManageUser.Item(ManageUser_cbo.Text)
End Sub
Private FileMysqlRow As New List(Of Dictionary(Of String, String))
Private _colsMatching() As String = {"事务ID", "开始时间", "截止时间", "事务标题"}
Public Sub initPojermanager()
Dim tabname As String = "tbl_event_lists"
Dim wherestr As String = $"`Process_Handler`='{Account}'"
FileMysqlRow.Clear()
Try
Dim dt As DataTable
Using db As New DbExecutor(DbExecutor.DbTypeEnum.Mysql, DbConnString2)
db.Open()
dt = db.ExecuteDataTable(db.CmdHelper.SearchAll(tabname, wherestr))
db.Close()
End Using
For Each dtrow As DataRow In dt.Rows
Dim clunm As New Dictionary(Of String, String)
For i As Integer = 0 To dt.Columns.Count - 1
'Console.WriteLine("argRoomTypeNodeIdx = " & dtrow.Item(i))
'If dtrow.Item(i).GetType = "DbNull" Then
' clunm.Add(dt.Columns(i).ColumnName, "")
' Continue For
'End If
If IsDBNull(dtrow.Item(i)) Then
clunm.Add(dt.Columns(i).ColumnName, "")
Else
clunm.Add(dt.Columns(i).ColumnName, dtrow.Item(i))
End If
Next
FileMysqlRow.Add(clunm)
Next
Catch ex As Exception
MsgBox("获取数据表数据错误tbl_event_lists")
End Try
End Sub
Private Sub Button10_Click(sender As Object, e As EventArgs) Handles Button10.Click
initPojermanager()
RefurbishEventITable_tbl(FileMysqlRow)
End Sub
Private Sub InitEventITable_tbl()
EventITable_tbl.DisplayRowNumber = False
EventITable_tbl.Cols = _colsMatching.Length
EventITable_tbl.Rows = 1
EventITable_tbl.Locked = True
For index = 0 To EventITable_tbl.Cols - 1
With EventITable_tbl.Cell(0, index)
.Text = _colsMatching(index)
.BackColor = Color.LightGray
.ForeColor = Color.Blue
.Font = New Font($"Arial", 8, FontStyle.Bold)
End With
With EventITable_tbl.Column(index)
If index = 0 Then
.Alignment = FlexCell.AlignmentEnum.CenterCenter
.Width = 50
ElseIf index = 3 Then
.Alignment = FlexCell.AlignmentEnum.CenterCenter
.Width = 200
Else
.Alignment = FlexCell.AlignmentEnum.CenterCenter
.Width = 80
End If
End With
Next
EventITable_tbl.SelectionMode = FlexCell.SelectionModeEnum.ByRow '设置选中行
End Sub
Private Sub ClearEventITable_tbl()
Dim rows As Integer = EventITable_tbl.Rows
For i As Integer = 1 To rows - 1
EventITable_tbl.Row(1).Delete()
Next
End Sub
Public _EvenDic As New List(Of Integer)
Public _PojerStart() As String = {"已提交", "处理中", "已处理", "验证中", "已关闭"}
Private Sub RefurbishEventITable_tbl(FileRow As List(Of Dictionary(Of String, String)))
ClearEventITable_tbl()
_EvenDic.Clear()
If IsNothingFileRow Then Return
For index As Integer = 0 To FileRow.Count - 1
EventITable_tbl.AddItem("")
Dim dic = FileRowindex
EventITable_tbl.Cell(EventITable_tbl.Rows - 1, 0).Text = dic.Item("ID")
EventITable_tbl.Cell(EventITable_tbl.Rows - 1, 1).Text = dic.Item("DateTime")
EventITable_tbl.Cell(EventITable_tbl.Rows - 1, 2).Text = dic.Item("Process_TargetDateTime")
EventITable_tbl.Cell(EventITable_tbl.Rows - 1, 3).Text = dic.Item("EventDesc")
'1已提交 黄色 2处理中 橙色 3已处理 绿色 4验证中 蓝色 5已关闭 灰色
Select Case dic.Item("CurrentStatus")
Case 1
EventITable_tbl.Cell(EventITable_tbl.Rows - 1, 3).ForeColor = Color.YellowGreen
Case 2
EventITable_tbl.Cell(EventITable_tbl.Rows - 1, 3).ForeColor = Color.OrangeRed
_EvenDic.Add(EventITable_tbl.Rows - 1)
Case 3
EventITable_tbl.Cell(EventITable_tbl.Rows - 1, 3).ForeColor = Color.Green
Case 4
EventITable_tbl.Cell(EventITable_tbl.Rows - 1, 3).ForeColor = Color.Blue
Case 5
EventITable_tbl.Cell(EventITable_tbl.Rows - 1, 3).ForeColor = Color.Green
End Select
Next
If _EvenDic.Count < 1 Then
Button9.ImageKey = ""
tab_Pojermanag.ImageKey = ""
Else
'tab_Pojermanag.ImageKey = "Warning.ico"
Button9.ImageKey = "Warning.ico"
TabPage8.ImageKey = "Warning.ico"
End If
End Sub
Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click
If _EvenDic.Count < 1 Then
Button9.ImageKey = ""
TabPage8.ImageKey = ""
tab_Pojermanag.ImageKey = ""
Return
End If
Dim index As Integer = _EvenDic.Item(0)
_EvenDic.RemoveAt(0)
EventITable_tbl.Range(index, 3, index, 3).SelectCells()
End Sub
Private Sub EventITable_tbl_Click(Sender As Object, e As EventArgs) Handles EventITable_tbl.Click
If EventITable_tbl.ActiveCell.Row > 0 Then
For Each index In FileMysqlRow
Dim tableId As String = EventITable_tbl.Cell(EventITable_tbl.ActiveCell.Row, 0).Text
Dim sqlid As String = index.Item("ID")
If sqlid.Equals(tableId) Then
SetPojermanag_tab(index)
Else
Continue For
End If
Next
End If
End Sub
Private Sub SetPojermanag_tab(dic As Dictionary(Of String, String)
'Try
ProjectTitle_lab.Text = $"标题:{dic.Item("EventDesc")}"
handler_lab.Text = dic.Item("Process_Handler")
PojerStart_lab.Text = _PojerStart(CInt(dic.Item("CurrentStatus")) - 1)
StartTime_lab.Text = Date.Parse(dic.Item("DateTime")).ToString("yyyy年MM月dd日 HH时mm分ss秒")
StopTime_lab.Text = Date.Parse(dic.Item("Process_TargetDateTime")).ToString("yyyy年MM月dd日")
UserControl11.ProjectDescription_rictxt.Clear()
'Console.WriteLine("接收:" & dic.Item("RtfText"))
SetSqlTextColorToTabel(dic.Item("TitleLabel"))
Dim filepath() As String = dic.Item("RtfText").Split("|")
Dim buff(filepath.Length - 1) As Byte
If Not IsDBNull(dic.Item("RtfText")) Then
For i As Integer = 0 To filepath.Length - 2
'Console .WriteLine $"{i}:{filepath(i)}"
buff(i) = Convert.ToByte(filepath(i))
Next
End If
'Console.WriteLine("接收:" & ByteToString( buff))
UserControl11.ProjectDescription_rictxt.Rtf = Encoding.Default.GetString(buff)
'File.WriteAllText(filepath, dic.Item("RtfText"))
'UserControl11.ProjectDescription_rictxt.LoadFile (filepath)
' Catch ex As Exception
'MsgBox("tbl_event_lists 数据丢失,请查看数据库或联系开发者")
'End Try
End Sub
Private Sub SetSqlTextColorToTabel(sqlstr As String)
ClearricLabelGrb_li()
If String.IsNullOrEmpty(sqlstr) Then Return
Dim buff() As String = sqlstr.Split(",")
For i As Integer = 0 To buff.Length - 2 '预设会切割出空白字符串
Dim tc() As String = buff(i).Split("_")
If tc.Length < 4 Then Return
Try
Dim col As Color = Color.FromArgb(CInt(tc(1)), CInttc(2)), CInttc(3))
CreatorSqlLabel(tc(0), col)
Catch ex As Exception
Continue For
End Try
Next
SortLab()
End Sub
Private Sub ClearricLabelGrb_li()
For i As Integer = 0 To ricLabelGrb_li.Count - 2
dellabel_btn.PerformClick()
Next
End Sub
Public Function ByteToString(databuff() As Byte)
Dim strData As String = String.Empty
For i = 0 To databuff.Length - 1
strData &= $" {Hex(databuff(i)).PadLeft(2, "0"c)}"
Next
Return strData
End Function
Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
If IsNothingEventITable_tbl Then Return
Dim txt As String = mapping_txt.Text
'Where name.Item ("EventDesc").Contains(txt) = True
Dim query = From name As Dictionary(Of String, String) In FileMysqlRow
Order By name.Item("EventDesc").Contains(txt) Descending
Select name
Dim li As New List(Of Dictionary(Of String, String))
li.AddRange(query.ToArray)
RefurbishEventITable_tbl(li)
End Sub
Public department As New Dictionary(Of String, String
Public Sub Setdepartment_cbo()
Dim sqlstr As String = "SELECT * FROM `tbl_engineerning_department`"
Dim dic = GetSqlTableRowlist(sqlstr)
If IsNothing(dic) AndAlso dic.Count < 1 Then Return
department_cbo.Items.Clear()
department.Clear()
For Each index In dic
If String.IsNullOrEmpty(index.Item("DepartmentName")) Then
Continue For
End If
If department.ContainsKey(index.Item("DepartmentName")) Then Continue For
department_cbo.Items.Add(index.Item("DepartmentName"))
department.Add(index.Item("DepartmentName"), index.Item("id"))
Next
End Sub
Private Sub department_cbo_SelectedValueChanged(sender As Object, e As EventArgs) Handles department_cbo.SelectedValueChanged
department_cbo.Tag = department.Item(department_cbo.Text)
SetManageUser_cbo()
End Sub
Public ManageUser As New Dictionary(Of String, String
Public Sub SetManageUser_cbo()
Dim sqlstr As String = "SELECT * FROM `tbl_engineerning_teammembers`"
Dim dic = GetSqlTableRowlist(sqlstr)
If IsNothing(dic) AndAlso dic.Count < 1 Then Return
ManageUser_cbo.Items.Clear()
ManageUser.Clear()
For Each index In dic
If String.IsNullOrEmpty(index.Item("UserName")) Then
Continue For
End If
If ManageUser.ContainsKey(index.Item("UserName")) Then Continue For
ManageUser_cbo.Items.Add(index.Item("UserName"))
ManageUser.Add(index.Item("UserName"), index.Item("UserID"))
Next
End Sub
Public Function GetSqlTableRowlist(sqlstr As String) As List(Of Dictionary(Of String, String))
Dim FileMysqlRow As New List(Of Dictionary(Of String, String))
Try
Dim dt As DataTable
Using db As New DbExecutor(DbExecutor.DbTypeEnum.Mysql, DbConnString2)
db.Open()
dt = db.ExecuteDataTable(sqlstr)
db.Close()
End Using
For Each dtrow As DataRow In dt.Rows
Dim clunm As New Dictionary(Of String, String)
For i As Integer = 0 To dt.Columns.Count - 1
'Console.WriteLine("argRoomTypeNodeIdx = " & dtrow.Item(i))
'If dtrow.Item(i).GetType = "DbNull" Then
' clunm.Add(dt.Columns(i).ColumnName, "")
' Continue For
'End If
clunm.Add(dt.Columns(i).ColumnName, dtrow.Item(i).ToString)
Next
FileMysqlRow.Add(clunm)
Next
Catch ex As Exception
Return Nothing
End Try
Return FileMysqlRow
End Function
Private Sub Circulation_btn_Click(sender As Object, e As EventArgs) Handles Circulation_btn.Click
If ComboBox1.Text.Length < 1 Then
MsgBox("任务类别为空!")
Return
End If
If department_cbo.Text.Length < 1 Then
MsgBox("部门为空!")
Return
End If
If ManageUser_cbo.Text.Length < 1 Then
MsgBox("处理人为空!")
Return
End If
'Dim sqlval As New Dictionary(Of String, String)
'sqlval.Add("CurrentStatus", ComboBox1.Tag)
'sqlval.Add("EventType", layer_cbo.Text)
'sqlval.Add("Process_Department", department_cbo.Text)
'sqlval.Add("Process_Handler", ManageUser_cbo.Text)
''sqlval.Add("RtfTextMd5", GetStringMd5(UserControl11.ProjectDescription_rictxt.Rtf))
'Dim buff() As Byte = System.Text.Encoding.Default.GetBytes(UserControl11.ProjectDescription_rictxt.Rtf)
'Dim sb As New StringBuilder
'For Each ss In buff
' sb.Append(ss)
' sb.Append("|")
'Next
''Console.WriteLine ("上传:"& ByteToString(buff ))
''Console.WriteLine ("上传:"& sb.ToString)
'sqlval.Add("RtfText", sb.ToString)
End Sub
Private Sub ComboBox1_SelectedValueChanged(sender As Object, e As EventArgs) Handles ComboBox1.SelectedValueChanged
If ComboBox1.Tag = ComboBox1.SelectedIndex + 1 = 6 Then
ComboBox1.Tag = 4
End If
ComboBox1.Tag = ComboBox1.SelectedIndex + 1
End Sub
Private Sub CreatorSqlLabel(txt As String, txtcolor As Color)
Dim lab As New Label
lab.Text = txt
lab.ForeColor = txtcolor
lab.BackColor = Color.LightGray
lab.AutoSize = True
ricLabelGrb_li.Insert(ricLabelGrb_li.Count - 2, lab)
End Sub
Private Sub Addlabel_btn_Click(sender As Object, e As EventArgs) Handles Addlabel_btn.Click
'Dim ucfrom As New UCreatelabel
'If ucfrom.ShowDialog = DialogResult.OK Then
' CreatorSqlLabel(ucfrom.txt, ucfrom.txtcolor)
' SortLab()
'End If
End Sub
Private Sub SortLab()
Dim x As Integer = 2
Dim Y As Integer = 2
For i As Integer = 0 To ricLabelGrb_li.Count - 1
Dim cont As Control = ricLabelGrb_li.Item(i)
If i < ricLabelGrb_li.Count - 2 Then
ricLabel_Grb.Controls.Add(cont)
If cont.Width + x > ricLabel_Grb.Width Then
Y = Y + 2 + Addlabel_btn.Height
x = 2
Else
End If
cont.Location = New Point(x, Y)
x = x + 2 + cont.Width
Else
Dim cont1 As Control = ricLabelGrb_li.Item(i + 1)
ricLabel_Grb.Controls.Add(cont)
ricLabel_Grb.Controls.Add(cont1)
If 170 + x > ricLabel_Grb.Width Then
Y = Y + 2 + Addlabel_btn.Height
x = 2
cont.Location = New Point(x, Y)
x = x + 2 + cont.Width
cont1.Location = New Point(x, Y)
Else
cont.Location = New Point(x, Y)
x = x + 2 + cont.Width
cont1.Location = New Point(x, Y)
End If
Exit For
End If
Next
End Sub
Private Sub dellabel_btn_Click(sender As Object, e As EventArgs) Handles dellabel_btn.Click
If ricLabelGrb_li.Count < 3 Then Return
ricLabel_Grb.Controls.Remove(ricLabelGrb_li.Item(ricLabelGrb_li.Count - 3))
ricLabelGrb_li.RemoveAt(ricLabelGrb_li.Count - 3)
SortLab()
End Sub
Private Sub ToolStripMenuItem7_Click(sender As Object, e As EventArgs) Handles ToolStripMenuItem7.Click, ToolStripMenuItem9.Click, ToolStripMenuItem8.Click
Dim obj As ToolStripMenuItem = sender
ToolStripTextBox1.Text = obj.Text
End Sub
Private Sub ToolStripButton1_Click_2(sender As Object, e As EventArgs) Handles ToolStripButton1.Click
_grdModel.SetLockingState(ToolStripTextBox1.Text.Trim)
End Sub
Private Sub ToolStripButton2_Click(sender As Object, e As EventArgs) Handles ToolStripButton2.Click
UpdateConfigInfo(Now)
Dim tmpStr = "Account = " & _grdModel._ConfigInfo.Author & vbCrLf &
"CfgFileVersion = " & _grdModel._ConfigInfo.CfgFileVersion & vbCrLf &
"ConfigToolVersion = " & _grdModel._ConfigInfo.ConfigToolVersion & vbCrLf &
"HotelName = " & _grdModel._ConfigInfo.HotelName & vbCrLf &
"RoomTypeName = " & _grdModel._ConfigInfo.RoomTypeName & vbCrLf &
"RCU_ModelName = " & _grdModel._RcuModelName & vbCrLf
MsgBox(tmpStr)
End Sub
Private Sub CB_roomName_DropDown(sender As Object, e As EventArgs) Handles CB_roomName.DropDown
CB_roomName.Items.Clear()
Dim selectstr As String = $"SELECT ROOM_OLD_ID, ROOM_NUMBER FROM tbl_room_basic_info WHERE REMARK ='{_project.HotelCode}' and ROOM_TYPE_OLD_ID='{_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID}' "
'Dim delete As String = $"DELETE FROM {tablename} WHERE HotelID ='{HotelID}' and RoomID='{RoomID}'"
Dim dt As DataTable
Using db As New DbExecutor(DbExecutor.DbTypeEnum.Mysql, DbConnString)
db.Open()
dt = db.ExecuteDataTable(selectstr)
If IsNothing(dt) Then Return
For i As Integer = 0 To dt.Rows.Count - 1
CB_roomName.Items.Add($"{dt(i)(0)}:{dt(i)(1)}")
Next
db.Close()
End Using
End Sub
Private Sub Toopbt_Devlist_Click(sender As Object, e As EventArgs) Handles Toopbt_Devlist.Click
Dim devdic As New List(Of Dictionary(Of String, String))
Dim ruleCheckReslut As Boolean
Dim ruleCheck_ErrCnt As Integer = 0
Dim ruleCheck_WarningCnt As Integer = 0
If _grdModel Is Nothing Then
MsgBox($"未选择模型")
Return
End If
ruleCheckReslut = _grdModel.StartGobleRuleCheck(ruleCheck_ErrCnt, ruleCheck_WarningCnt)
'如果规则检查有错误则不允许编译
If ruleCheck_ErrCnt > 0 Then
MsgBox("规则检测不通过,请逐项处理后重新编译!", MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "编译失败..")
Return
Else
_grdModel._compiler.GetXMLdevList(devdic)
End If
Dim strbuff() As String = CB_roomName.Text.Split(":")
tbl_room_ble_devlistInsert(_project.HotelCode, _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID, strbuff(0), "tbl_room_ble_devlist", devdic)
End Sub
#Region "表格编译代码"
''' <summary>
''' 表格交互处理类对象
''' </summary>
Public _TableInteraction As TableInteraction
Private Sub T_OpenfileXML_Click(sender As Object, e As EventArgs) Handles T_OpenfileXML.Click
If IsNothing(_ConfigInfo.Author) Then
MsgBox("Room type not selected")
Return
End If
Dim tmpMsgReslut As MsgBoxResult '弹出消息框的选定值
Try
If _TableInteraction IsNot Nothing Then
If _TableInteraction._isCellChanged = True Then
Dim msgPromopt As String = "The current file has not been saved, please save it and open a new file" & vbCrLf & vbCrLf &
"Yes : Save the file you are currently editing and create a new project。" & vbCrLf &
"No :Do not save the file currently being edited and create a new project。" & vbCrLf &
"Cancel Cancel the current operation and continue editing the current file" & vbCrLf
Dim msgTitle As String = "The current file is not saved"
tmpMsgReslut = MsgBox(msgPromopt, MsgBoxStyle.YesNoCancel + MsgBoxStyle.Critical, "Please save the currently edited file first")
'根据选择结果进行对应的操作
Select Case tmpMsgReslut
Case MsgBoxResult.Yes
'保存操作
If FileExist(g_Xml_FullName) Then
If _grdModel.Save(g_Xml_FullName) = False Then '如果当前文件存在则保存配置文件
MsgBox("Failed to save file! The project you are editing will be returned and saved successfully before creating a new project", vbOKOnly + MsgBoxStyle.Information, "File saving failure")
Return
End If
Else
If (SaveFileAs()) = False Then '如果文件名不存在则启动“另存为”
MsgBox("Failed to save file! The project you are editing will be returned and saved successfully before creating a new project", vbOKOnly + MsgBoxStyle.Information, "File saving failure")
Return
End If
End If
Case MsgBoxResult.No
'不保存,继续新建项目操作
Case MsgBoxResult.Cancel
'不保存,返回继续编辑操作
Return
Case Else
Return
End Select
End If
Else
_TableInteraction = New TableInteraction(CompileSchedule)
If _TableInteraction.Grid Is Nothing Then _TableInteraction.Grid = Table_action
'初始化treeview控件
End If
Dim tmpRcuModelFile As String
Using dlg As New OpenFileDialog
dlg.InitialDirectory = g_DataDir_Path & g_ModelDirEN_Path & "RCUModel\"
'dlg.InitialDirectory = Application.StartupPath & "\RCUModel\"
dlg.Title = "Please select the RCU model file"
dlg.Filter = "RCUModel information(*(Table).xml)|*(Table).xml"
If dlg.ShowDialog <> DialogResult.OK Then Return
tmpRcuModelFile = dlg.FileName
End Using
Try
Dim model As DeviceModel = LoadModelFromXml(tmpRcuModelFile)
'model.HotelName = _project.HotelName
'model.VerdorName = _project.VerdorName
'model.HotelRoomType = TvwMain.SelectedNode.Text
'加载基类
If LoadBasicClass(model.Desc.DevBasicClassFilename) = False Then
Return
End If
'加载条件
If LoadCondiction(model.Desc.DevCondictionFilename) = False Then
Return
End If
_TableInteraction._RcuModelName = model.Desc.Name
_TableInteraction.BasicClassFilename = model.Desc.DevBasicClassFilename
_TableInteraction.ConditionFileName = model.Desc.DevCondictionFilename
_TableInteraction.BasicClasses = _basicClass
_TableInteraction.Condictions = _condictions
_TableInteraction.ConfigInfo = _ConfigInfo
If _TableInteraction.Grid Is Nothing Then _TableInteraction.Grid = Table_action
_TableInteraction.LoadTheHostTable(model)
Catch ex As Exception
MsgBox($"Error loading RCU model{ex.Message}")
End Try
g_Xml_FullName = ""
UpdateWindowTitle()
tsb_UpdateAllResourceList.PerformClick()
tsb_DefaultView.PerformClick()
Dim tmpErrCnt As Integer
Dim tmpWarningCnt As Integer
_grdModel.StartGobleRuleCheck(tmpErrCnt, tmpWarningCnt)
_grdModel.CreateErrHightTimer(True)
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "New file error")
End Try
End Sub
Private Sub ToolStripButton7_Click(sender As Object, e As EventArgs) Handles ToolStripButton7.Click
If FileExist(g_Xml_FullName) Then
If _TableInteraction.Save(g_Xml_FullName) Then
MsgBox($"保存成功!{g_Xml_FullName}")
End If '保存配置文件
Else
SaveFileAsBlv()
'ToolStripButton12_Click(Nothing Nothing)
End If
' 编译成功后弹窗
TableInteractionprojectCompile("", True)
End Sub
Public Function TableInteractionprojectCompile(Optional savePath As String = "",
Optional ByVal IsShowCompileResult As Boolean = False,
Optional ByVal ifCfgVerPlusPlus As Boolean = False
Optional ByVal dic As List(Of Dictionary(Of String String)) = Nothing) As Boolean
If String.IsNullOrEmpty(savePath) Then
savePath = g_Xml_FullName
End If
If IsNothing_TableInteraction Then
MsgBox($"Unselected model")
Return False
End If
Dim tmpReleasedDateTime As Date = DateAndTime.Now
If UpdateConfigInfo(tmpReleasedDateTime, ifCfgVerPlusPlus) = False Then
MsgBox($"Configuration refresh failure")
Return False
End If
'Try
'生成文件夹
If CreateXmlPath() Then
If _TableInteraction.CheckGridData Then
'填充配置信息
'_grdModel._ConfigInf
If _TableInteraction.TableCompiletoByte(savePath, True) = True Then
_TableInteraction.Save(savePath) '保存配置文件
If IsShowCompileResult Then MsgBox($"Compile complete Configuration version number" & _TableInteraction.ConfigInfo.CfgFileVersion)
Return True
Else
MsgBox("Compilation failure", MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "Compilation failure.")
Return False
End If
Else
MsgBox("If the rule check fails, process the rule item by item and recompile it", MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "Compilation failure..")
Return False
End If
Else
MsgBox("Compilation failure", MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "Failed to create the project file..")
Return False
End If
'Catch ex As Exception
' MsgBox($"编译失败,{ex.Message}")
' Return False
'End Try
End Function
Public Function fulijisuanqi()
Dim ager As Integer = 20000
Dim addr As Integer = 3000
Dim yuer As Integer = 60
Dim sun As Integer = 0
For i = 1 To yuer
sun = (ager * 0.12) + ager + addr
ager = sun
Console.WriteLine($"key{i}___Val:{ager}")
Next
End Function
Private Sub ToolStripButton14_Click(sender As Object, e As EventArgs) Handles ToolStripButton14.Click
' fulijisuanqi()
If IsNothing_TableInteraction Then Return
_TableInteraction.AddSceneLine()
End Sub
Private Sub ToolStripButton16_Click(sender As Object, e As EventArgs) Handles ToolStripButton16.Click
If IsNothing_TableInteraction Then Return
Dim Dirpath As String = g_DataDir_Path & g_ModelDirEN_Path & "485Model\"
' Dim Dirpath As String = "C:\Users\Administrator\Desktop\微信临时文件\WeChat Files\wxid_a2psdqznmt8y22\FileStorage\File\2023-03\设备类别"
_TableInteraction.AddToTableDevMode(Dirpath)
End Sub
Private Sub Tablet_DeleteRow_Click(sender As Object, e As EventArgs) Handles Tablet_DeleteRow.Click
If IsNothing_TableInteraction Then Return
_TableInteraction.SelectRowNode()
End Sub
Private Sub ToolStripButton3_Click(sender As Object, e As EventArgs) Handles ToolStripButton3.Click
If IsNothing_TableInteraction Then Return
_TableInteraction.LaunchService()
End Sub
Private Sub ToolStripMenuItem16_Click(sender As Object, e As EventArgs) Handles ToolStripMenuItem16.Click
If IsNothing_TableInteraction Then Return
_TableInteraction.CopySceneActionData()
End Sub
Private Sub ToolStripMenuItem17_Click(sender As Object, e As EventArgs) Handles ToolStripMenuItem17.Click
If IsNothing_TableInteraction Then Return
_TableInteraction.GlueSceneActionData()
End Sub
Private Sub ToolStripButton11_Click(sender As Object, e As EventArgs) Handles ToolStripButton11.Click
If IsNothing_TableInteraction Then Return
If FileExist(g_Xml_FullName) Then
If _TableInteraction.Save(g_Xml_FullName) Then
MsgBox($"Save successfully{g_Xml_FullName}")
End If '保存配置文件
Else
ToolStripButton12_Click(Nothing Nothing)
End If
End Sub
Private Sub ToolStripButton10_Click(sender As Object, e As EventArgs) Handles ToolStripButton10.Click
Dim tmpMsgReslut As MsgBoxResult '弹出消息框的选定值
Me.Cursor = System.Windows.Forms.Cursors.WaitCursor '光标变成漏斗状
Try
If IsNothing_TableInteraction Then
_TableInteraction = New TableInteraction(CompileSchedule)
If _TableInteraction.Grid Is Nothing Then _TableInteraction.Grid = Table_action
Else
If _TableInteraction._isCellChanged = True Then
Dim msgPromopt As String = "The current file has not been saved, please save it and open a new file" & vbCrLf & vbCrLf &
"Yes : Save the file you are currently editing and create a new project。" & vbCrLf &
"No :Do not save the file currently being edited and create a new project。" & vbCrLf &
"Cancel Cancel the current operation and continue editing the current file" & vbCrLf
Dim msgTitle As String = "当前文件尚未保存"
tmpMsgReslut = MsgBox(msgPromopt, MsgBoxStyle.YesNoCancel + MsgBoxStyle.Critical, "请先保存当前编辑的文件!")
'根据选择结果进行对应的操作
Select Case tmpMsgReslut
Case MsgBoxResult.Yes
'保存操作
If FileExist(g_Xml_FullName) Then
If _TableInteraction.Save(g_Xml_FullName) = False Then '如果当前文件存在则保存配置文件
MsgBox("保存文件失败!将返回正在编辑的项目,保存成功后再打开项目!", vbOKOnly + MsgBoxStyle.Information, "文件保存失败")
Return
End If
Else
'If (SaveFileAs()) = False Then '如果文件名不存在则启动“另存为”
' MsgBox("保存文件失败!将返回正在编辑的项目,保存成功后再打开项目!", vbOKOnly + MsgBoxStyle.Information, "文件保存失败")
' Return
'End If
End If
Case MsgBoxResult.No
'不保存,继续新建项目操作
Case MsgBoxResult.Cancel
'不保存,返回继续编辑操作
Return
Case Else
Return
End Select
End If
End If
Using openFileDialog As New OpenFileDialog
Dim tmpInitDir As String = g_DataDir_Path & g_ConfigDir_Path
openFileDialog.InitialDirectory = tmpInitDir
openFileDialog.RestoreDirectory = True
openFileDialog.Title = "打开文件"
openFileDialog.Filter = $"配置文件(*.blv)|*.blv"
If openFileDialog.ShowDialog() = DialogResult.OK Then
g_Xml_Name = openFileDialog.SafeFileName
g_Xml_FullName = openFileDialog.FileName
If _TableInteraction.LoadFile(g_Xml_FullName) = False Then g_Xml_FullName = ""
Dim tmpBasicClassFilename As String = _TableInteraction.BasicClassFilename
If LoadBasicClass(tmpBasicClassFilename) = False Then Return
Dim tmpCondictionFilename As String = _TableInteraction.ConditionFileName
If LoadCondiction(tmpCondictionFilename) = False Then Return
_TableInteraction.BasicClasses = _basicClass
_TableInteraction.Condictions = _condictions
_TableInteraction.ConfigInfo = _ConfigInfo
End If
End Using
UpdateWindowTitle()
Me.Cursor = System.Windows.Forms.Cursors.Default '光标恢复正常
Catch ex As Exception
Me.Cursor = System.Windows.Forms.Cursors.Default '光标恢复正常
End Try
End Sub
Private Sub ToolStripButton12_Click(sender As Object, e As EventArgs) Handles ToolStripButton12.Click
Using saveFileDialog As New SaveFileDialog
Dim tmpXmlFullName As String = ""
Dim tmpInitDir As String = g_DataDir_Path & g_ConfigDir_Path
With saveFileDialog
.InitialDirectory = tmpInitDir
.RestoreDirectory = True
.OverwritePrompt = True
.AddExtension = True
.DefaultExt = ".xml"
.Title = "保存文件"
.Filter = $"配置文件(*.blv)|*.blv"
End With
If saveFileDialog.ShowDialog() = DialogResult.OK Then
'g_Xml_Name = saveFileDialog.SafeFileName
g_Xml_FullName = saveFileDialog.FileName
If _TableInteraction.Save(g_Xml_FullName) Then
UpdateWindowTitle()
MsgBox($"保存成功!{g_Xml_FullName}")
End If
End If
End Using
End Sub
Private Sub ToolStripButton9_Click(sender As Object, e As EventArgs) Handles ToolStripButton9.Click
If Releaseflag And Not IsNothing(TvwMain.SelectedNode) Then
Releaseflag = False
Dim tmpModifiedTime As Date = DateAndTime.Now
Dim strModifiedTime As String = Format(tmpModifiedTime, "yyMMddHHmmss") ' yyyyMMddHHmmss
'更新Model信息
'_grdModel.HotelName = _project.HotelName
'_grdModel.VerdorName = _project.VerdorName
'_grdModel.HotelRoomType = TvwMain.SelectedNode.Text
'配置文件保存地址
Dim tmpPath As String = g_ConfigDir_Path _
& _project.VerdorName & "\" _
& _project.HotelCode & "-" _
& _project.HotelName
''文件名
Dim cfgVer As Integer = Integer.Parse(_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_CfgCurrVer)
Dim newcfgVer As Integer = cfgVer + 1
Dim tmpXmlName = newcfgVer & "_Config-" &
_project.HotelCode & "-" &
_project.HotelName & "-" &
_project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_Name & "-" &
strModifiedTime & ".blv"
Dim tmp_Local_XmlFullName As String = g_DataDir_Path & tmpPath & "\" & tmpXmlName
Dim devdic As New List(Of Dictionary(Of String, String))
'If projectCompile(tmp_Local_XmlFullName, False, True, devdic) Then
If TableInteractionprojectCompile(tmp_Local_XmlFullName, False, True, devdic) Then
'取当前时间
ReleaseConfigBLVToDB(tmpPath, tmpXmlName, cfgVer, newcfgVer, devdic)
Else
End If
Releaseflag = True
Else
MsgBox("请选择发布节点")
End If
End Sub
Private Sub ToolStripButton13_Click(sender As Object, e As EventArgs) Handles ToolStripButton13.Click
If IsNothing_TableInteraction Then Return
Using saveFileDialog As New SaveFileDialog
Dim tmpXmlFullName As String = ""
Dim tmpInitDir As String = g_DataDir_Path & g_ConfigDir_Path
With saveFileDialog
.InitialDirectory = tmpInitDir
.RestoreDirectory = True
.OverwritePrompt = True
.AddExtension = True
.DefaultExt = ".xls"
.Title = "Save file"
.Filter = $"Configuration file(*.xls)|*.xls"
End With
If saveFileDialog.ShowDialog() = DialogResult.OK Then
'g_Xml_Name = saveFileDialog.SafeFileName
If _TableInteraction.SaveToExle(saveFileDialog.FileName) Then
MsgBox($"Export successfully{saveFileDialog.FileName}")
End If
End If
End Using
End Sub
#End Region
' Public Function GetStringMd5(str As String) As String
' Dim md5Hasher As New MD5CryptoServiceProvider()
' Dim data As Byte() = md5Hasher.ComputeHash(Encoding.UTF8.GetBytes(str))
' Dim fileMd5 As New StringBuilder()
' Dim i As Integer
' For i = 0 To data.Length - 1
' fileMd5.Append(data(i).ToString("X2"))
' Next
' Return fileMd5.ToString()
'End Function
#End Region
#End Region
#Region "逻辑表配置代码"
#End Region
End Class
<Serializable>
Public Class DemoClass
Public Name As String
Public Age As String
Public Room As RoomType
Sub New()
Name = "N"
Age = "A"
Room = New RoomType
Room.HotelID = 1
Room.RoomType = 2
Room.XmlFile = 3
Room.BinFile = 4
Room.BinFileMd5 = 5
End Sub
Public Overrides Function ToString() As String
Return $"Name:{Name},Age:{Age},HID:{Room.HotelID},HT:{Room.RoomType}"
End Function
End Class
<Serializable>
Public Class RoomType
Public Property HotelID As String
Public Property HotelCode As String
Public Property RoomType As String
Public Property RoomTypeIdx As String
Public Property XmlFile As String
Public Property BinFile As String
Public Property BinFileMd5 As String
Public Property CfgCurrVer As String
Public Property PassWord As String
Public Property CfgVersion As String
Public Property App_Cfg_For_L2 As String
Public Property App_Cfg_For_L4 As String
Public Property IsDel As String
Public Property APP_Type As String
' Public Property RoomType_OldID As String
End Class