Imports System.IO Imports System.Security.Cryptography Imports System.Text Imports System.Threading Imports BLV_Studio.GridModel Imports BLV_Studio.GridModel.DeviceEventModel Imports BLV_Studio.UTSModule Public Class FrmMain ''' ''' 配置信息,这些信息将会被编译到配置文件的0x01数据块 ''' Dim _ConfigInfo As ConfigInfoStuct ''' ''' 项目信息 ''' Public _project As ProjectInfo ''' ''' 模型表格 ''' Private _grdModel As GridModel.DeviceEventModel ''' ''' 账号 ''' Public Property Account As String ''' ''' 账号权限 ''' Public Property AccountAuth As AccountAuth ''' ''' 基类信息 ''' Private _basicClass As DeviceObjectClasses ''' ''' 条件信息 ''' Private _condictions As ConfigActionConcitons ''' ''' 当前编辑的酒店房型 node index,等同于在 _project.RoomType list列表中的位置 ''' Private g_CurrentTreeNodeRoomTypeItemIndex As Integer = 0 ''' ''' 根据酒店组+酒店ID+酒店名称 确定XML文件存放目录 ''' Public g_Xml_FullPath_BasedOnTempFolder As String ''' ''' 主文件夹路径 ''' Public g_DataDir_Path As String = Application.StartupPath.Substring(0, Application.StartupPath.IndexOf("\")) & "\BLV_Studio" ''' ''' 模型文件夹名称 ''' Public g_ModelDir_Path As String = "\Data\Model\" ''' ''' 配置文件夹名称 ''' Public g_ConfigDir_Path As String = "\Data\Config\" ''' ''' 固件文件夹名称 ''' Public g_Firmware_Path As String = "\Data\Firmware\" ''' ''' XML 临时文件文件名 ''' 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) Me.Invoke(dev, ftpFlag) Else Select Case ftpFlag Case 0 FtpIcon_lab.Image = ImgLstMain.Images.Item(ImgLstMain.Images.IndexOfKey(“Syncing.png”)) Case 1 FtpIcon_lab.Image = ImgLstMain.Images.Item(ImgLstMain.Images.IndexOfKey(“Syncerror.png”)) Case 2 FtpIcon_lab.Image = ImgLstMain.Images.Item(ImgLstMain.Images.IndexOfKey(“SyncTrue.png”)) 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 '未处理的异常捕捉 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 '读取项目信息 '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() '同步文件 _blvSync = New blvFtpServer(g_DataDir_Path & g_ModelDir_Path, DbConnString) 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 ''' ''' 刷新编辑表 ''' 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 Private Sub TsmiChangeUser_Click(sender As Object, e As EventArgs) Handles TsmiChangeUser.Click Dim frm As New FrmLogin 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 XmlSerializer.DeserializeFormXml(Of DeviceModel)(path) End Function Public Sub SaveModelToXml(path As String, model As DeviceModel) XmlSerializer.SerializeToXml(path, model) End Sub Public Sub SaveProjectToXml(fullFileName As String, project As ProjectInfo) XmlSerializer.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 TsBtnChangeProject.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 ''' ''' '检测酒店发布权限,并载入酒店节点 ''' 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 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 ''' ''' 获取权限ID 对应权限 ''' ''' 酒店权限集合 ''' 权限ID ''' 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 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 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 = "当前文件尚未保存,请保存后再打开新的文件!" & vbCrLf & vbCrLf & "Yes : 保存当前编辑中的文件,然后打开一个项目。" & vbCrLf & "No :不保存当前编辑中的文件,然后打开一个项目。" & vbCrLf & "Cancel: 取消当前操作,继续编辑当前文件" & 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 = "当前文件尚未保存,请保存后再打开新的文件!" & vbCrLf & vbCrLf & "Yes : 保存当前编辑中的文件,然后新建一个项目。" & vbCrLf & "No :不保存当前编辑中的文件,然后新建一个项目。" & vbCrLf & "Cancel: 取消当前操作,继续编辑当前文件" & 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_ModelDir_Path & "BaseModel\" & xmlFileName _condictions = XmlSerializer.DeserializeFormXml(Of ConfigActionConcitons)(tmpCondictionClassFilename) Catch ex As Exception MsgBox($"加载条件文件失败!{ex.Message}") Return False End Try Return True End Function Private Function LoadBasicClass(xmlFileName As String) As Boolean Try '根据XML文件格式确定的基类 Dim tmpBasicClassFilename = g_DataDir_Path & g_ModelDir_Path & "BaseModel\" & xmlFileName _basicClass = XmlSerializer.DeserializeFormXml(Of DeviceObjectClasses)(tmpBasicClassFilename) Catch ex As Exception 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 = "请确认发布项目和房型:" & vbCrLf & vbCrLf & vbCrLf & "项目分组 : " & _project.VerdorName & vbCrLf & "项目编号 : " & _project.HotelCode & vbCrLf & "项目名称 : " & _project.HotelName & vbCrLf & "房 型 : " & _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_Name & vbCrLf & "房型ID : " & _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID & vbCrLf & vbCrLf & "配置文件名 : " & tmpXmlName & vbCrLf & vbCrLf & "版本号 : " & 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($"发布密码错误") 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("上传文件错误!") 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($"发布完成") 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 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 ''' ''' 刷新配置文件信息,这些信息将会被编译到配置文件的0x01数据块 ''' 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 '复制到类变量,供编译时调用 Catch ex As Exception MsgBox("未指定项目名称和房型时,无法编译!", MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "未指定项目名称或房型!") 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 #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 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 Catch ex As Exception Return False End Try Return True End Function #End Region #Region "文件和目录操作" 'FTP地址:'blv-oa.com '账号:BLV_Studio 'pw:37f5675t6R&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 '弹出消息框的选定值 If _grdModel._isCellChanged = True Then Dim msgPromopt As String = "当前文件尚未保存,请确认是否保存后再关闭程序!" & vbCrLf & vbCrLf & "Yes : 保存当前编辑中的文件,然后关闭程序。" & vbCrLf & "No :不保存当前编辑中的文件,然后关闭程序。" & vbCrLf & "Cancel: 取消当前操作,继续编辑当前文件" & 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 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) Handles tsb_SyncConfigFiles.Click '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 TreeViewEventArgs(TvwMain.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") Then Return Dim tmpRoomTypeNodeIdx As Integer = 0 Dim tmpXmlFullName As String = "" If _grdModel._isCellChanged = True Then MsgBox("当前文件尚未保存,请保存后再打开新的文件!", MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "请先保存当前编辑的文件!") Return End If '文件名 '配置文件保存地址 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 VHFromDownFile(roomsqlrow) 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 VHFromDownFile(roomsqlrow) 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() 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) VHFromDownFile(roomsqlrow) 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 ''' ''' 单文件下载 ''' ''' 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 UpdateFileLatest(DownFile, 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() UpdateFileLatest(DownFile, 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 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 = "请确认发布项目和房型:" & vbCrLf & vbCrLf & vbCrLf & "项目分组 : " & _project.VerdorName & vbCrLf & "项目编号 : " & _project.HotelCode & vbCrLf & "项目名称 : " & _project.HotelName & vbCrLf & "房 型 : " & _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_Name & vbCrLf & "房型ID : " & _project.RoomType(g_CurrentTreeNodeRoomTypeItemIndex).structRoomType_ID & vbCrLf & vbCrLf & "配置文件名 : " & tmpXmlName & vbCrLf & vbCrLf & "版本号 : " & 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($"发布密码错误") 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 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 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()) 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 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 ''' ''' 固件上传 ''' ''' ''' 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 firmwareIsFtpUpload2(dic, tmpPath, uploadfile) And firmwareIsFtpUpload2(dicv4, 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 Return False Else End If End If If insertClunm.ContainsKey("FileName") Then idt = db.ExecuteDataTable(db.CmdHelper.Insert("tbl_firmware_upload_logs", insertClunm)) Else Return True End If db.Close() End Using If IsNothing(idt) Then Return False Else Return True End If 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 IsNothing(FileRow) Then Return For index As Integer = 0 To FileRow.Count - 1 EventITable_tbl.AddItem("") Dim dic = FileRow(index) 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)), CInt(tc(2)), CInt(tc(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 IsNothing(EventITable_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 "表格编译代码" ''' ''' 表格交互处理类对象 ''' Public _TableInteraction As TableInteraction Private Sub T_OpenfileXML_Click(sender As Object, e As EventArgs) Handles T_OpenfileXML.Click Dim tmpMsgReslut As MsgBoxResult '弹出消息框的选定值 Try If _TableInteraction IsNot Nothing Then If _TableInteraction._isCellChanged = True Then Dim msgPromopt As String = "当前文件尚未保存,请保存后再打开新的文件!" & vbCrLf & vbCrLf & "Yes : 保存当前编辑中的文件,然后新建一个项目。" & vbCrLf & "No :不保存当前编辑中的文件,然后新建一个项目。" & vbCrLf & "Cancel: 取消当前操作,继续编辑当前文件" & 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 _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_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 _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($"加载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 Sub ToolStripButton7_Click(sender As Object, e As EventArgs) Handles ToolStripButton7.Click _TableInteraction.TableCompiletoByte() 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 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 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 APP_Type As String ' Public Property RoomType_OldID As String End Class