Imports System.Security.Cryptography Imports System.Text Imports Microsoft.Win32 Imports Microsoft.Win32.Registry Imports System.Management Public Class Form1 Private Sub BTn_Read_Click(sender As Object, e As EventArgs) Handles BTn_Read.Click GetRegistDataToUI() End Sub Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load BTn_Read.PerformClick() End Sub Public Sub GetRegistDataToUI() 'AUTS Dim Root As String = $"software\AUTS" If IsNothing(LocalMachine.OpenSubKey(Root)) Then MsgBox("未找到目标注册列表") Return End If 'AUTS txt_auts_mr.Text = GetRegistData(Root, "") txt_auts_BN.Text = GetRegistData(Root, "BarnchNet") txt_auts_Dh.Text = GetRegistData(Root, "DbHost") txt_auts_Fh.Text = GetRegistData(Root, "FtpHost") txt_auts_P.Text = GetRegistData(Root, "Path") txt_auts_R.Text = GetRegistData(Root, "Roles") 'AUTS_DataService Root = $"software\AUTS\AUTS_DataService" txt_auts_D_mr.Text = GetRegistData(Root, "") txt_auts_D_A.Text = GetRegistData(Root, "Alias") txt_auts_D_I.Text = GetRegistData(Root, "Index") txt_auts_D_N.Text = GetRegistData(Root, "Name") txt_auts_D_P.Text = GetRegistData(Root, "Port") txt_auts_D_V.Text = GetRegistData(Root, "Version") Root = $"software\AUTS\AUTS_UpdateService" txt_auts_U_mr.Text = GetRegistData(Root, "") txt_auts_U_N.Text = GetRegistData(Root, "Name") txt_auts_U_V.Text = GetRegistData(Root, "Version") Root = $"software\AUTS\License" txt_Li_mr.Text = GetRegistData(Root, "") txt_Li_N.Text = GetRegistData(Root, "Name") Root = $"software\AUTS\LocalDb" txt_L_mr.Text = GetRegistData(Root, "") tb_ProcessorID.Text = GetProcessorId() End Sub Public Function GetRegistData(keypath As String, keyval As String) As String Try Dim regkey As RegistryKey = Registry.LocalMachine.OpenSubKey(keypath) If IsNothing(regkey.GetValue(keyval)) Then Return "" End If Dim result As String = regkey.GetValue(keyval).ToString ' Dim s() As String = regkey.GetValueNames Return result Catch ex As Exception Return String.Empty End Try End Function Private Sub Btn_write_Click(sender As Object, e As EventArgs) Handles Btn_write.Click Dim Root As String = $"software\AUTS" If IsNothing(LocalMachine.OpenSubKey(Root)) Then MsgBox("未找到目标注册列表") Return End If 'AUTS If IsNothing(LocalMachine.OpenSubKey(Root)) Then MsgBox("未找到目标注册列表") Return End If 'AUTS SetRegistData(Root, "", txt_auts_mr.Text) SetRegistData(Root, "BarnchNet", txt_auts_BN.Text) SetRegistData(Root, "DbHost", txt_auts_Dh.Text) SetRegistData(Root, "FtpHost", txt_auts_Fh.Text) SetRegistData(Root, "Path", txt_auts_P.Text) SetRegistData(Root, "Roles", txt_auts_R.Text) 'AUTS_DataService Root = $"software\AUTS\AUTS_DataService" SetRegistData(Root, "", txt_auts_D_mr.Text) SetRegistData(Root, "Alias", txt_auts_D_A.Text) SetRegistData(Root, "Index", txt_auts_D_I.Text) SetRegistData(Root, "Name", txt_auts_D_N.Text) SetRegistData(Root, "Port", txt_auts_D_P.Text) SetRegistData(Root, "Version", txt_auts_D_V.Text) Root = $"software\AUTS\AUTS_UpdateService" SetRegistData(Root, "", txt_auts_U_mr.Text) SetRegistData(Root, "Name", txt_auts_U_N.Text) SetRegistData(Root, "Version", txt_auts_U_V.Text) Root = $"software\AUTS\License" SetRegistData(Root, "", txt_Li_mr.Text) SetRegistData(Root, "Name", txt_Li_N.Text) Root = $"software\AUTS\LocalDb" SetRegistData(Root, "", txt_L_mr.Text) Ric_1.SelectionStart = Ric_1.TextLength Dim at As String = $"数据读取成功{vbCrLf}" Ric_1.SelectionLength = at.Length Ric_1.SelectionColor = Color.LawnGreen End Sub Public Sub SetRegistData(keypath As String, name As String, keyval As String) Dim at As String = $"{keypath}\{name} 设置成功,keyval:{keyval}{vbCrLf}" If String.IsNullOrEmpty(keyval) Then Return Ric_1.SelectionStart = Ric_1.TextLength Try Dim regkey As RegistryKey = Registry.LocalMachine.CreateSubKey(keypath) 'Dim regkey As RegistryKey = Registry.LocalMachine.OpenSubKey(keypath) regkey.SetValue(name, keyval) Registry.LocalMachine.Flush() Ric_1.AppendText(at) Ric_1.SelectionLength = at.Length Ric_1.SelectionColor = Color.LawnGreen Catch ex As Exception at = $"{keypath}\{name} 设置失败,keyval:{keyval}{vbCrLf}" Ric_1.AppendText(at) Ric_1.SelectionLength = at.Length Ric_1.SelectionColor = Color.Red End Try Try Catch ex As Exception End Try End Sub Private Sub Ric_1_TextChanged(sender As Object, e As EventArgs) Handles Ric_1.TextChanged If Ric_1.TextLength > 1000 Then Ric_1.SelectionStart = 800 Ric_1.SelectionLength = Ric_1.TextLength - 800 Ric_1.Copy() Ric_1.Paste() End If Ric_1.SelectionStart = Ric_1.TextLength Ric_1.ScrollToCaret() End Sub Private Function GetProcessorId() As String Dim Wmis As New System.Management.ManagementObjectSearcher("SELECT * FROM Win32_Processor") Dim pid As String = "" For Each WmiObj As ManagementObject In Wmis.Get pid = CStr(WmiObj("ProcessorId")).ToUpper Exit For Next Return pid End Function End Class