2020 lines
83 KiB
VB.net
2020 lines
83 KiB
VB.net
Imports System.IO
|
||
Imports System.Net
|
||
Imports System.Runtime.InteropServices
|
||
Imports System.Security.AccessControl
|
||
Imports System.Security.Principal
|
||
Imports Microsoft.Win32
|
||
Imports System.Text
|
||
Imports System.Threading
|
||
Imports System.Net.NetworkInformation
|
||
Imports System.Net.Http
|
||
Imports System.Web.Script.Serialization
|
||
Imports System.Reflection
|
||
|
||
Public Class Form1
|
||
Dim 是否断网 As Boolean = False
|
||
Dim 全局变量_BIOS识别码 As String = ""
|
||
Dim 全局变量_异常密码 As String = "009988"
|
||
'api接口地址 '
|
||
Dim ApiEndPoint As String = "http://api.systemcd.org/api/v1"
|
||
Dim 全局变量_id As String = ""
|
||
Dim 全局变量_心跳时间 As String = ""
|
||
Dim 全局变量_关键字心跳时间 As String = ""
|
||
Dim 全局变量_进程限制 As Integer = 2
|
||
Dim 全局变量_应用限制 As Integer = 2
|
||
Dim 全局变量_关键字采集 As Integer = 2 '关键字采集 1开启 2-关闭 默认关闭'
|
||
Dim 全局变量_拦截记录间隔 As Double = 1 '进程拦截记录间隔（小时）'
|
||
Dim 全局变量_采集的文本 As List(Of KeywordItemReq) = New List(Of KeywordItemReq) '已采集的违规文本'
|
||
Dim 全局变量_程序版本 As String = ""
|
||
'忽略的特殊字符'
|
||
Dim ignoreChars As New HashSet(Of Char)({" ", vbCrLf, "，", "。", "：", "【", "】", "？", "；", ",", ".", "!", "@", "#", "$", "%", "^", "&", "*", "(", ")", "-", "_", "+", "=", "`", "~", "[", "]", "{", "}", "\", "|", ";", ":", "’", "‘", "'", """", "<", ">", "/", "?"})
|
||
|
||
Dim 全局变量_已拦截进程 As Dictionary(Of String, DateTime) = New Dictionary(Of String, Date)
|
||
Public 全局变量_关键字 As KeywordItem = New KeywordItem
|
||
|
||
'http请求对象'
|
||
Dim client As New HttpClient()
|
||
'序列化对象'
|
||
Dim serializer As New JavaScriptSerializer()
|
||
|
||
Private Const HWND_BROADCAST As Integer = &HFFFF
|
||
Private Const WM_SETTINGCHANGE As Integer = &H1A
|
||
Private Const SMTO_NORMAL As UInteger = &H0
|
||
|
||
Private promptLoopTask As Task = Nothing
|
||
Private promptLoopStarted As Boolean = False
|
||
Private promptLoopLock As New Object() ' 用于线程同步
|
||
Private keywordLoopLock As New Object() '关键词task线程同步'
|
||
|
||
'允许进程列表'
|
||
Private allowedProcesses As New HashSet(Of String)(StringComparer.OrdinalIgnoreCase)
|
||
'组策略允许列表'
|
||
Private allGroupApplication As New HashSet(Of String)(StringComparer.OrdinalIgnoreCase)
|
||
|
||
'用于存储定时任务的 Task
|
||
Private monitorTask As Task
|
||
'关键词定时同步 Task'
|
||
Private keywordMonitorTask As Task
|
||
'用于控制定时任务的取消'
|
||
Private monitorCancellationTokenSource As New CancellationTokenSource()
|
||
'关键字控制定时任务取消'
|
||
Private monitorKeywordCancellationTokenSource As New CancellationTokenSource()
|
||
|
||
'剪切板'
|
||
Private Const WM_CLIPBOARDUPDATE As Integer = &H31D
|
||
'增加剪切板监听'
|
||
<DllImport("user32.dll", SetLastError:=True)>
|
||
Private Shared Function AddClipboardFormatListener(hWnd As IntPtr) As Boolean
|
||
End Function
|
||
|
||
'移除剪切板监听'
|
||
<DllImport("user32.dll", SetLastError:=True)>
|
||
Private Shared Function RemoveClipboardFormatListener(hWnd As IntPtr) As Boolean
|
||
End Function
|
||
|
||
<DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)>
|
||
Private Shared Function MoveFileEx(
|
||
lpExistingFileName As String,
|
||
lpNewFileName As String,
|
||
dwFlags As Integer) As Boolean
|
||
End Function
|
||
|
||
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
|
||
Private Shared Function SendMessageTimeout(
|
||
hWnd As IntPtr,
|
||
Msg As UInteger,
|
||
wParam As IntPtr,
|
||
lParam As String,
|
||
fuFlags As UInteger,
|
||
uTimeout As UInteger,
|
||
ByRef lpdwResult As IntPtr
|
||
) As IntPtr
|
||
End Function
|
||
|
||
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
|
||
Private Shared Function SendNotifyMessage(ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As IntPtr, ByVal lParam As String) As Boolean
|
||
End Function
|
||
|
||
<DllImport("user32.dll", SetLastError:=True)>
|
||
Private Shared Function RegisterHotKey(
|
||
hWnd As IntPtr,
|
||
id As Integer,
|
||
fsModifiers As UInteger,
|
||
vk As UInteger
|
||
) As Boolean
|
||
End Function
|
||
|
||
<DllImport("user32.dll", SetLastError:=True)>
|
||
Private Shared Function UnregisterHotKey(
|
||
hWnd As IntPtr,
|
||
id As Integer
|
||
) As Boolean
|
||
End Function
|
||
|
||
<DllImport("advapi32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)>
|
||
Private Shared Function SetNamedSecurityInfo(
|
||
pObjectName As String,
|
||
objectType As Integer,
|
||
securityInfo As Integer,
|
||
psidOwner As IntPtr,
|
||
psidGroup As IntPtr,
|
||
pDacl As IntPtr,
|
||
pSacl As IntPtr
|
||
) As Integer
|
||
End Function
|
||
|
||
Private Const SE_FILE_OBJECT As Integer = 1
|
||
Private Const OWNER_SECURITY_INFORMATION As Integer = &H1
|
||
Private Const WM_HOTKEY As Integer = &H312
|
||
Private Const MOD_CONTROL As Integer = &H2
|
||
Private Const MOD_ALT As Integer = &H1
|
||
Private Const HOTKEY_ID As Integer = 1
|
||
' 检测当前是否以管理员身份运行
|
||
Private Function IsAdministrator() As Boolean
|
||
Dim identity = WindowsIdentity.GetCurrent()
|
||
Dim principal = New WindowsPrincipal(identity)
|
||
Return principal.IsInRole(WindowsBuiltInRole.Administrator)
|
||
End Function
|
||
Private Sub EnsureElevated()
|
||
If Not IsAdministrator() Then
|
||
Dim psi As New ProcessStartInfo(Application.ExecutablePath) With {
|
||
.Verb = "runas",
|
||
.UseShellExecute = True
|
||
}
|
||
Try
|
||
Process.Start(psi)
|
||
Catch ex As Exception
|
||
MessageBox.Show("需要管理员权限才能继续。", "权限不足", MessageBoxButtons.OK, MessageBoxIcon.Warning)
|
||
End Try
|
||
Application.Exit()
|
||
End If
|
||
End Sub
|
||
Async Function GetSmbiosUuid() As Task(Of String)
|
||
Dim result As String = String.Empty
|
||
|
||
Try
|
||
Dim adapters As NetworkInterface() = NetworkInterface.GetAllNetworkInterfaces()
|
||
|
||
If adapters.Length = 0 Then
|
||
Console.WriteLine("未找到任何网络接口。")
|
||
Return String.Empty
|
||
End If
|
||
For Each adapter As NetworkInterface In adapters
|
||
' 过滤掉 Loopback 和 Tunnel 接口，只关注 Ethernet 接口
|
||
If adapter.NetworkInterfaceType = NetworkInterfaceType.Ethernet Then
|
||
Dim physicalAddress As PhysicalAddress = adapter.GetPhysicalAddress()
|
||
Dim macBytes As Byte() = physicalAddress.GetAddressBytes()
|
||
result = String.Join(":", macBytes.Select(Function(b) b.ToString("X2")))
|
||
|
||
Exit For
|
||
End If
|
||
Next
|
||
|
||
Catch ex As Exception
|
||
' 读取失败时可以日志记录或抛出
|
||
Console.Error.WriteLine("读取 SMBIOS UUID 时发生异常: " & ex.Message)
|
||
End Try
|
||
|
||
Return result
|
||
End Function
|
||
Private Async Sub Form1_Shown(sender As Object, e As EventArgs) Handles Me.Shown
|
||
Dim title As String = $"管理端{全局变量_程序版本}"
|
||
If IsNetworkAvailable() = True Then
|
||
是否断网 = True
|
||
Else
|
||
title = $"管理端{全局变量_程序版本} - 无网络"
|
||
是否断网 = False
|
||
End If
|
||
|
||
Me.Text = title
|
||
'打开时先判断是否有网络
|
||
Await Task.WhenAll(AddStartupEntry())
|
||
|
||
'首先第一步就是获取CPU识别号。
|
||
Await Task.Run(Async Function()
|
||
全局变量_BIOS识别码 = Await GetSmbiosUuid()
|
||
TextBox4.BeginInvoke(Sub()
|
||
TextBox4.Text = 全局变量_BIOS识别码
|
||
End Sub)
|
||
End Function)
|
||
|
||
|
||
Try
|
||
Dim initResult As Boolean = Await InitSetting()
|
||
|
||
If initResult = False Then
|
||
Return
|
||
End If
|
||
|
||
' 隐藏当前窗体并继续后续异步初始化
|
||
If Not 全局变量_id = "" Then
|
||
Me.Hide()
|
||
End If
|
||
|
||
If Not Me.Visible Then
|
||
If 是否断网 = True Then
|
||
Await Task.WhenAll(
|
||
GetRemoteTextAndPopulateAllowedProcesses())
|
||
|
||
Await Task.Run(Async Function()
|
||
Await 日志输出(全局变量_id, "1", 全局变量_BIOS识别码) '打开软件
|
||
End Function)
|
||
Else
|
||
Dim folder As String = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.CommonApplicationData), "Vls")
|
||
Dim filePath1 As String = Path.Combine(folder, "list")
|
||
|
||
' 检查文件是否存在
|
||
If File.Exists(filePath1) Then
|
||
' 逐行读取并加入 HashSet
|
||
For Each rawLine As String In File.ReadLines(filePath1)
|
||
Dim line As String = rawLine.Trim()
|
||
If Not String.IsNullOrEmpty(line) Then
|
||
allowedProcesses.Add(line)
|
||
|
||
TextBox2.BeginInvoke(Sub()
|
||
TextBox2.AppendText(line & vbCrLf)
|
||
End Sub)
|
||
End If
|
||
Next
|
||
|
||
Button5.BeginInvoke(Sub()
|
||
Button5.Enabled = False
|
||
End Sub)
|
||
Button3.BeginInvoke(Sub()
|
||
Button3.Enabled = False
|
||
End Sub)
|
||
|
||
StartMonitorLoop()
|
||
Else
|
||
MessageBox.Show("进程列表不存在，此软件运行不会生效。确定之后将退出。", "Err", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
End If
|
||
|
||
If 全局变量_关键字采集 = 1 Then
|
||
StartKeywordMonitorLoop()
|
||
End If
|
||
|
||
End If
|
||
|
||
StartPromptLoopOnce()
|
||
Else
|
||
Me.Hide()
|
||
End If
|
||
Catch ex As Exception
|
||
MessageBox.Show("读取文件时发生错误: " & ex.Message, "错误", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
End Try
|
||
|
||
End Sub
|
||
|
||
Protected Overrides Sub WndProc(ByRef m As Message)
|
||
MyBase.WndProc(m)
|
||
If m.Msg = WM_HOTKEY AndAlso m.WParam.ToInt32() = HOTKEY_ID Then
|
||
Dim 断网_tmp As Boolean = IsNetworkAvailable()
|
||
If 断网_tmp = False Then
|
||
MessageBox.Show("当前已断网，请输入超级密码进行登陆！", "Err", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
End If
|
||
Using dlg As New PasswordDialog("请输入打开密码：", "权限请求")
|
||
If dlg.ShowDialog(Me) = DialogResult.OK Then
|
||
If 断网_tmp = True Then
|
||
是否断网 = True
|
||
Dim PasswordCode As String = 获取密码() ' 假设这是一个字符串
|
||
Dim input As String = dlg.PasswordText ' 保留为字符串类型
|
||
If input = PasswordCode Then
|
||
Me.Show()
|
||
End If
|
||
Else
|
||
Me.Text = $"管理端{全局变量_程序版本} - 无网络"
|
||
是否断网 = False
|
||
Dim input As String = dlg.PasswordText ' 保留为字符串类型
|
||
If input = 全局变量_异常密码 Then
|
||
Me.Show()
|
||
End If
|
||
End If
|
||
End If
|
||
End Using
|
||
End If
|
||
|
||
Select Case m.Msg
|
||
Case WM_CLIPBOARDUPDATE
|
||
' 获取剪贴板中的文本内容
|
||
If 全局变量_关键字采集 = 1 AndAlso Clipboard.ContainsText() Then
|
||
Dim clipboardText As String = Clipboard.GetText()
|
||
If Not clipboardText = "" Then
|
||
Task.Run(Async Function()
|
||
Await JudgeKeywords(clipboardText)
|
||
End Function)
|
||
End If
|
||
End If
|
||
End Select
|
||
End Sub
|
||
Public Function 获取密码() As String
|
||
Dim result As String = ""
|
||
|
||
Try
|
||
' 设置请求的URL
|
||
Dim url As String = $"{ApiEndPoint}/mm-machine/getPassword" ' 请替换为你实际的接口地址
|
||
'使用TLS12安全协议连接
|
||
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
|
||
' 创建 HttpWebRequest 对象
|
||
Dim request As HttpWebRequest = CType(WebRequest.Create(url), HttpWebRequest)
|
||
|
||
' 设置请求方法为 GET
|
||
request.Method = "GET"
|
||
request.Proxy = Nothing
|
||
' 发送请求并获取响应
|
||
Dim response As WebResponse = request.GetResponse()
|
||
|
||
' 读取响应流并获取内容
|
||
Using reader As New StreamReader(response.GetResponseStream())
|
||
result = reader.ReadToEnd()
|
||
End Using
|
||
|
||
Catch ex As Exception
|
||
result = 全局变量_异常密码
|
||
End Try
|
||
|
||
Return result
|
||
End Function
|
||
Private Async Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
|
||
Dim result As DialogResult = MessageBox.Show("确定要退出吗？", "确认退出", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
|
||
|
||
' 如果用户选择“否”，则取消关闭操作
|
||
If result = DialogResult.No Then
|
||
e.Cancel = True
|
||
Else
|
||
If IsNetworkAvailable() = True Then
|
||
'如果有网络，那么执行日志输出错误，避免出错
|
||
Await Task.Run(Async Function()
|
||
Await 日志输出(全局变量_id, "4", 全局变量_BIOS识别码) '退出软件
|
||
End Function)
|
||
End If
|
||
|
||
UnregisterHotKey(Me.Handle, HOTKEY_ID)
|
||
End
|
||
End If
|
||
|
||
RemoveClipboardFormatListener(Me.Handle)
|
||
End Sub
|
||
|
||
''' <summary>
|
||
''' 定时任务
|
||
''' </summary>
|
||
''' <returns></returns>
|
||
Private Async Function MonitorLoopAsync(cc As Int64, cancellationToken As CancellationToken) As Task
|
||
Do
|
||
'Logger.Info($"循环中2 {cc}")
|
||
Dim isNetworkAvailableLocal As Boolean = IsNetworkAvailable()
|
||
Dim limitText As String = ""
|
||
|
||
If 全局变量_进程限制 = 1 Then
|
||
limitText = "已应用"
|
||
Else
|
||
limitText = "未应用"
|
||
End If
|
||
|
||
lbl_taskLimit.BeginInvoke(Sub()
|
||
lbl_taskLimit.Text = limitText
|
||
End Sub)
|
||
If IsNetworkAvailable() = True Then
|
||
是否断网 = True
|
||
Else
|
||
Me.BeginInvoke(Sub()
|
||
Me.Text = $"管理端 - 无网络"
|
||
End Sub)
|
||
是否断网 = False
|
||
End If
|
||
|
||
|
||
If 是否断网 = True And 全局变量_进程限制 <> 2 Then
|
||
Dim 是否调试 As Boolean = CheckBox1.Checked
|
||
Try
|
||
For Each proc As Process In Process.GetProcesses()
|
||
If Not JudeProcessName(proc.ProcessName) Then
|
||
Try
|
||
If 是否调试 = True Then
|
||
ListBox1.BeginInvoke(Sub()
|
||
ListBox1.Items.Add(proc.ProcessName)
|
||
End Sub)
|
||
End If
|
||
|
||
If JudgeTimeInterval(proc.ProcessName) Then
|
||
Await Task.Run(Async Function()
|
||
Await 日志输出(全局变量_id, "6", 全局变量_BIOS识别码, proc.ProcessName) '拦截进程
|
||
End Function)
|
||
End If
|
||
|
||
If 全局变量_进程限制 = 1 Then
|
||
proc.Kill()
|
||
End If
|
||
Catch
|
||
End Try
|
||
End If
|
||
Next
|
||
Catch
|
||
|
||
End Try
|
||
ElseIf 全局变量_进程限制 <> 2 Then
|
||
Dim 是否调试 As Boolean = CheckBox1.Checked
|
||
Try
|
||
For Each proc As Process In Process.GetProcesses()
|
||
If Not JudeProcessName(proc.ProcessName) Then
|
||
Try
|
||
If 是否调试 = True Then
|
||
ListBox1.BeginInvoke(Sub()
|
||
ListBox1.Items.Add(proc.ProcessName)
|
||
End Sub)
|
||
End If
|
||
If 全局变量_进程限制 = 1 Then
|
||
proc.Kill()
|
||
End If
|
||
Catch
|
||
End Try
|
||
End If
|
||
Next
|
||
Catch
|
||
End Try
|
||
End If
|
||
|
||
Try
|
||
Await Task.Delay(500, cancellationToken) ' 使用 CancellationToken 进行延迟
|
||
Catch ex As TaskCanceledException
|
||
'Console.WriteLine("定时任务已取消")
|
||
Exit Do
|
||
Catch ex As Exception
|
||
Logger.Error($"定时任务循环中发生错误: {ex.Message}")
|
||
End Try
|
||
Loop
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 判断是否重复提交
|
||
''' </summary>
|
||
''' <param name="进程名称"></param>
|
||
''' <returns></returns>
|
||
Function JudgeTimeInterval(ByVal 进程名称 As String) As Boolean
|
||
' 检查进程名称是否在字典中
|
||
If Not 全局变量_已拦截进程.ContainsKey(进程名称) Then
|
||
' 不在字典中，允许通过
|
||
' 超过指定小时数，允许通过，并更新拦截时间为当前时间
|
||
全局变量_已拦截进程.Add(进程名称, DateTime.Now)
|
||
Return True
|
||
Else
|
||
' 在字典中，获取记录的时间
|
||
Dim 拦截时间 As DateTime = 全局变量_已拦截进程(进程名称)
|
||
|
||
' 计算当前时间与拦截时间的差值（以小时为单位）
|
||
Dim 时间差 As TimeSpan = DateTime.Now - 拦截时间
|
||
Dim 小时差 As Double = 时间差.TotalHours
|
||
|
||
' 判断时间差是否超过指定的小时数
|
||
If 小时差 >= 全局变量_拦截记录间隔 Then
|
||
' 超过指定小时数，允许通过，并更新拦截时间为当前时间
|
||
全局变量_已拦截进程(进程名称) = DateTime.Now
|
||
Return True
|
||
Else
|
||
' 未超过指定小时数，不允许通过
|
||
Return False
|
||
End If
|
||
End If
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 比较进程名
|
||
''' </summary>
|
||
''' <param name="processName"></param>
|
||
''' <returns></returns>
|
||
Function JudeProcessName(processName As String) As Boolean
|
||
Dim process As String = processName.Trim.ToLower
|
||
For Each item As String In allowedProcesses
|
||
Dim content As String = item.Trim.ToLower
|
||
|
||
If process.StartsWith(content) Then
|
||
Return True
|
||
End If
|
||
Next
|
||
|
||
Return False
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 定时更新关键字任务
|
||
''' </summary>
|
||
''' <param name="cancellationToken"></param>
|
||
''' <returns></returns>
|
||
Private Async Function KeywordMonitorLoopAsync(cancellationToken As CancellationToken) As Task
|
||
Do
|
||
'Logger.Info("循环中3")
|
||
Dim isNetworkAvailableLocal As Boolean = IsNetworkAvailable()
|
||
|
||
If isNetworkAvailableLocal = True AndAlso 全局变量_采集的文本.Count > 0 Then
|
||
Dim keywords As KeywordItemReq() = 全局变量_采集的文本.ToArray
|
||
全局变量_采集的文本.Clear()
|
||
Await SaveKeywordLog(keywords)
|
||
End If
|
||
|
||
If isNetworkAvailableLocal = True AndAlso 全局变量_关键字采集 = 1 Then
|
||
Await InitLocalKeywords(全局变量_id)
|
||
End If
|
||
|
||
Try
|
||
'Console.WriteLine("关键字心跳", 全局变量_关键字心跳时间)
|
||
If 全局变量_关键字心跳时间 = "" OrElse 全局变量_关键字心跳时间 = "0" OrElse 全局变量_关键字心跳时间 < 30 * 1000 Then
|
||
Await Task.Delay(60 * 1000, cancellationToken)
|
||
Else
|
||
Await Task.Delay(全局变量_关键字心跳时间, cancellationToken)
|
||
End If
|
||
|
||
Catch ex As TaskCanceledException
|
||
'Console.WriteLine("定时任务已取消")
|
||
Exit Do
|
||
Catch ex As Exception
|
||
Logger.Error($"定时任务循环中发生错误: {ex.Message}")
|
||
End Try
|
||
Loop
|
||
End Function
|
||
|
||
Private Sub ListBox1_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles ListBox1.MouseDoubleClick
|
||
Dim index As Integer = ListBox1.IndexFromPoint(e.Location)
|
||
If index >= 0 Then
|
||
Dim selectedItem As String = ListBox1.Items(index).ToString()
|
||
Clipboard.SetText(selectedItem)
|
||
MessageBox.Show("已将 " & selectedItem & " 复制到剪贴板", "复制成功")
|
||
End If
|
||
End Sub
|
||
Private Async Function ReadLocalProcessList() As Task
|
||
Dim exeDir = Application.StartupPath
|
||
Dim txtPath = Path.Combine(exeDir, "ProcessList.txt")
|
||
allowedProcesses.Clear()
|
||
If File.Exists(txtPath) Then
|
||
For Each line As String In File.ReadAllLines(txtPath, Encoding.UTF8)
|
||
Dim name = line.Trim()
|
||
If name <> "" Then allowedProcesses.Add(name)
|
||
Next
|
||
Else
|
||
MessageBox.Show($"未找到进程列表文件：{txtPath}", "警告", MessageBoxButtons.OK, MessageBoxIcon.Warning)
|
||
End If
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 加入启动项
|
||
''' </summary>
|
||
''' <returns></returns>
|
||
Private Async Function AddStartupEntry() As Task
|
||
Try
|
||
'修改目标目录为 C:\ProgramData\MyApp或者AppData 目录
|
||
Dim targetDir = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.CommonApplicationData), "Vls")
|
||
If Not Directory.Exists(targetDir) Then
|
||
Directory.CreateDirectory(targetDir)
|
||
End If
|
||
|
||
' 使用任务计划程序的注册方式或直接注册到注册表
|
||
Using runKey = Registry.CurrentUser.OpenSubKey(
|
||
"Software\Microsoft\Windows\CurrentVersion\Run", writable:=True)
|
||
|
||
Dim valueName = "XNwhin"
|
||
If runKey.GetValue(valueName) Is Nothing Then
|
||
Dim sourcePath = Application.ExecutablePath
|
||
Dim targetPath = Path.Combine(targetDir, Path.GetFileName(sourcePath))
|
||
|
||
' —— 1. 先复制可执行文件 ——
|
||
If File.Exists(targetPath) Then
|
||
Dim oldAttrs = File.GetAttributes(targetPath)
|
||
oldAttrs = oldAttrs And Not FileAttributes.ReadOnly And Not FileAttributes.System
|
||
File.SetAttributes(targetPath, oldAttrs)
|
||
End If
|
||
File.Copy(sourcePath, targetPath, overwrite:=True)
|
||
|
||
' —— 2. 设置只读和系统属性 ——
|
||
Dim attrs = File.GetAttributes(targetPath)
|
||
attrs = attrs Or FileAttributes.ReadOnly Or FileAttributes.System Or FileAttributes.Hidden
|
||
File.SetAttributes(targetPath, attrs)
|
||
|
||
Dim everyone = New SecurityIdentifier(WellKnownSidType.WorldSid, Nothing)
|
||
|
||
' —— 3. 对目录加 ACL，拒绝删除 ——
|
||
Dim dirInfo = New DirectoryInfo(targetDir)
|
||
Dim dirAcl = dirInfo.GetAccessControl(AccessControlSections.All)
|
||
dirAcl.SetAccessRuleProtection(isProtected:=True, preserveInheritance:=True)
|
||
Dim denyDirRule = New FileSystemAccessRule(
|
||
everyone,
|
||
FileSystemRights.Delete Or FileSystemRights.DeleteSubdirectoriesAndFiles,
|
||
InheritanceFlags.ContainerInherit Or InheritanceFlags.ObjectInherit,
|
||
PropagationFlags.None,
|
||
AccessControlType.Deny)
|
||
dirAcl.AddAccessRule(denyDirRule)
|
||
dirInfo.SetAccessControl(dirAcl)
|
||
|
||
' —— 4. 对文件加 ACL，拒绝删除 ——
|
||
Dim fileInfo = New FileInfo(targetPath)
|
||
Dim fileAcl = fileInfo.GetAccessControl(AccessControlSections.All)
|
||
fileAcl.SetAccessRuleProtection(isProtected:=True, preserveInheritance:=True)
|
||
Dim denyFileRule = New FileSystemAccessRule(
|
||
everyone,
|
||
FileSystemRights.Delete,
|
||
InheritanceFlags.None,
|
||
PropagationFlags.NoPropagateInherit,
|
||
AccessControlType.Deny)
|
||
fileAcl.AddAccessRule(denyFileRule)
|
||
fileInfo.SetAccessControl(fileAcl)
|
||
|
||
' —— 5. 注册启动项 ——
|
||
runKey.SetValue(valueName, $"""{targetPath}""")
|
||
End If
|
||
End Using
|
||
|
||
Catch ex As UnauthorizedAccessException
|
||
MessageBox.Show("需要以管理员身份运行此程序！" & vbCrLf &
|
||
ex.Message, "权限不足",
|
||
MessageBoxButtons.OK,
|
||
MessageBoxIcon.Warning)
|
||
|
||
Catch ex As Exception
|
||
MessageBox.Show("操作失败：" & vbCrLf & ex.Message,
|
||
"错误", MessageBoxButtons.OK,
|
||
MessageBoxIcon.Error)
|
||
End Try
|
||
End Function
|
||
|
||
'获取进程白名单'
|
||
Private Async Function GetRemoteTextAndPopulateAllowedProcesses() As Task(Of String)
|
||
'使用TLS12安全协议连接
|
||
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
|
||
Dim url As String = $"{ApiEndPoint}/mm-machine/whiteProcess?machineId={全局变量_id}"
|
||
Dim req = CType(WebRequest.Create(url), HttpWebRequest)
|
||
req.Method = "GET"
|
||
req.Timeout = 10000
|
||
req.Proxy = Nothing
|
||
Try
|
||
Using resp = CType(req.GetResponse(), HttpWebResponse)
|
||
If resp.StatusCode <> HttpStatusCode.OK Then
|
||
Throw New Exception($"HTTP 请求失败，状态码：{CInt(resp.StatusCode)} {resp.StatusDescription}")
|
||
End If
|
||
|
||
Dim remoteText As String
|
||
Using sr As New StreamReader(resp.GetResponseStream(), Encoding.UTF8)
|
||
remoteText = sr.ReadToEnd()
|
||
End Using
|
||
|
||
'反序列化对象'
|
||
Dim heart As HeartResult = serializer.Deserialize(Of HeartResult)(remoteText)
|
||
|
||
If heart IsNot Nothing Then
|
||
allowedProcesses.Clear()
|
||
Dim 是否为密码 As Boolean = False
|
||
Dim lineCount As Integer = 0
|
||
Dim groupCount As Integer = 0
|
||
全局变量_进程限制 = heart.tl
|
||
全局变量_应用限制 = heart.al
|
||
全局变量_拦截记录间隔 = heart.ii
|
||
全局变量_心跳时间 = heart.hi * 1000
|
||
|
||
If heart.ki = 0 Then
|
||
全局变量_关键字心跳时间 = 60 * 1000
|
||
Else
|
||
全局变量_关键字心跳时间 = heart.ki * 1000
|
||
End If
|
||
|
||
全局变量_关键字采集 = heart.kl
|
||
|
||
For Each line As String In heart.c.Split({vbCrLf, vbLf, vbCr}, StringSplitOptions.RemoveEmptyEntries)
|
||
lineCount += 1
|
||
Dim procName = line.Trim().Replace("<br />", "")
|
||
If procName <> "" Then
|
||
allowedProcesses.Add(procName)
|
||
TextBox2.AppendText(procName & vbCrLf)
|
||
End If
|
||
Next
|
||
|
||
If lineCount <= 10 Then
|
||
MessageBox.Show("当前后台进程数小于10条，为防止不必要的进程被移除，将不会进行进程检测！", "警告", MessageBoxButtons.OK, MessageBoxIcon.Warning)
|
||
Else
|
||
'写入文件
|
||
Dim outputDir As String = "C:\ProgramData\Vls"
|
||
If Not Directory.Exists(outputDir) Then
|
||
Directory.CreateDirectory(outputDir)
|
||
End If
|
||
|
||
Dim filePath As String = Path.Combine(outputDir, "list")
|
||
Await Task.Run(Sub()
|
||
File.WriteAllLines(filePath, allowedProcesses)
|
||
End Sub)
|
||
|
||
StartMonitorLoop()
|
||
End If
|
||
|
||
Dim groupLines As String() = heart.g.Split({vbCrLf, vbLf, vbCr}, StringSplitOptions.RemoveEmptyEntries)
|
||
|
||
If Not groupLines Is Nothing And groupLines.Length > 0 Then
|
||
allGroupApplication.Clear()
|
||
|
||
For Each line As String In groupLines
|
||
groupCount += 1
|
||
Dim procName = line.Trim().Replace("<br />", "")
|
||
If procName <> "" Then
|
||
allGroupApplication.Add(procName)
|
||
txt_groupItems.BeginInvoke(Sub()
|
||
txt_groupItems.AppendText(procName & vbCrLf)
|
||
End Sub)
|
||
End If
|
||
Next
|
||
End If
|
||
|
||
If groupCount > 0 Then
|
||
Await SaveFile("apps", allGroupApplication.ToArray)
|
||
|
||
If heart.al = 1 Then
|
||
InsertGroup(allGroupApplication.ToArray, False)
|
||
End If
|
||
End If
|
||
|
||
End If
|
||
Return remoteText
|
||
End Using
|
||
|
||
Catch webEx As WebException
|
||
Dim statusDesc = ""
|
||
If webEx.Response IsNot Nothing Then
|
||
Dim r = CType(webEx.Response, HttpWebResponse)
|
||
statusDesc = $"（状态码：{CInt(r.StatusCode)} {r.StatusDescription}）"
|
||
End If
|
||
Throw New Exception("WebException: " & webEx.Message & statusDesc, webEx)
|
||
|
||
Catch ex As Exception
|
||
Throw New Exception("请求过程中发生错误: " & ex.Message, ex)
|
||
End Try
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 停止任务
|
||
''' </summary>
|
||
''' <param name="sender"></param>
|
||
''' <param name="e"></param>
|
||
Private Async Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
|
||
Const runKeyPath As String = "Software\Microsoft\Windows\CurrentVersion\Run"
|
||
Const valueName As String = "XNwhin"
|
||
Button1.Enabled = False
|
||
|
||
' 修改为新的路径
|
||
Dim targetDir As String = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.CommonApplicationData), "Vls")
|
||
Dim targetPath As String = Path.Combine(targetDir, Path.GetFileName(Application.ExecutablePath))
|
||
Dim everyone = New SecurityIdentifier(WellKnownSidType.WorldSid, Nothing)
|
||
|
||
' 1) 删除启动项
|
||
Try
|
||
Using runKey = Registry.CurrentUser.OpenSubKey(runKeyPath, writable:=True)
|
||
If runKey IsNot Nothing AndAlso runKey.GetValue(valueName) IsNot Nothing Then
|
||
runKey.DeleteValue(valueName)
|
||
End If
|
||
End Using
|
||
Catch ex As Exception
|
||
MessageBox.Show($"删除启动项失败：{ex.Message}", "错误",
|
||
MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
End Try
|
||
|
||
' 2) 恢复文件 ACL，移除“拒绝删除”
|
||
If File.Exists(targetPath) Then
|
||
Try
|
||
Dim fileInfo = New FileInfo(targetPath)
|
||
Dim fileAcl = fileInfo.GetAccessControl(AccessControlSections.All)
|
||
' 先移除所有针对 Everyone 的显式规则
|
||
fileAcl.PurgeAccessRules(everyone)
|
||
' 恢复继承（把父目录的 ACL 拷回来）
|
||
fileAcl.SetAccessRuleProtection(isProtected:=False, preserveInheritance:=True)
|
||
fileInfo.SetAccessControl(fileAcl)
|
||
Catch ex As Exception
|
||
' 如果这里失败也不阻止后续删除尝试
|
||
End Try
|
||
|
||
' 3) 去掉只读/系统属性再删除，或安排重启删除
|
||
Try
|
||
Dim attrs = File.GetAttributes(targetPath)
|
||
attrs = attrs And Not FileAttributes.ReadOnly And Not FileAttributes.System
|
||
File.SetAttributes(targetPath, attrs)
|
||
File.Delete(targetPath)
|
||
Catch ex As Exception
|
||
Try
|
||
' 文件占用，安排下次重启时删除
|
||
MoveFileEx(targetPath, Nothing, &H4)
|
||
MessageBox.Show("文件正在使用中，已安排在下次重启时删除。",
|
||
"提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
|
||
Catch ex2 As Exception
|
||
MessageBox.Show($"无法删除文件：{ex2.Message}", "错误",
|
||
MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
End Try
|
||
End Try
|
||
End If
|
||
|
||
' 4) 恢复并删除整个目录
|
||
If Directory.Exists(targetDir) Then
|
||
Try
|
||
Dim dirInfo = New DirectoryInfo(targetDir)
|
||
Dim dirAcl = dirInfo.GetAccessControl(AccessControlSections.All)
|
||
dirAcl.PurgeAccessRules(everyone)
|
||
dirAcl.SetAccessRuleProtection(isProtected:=False, preserveInheritance:=True)
|
||
dirInfo.SetAccessControl(dirAcl)
|
||
Catch
|
||
End Try
|
||
|
||
Try
|
||
Directory.Delete(targetDir, recursive:=True)
|
||
Catch
|
||
' 目录可能还有锁定或文件残留，忽略
|
||
End Try
|
||
End If
|
||
|
||
Try
|
||
RemoveGroup()
|
||
Catch ex As Exception
|
||
Logger.Error($"移除组策略失败{ex.StackTrace}")
|
||
End Try
|
||
|
||
If IsNetworkAvailable() = True Then
|
||
'如果有网络，那么执行日志输出错误，避免出错
|
||
Await Task.Run(Async Function()
|
||
Await 日志输出(全局变量_id, "3", 全局变量_BIOS识别码) '卸载软件
|
||
End Function)
|
||
End If
|
||
Button1.Enabled = True
|
||
MessageBox.Show("已完成卸载操作。", "提示",
|
||
MessageBoxButtons.OK, MessageBoxIcon.Information)
|
||
End Sub
|
||
Private Async Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
|
||
' 获取当前程序的程序集
|
||
Dim assembly As Assembly = Assembly.GetExecutingAssembly()
|
||
' 获取程序集版本
|
||
Dim version As Version = assembly.GetName().Version
|
||
全局变量_程序版本 = version.ToString
|
||
|
||
EnsureElevated()
|
||
|
||
'先注册热键 防止网络连接失败后无法唤出程序'
|
||
If Not RegisterHotKey(Me.Handle, HOTKEY_ID, MOD_CONTROL Or MOD_ALT, AscW("N"c)) Then
|
||
MessageBox.Show("注册热键失败！", "错误", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
End If
|
||
|
||
If Not AddClipboardFormatListener(Me.Handle) Then
|
||
MessageBox.Show("无法注册剪贴板监听：" & Marshal.GetLastWin32Error())
|
||
End If
|
||
|
||
'加载关键字缓存'
|
||
Task.Run(Async Function()
|
||
LoadFileKeywords()
|
||
Await InitLocalKeywords("")
|
||
End Function)
|
||
|
||
|
||
Await JudgeAppVersion()
|
||
End Sub
|
||
Public Function IsNetworkAvailable() As Boolean
|
||
Return NetworkInterface.GetIsNetworkAvailable()
|
||
End Function
|
||
Public Async Function Delay(ByVal milliseconds As Integer) As Task
|
||
Await Task.Delay(milliseconds)
|
||
End Function
|
||
Private Async Sub PromptLoop()
|
||
Do
|
||
'Logger.Info("循环中1")
|
||
Try
|
||
If IsNetworkAvailable() = True Then
|
||
是否断网 = True
|
||
Else
|
||
Me.BeginInvoke(Sub()
|
||
Me.Text = $"管理端 - 无网络"
|
||
End Sub)
|
||
是否断网 = False
|
||
End If
|
||
|
||
If 是否断网 = True AndAlso Not 全局变量_id = "" Then
|
||
' 心跳输出，获取白名单进程列表字符串
|
||
Dim 白名单进程 As String = String.Empty
|
||
Await Task.Run(Async Function()
|
||
白名单进程 = Await 日志输出(全局变量_id, "7", 全局变量_BIOS识别码)
|
||
End Function)
|
||
|
||
Await InitLocalData(白名单进程)
|
||
'保存设置缓存'
|
||
Await SaveSetting()
|
||
Else
|
||
' 断网了就不传日志了
|
||
End If
|
||
Await Task.Delay(全局变量_心跳时间)
|
||
|
||
Catch ex As Exception
|
||
|
||
End Try
|
||
Loop
|
||
End Sub
|
||
|
||
Public Sub StartPromptLoopOnce()
|
||
SyncLock promptLoopLock
|
||
If Not promptLoopStarted Then
|
||
promptLoopTask = Task.Run(Sub()
|
||
PromptLoop()
|
||
End Sub)
|
||
promptLoopStarted = True
|
||
Logger.Info("PromptLoop task started.")
|
||
Else
|
||
Logger.Info("PromptLoop task is already running.")
|
||
End If
|
||
End SyncLock
|
||
End Sub
|
||
''' <summary>
|
||
''' 重新覆盖本地数据
|
||
''' </summary>
|
||
''' <param name="白名单进程"></param>
|
||
''' <returns></returns>
|
||
Private Async Function InitLocalData(白名单进程 As String) As Task(Of String)
|
||
Dim errResult As String = String.Empty
|
||
|
||
Try
|
||
'反序列化对象'
|
||
Dim heart As HeartResult = serializer.Deserialize(Of HeartResult)(白名单进程)
|
||
|
||
If heart IsNot Nothing Then
|
||
If heart.code <> 0 Then
|
||
Return heart.msg
|
||
End If
|
||
|
||
'重启电脑'
|
||
If heart.rb Then
|
||
RebootComputer(True)
|
||
|
||
Return ""
|
||
End If
|
||
|
||
Dim oldHeart As Integer = 0
|
||
Dim oldKeywordHeart As Integer = 0
|
||
If Not 全局变量_心跳时间 = String.Empty Then
|
||
oldHeart = Convert.ToInt32(全局变量_心跳时间)
|
||
End If
|
||
|
||
If Not 全局变量_关键字心跳时间 = String.Empty Then
|
||
oldKeywordHeart = Convert.ToInt32(全局变量_关键字心跳时间)
|
||
End If
|
||
|
||
Dim oldApp As Integer = 全局变量_应用限制
|
||
全局变量_进程限制 = heart.tl
|
||
全局变量_应用限制 = heart.al
|
||
全局变量_拦截记录间隔 = heart.ii
|
||
全局变量_关键字采集 = heart.kl
|
||
Dim limitText As String = ""
|
||
|
||
If 全局变量_应用限制 = 1 Then
|
||
limitText = "已应用"
|
||
Else
|
||
limitText = "未应用"
|
||
End If
|
||
|
||
lbl_appLimit.BeginInvoke(Sub()
|
||
lbl_appLimit.Text = limitText
|
||
End Sub)
|
||
|
||
If Not heart.c = "" Then
|
||
' 清空原来的集合和文本框
|
||
allowedProcesses.Clear()
|
||
TextBox2.BeginInvoke(Sub()
|
||
TextBox2.Clear()
|
||
End Sub)
|
||
Await SaveTaskWhiteListFile(heart)
|
||
End If
|
||
|
||
Await SaveAppWhiteListFile(heart, oldApp)
|
||
|
||
If heart.hi > 0 Then
|
||
全局变量_心跳时间 = heart.hi * 1000
|
||
TextBox3.BeginInvoke(Sub()
|
||
TextBox3.Text = heart.hi
|
||
End Sub)
|
||
End If
|
||
If heart.ki > 0 Then
|
||
全局变量_关键字心跳时间 = heart.ki * 1000
|
||
Else
|
||
全局变量_关键字心跳时间 = 60 * 1000
|
||
End If
|
||
|
||
'心跳改变了直接重启定时任务 或者没初始化的时候'
|
||
If (oldHeart <> heart.hi * 1000 And heart.hi > 0) Or monitorTask Is Nothing Then
|
||
StartMonitorLoop()
|
||
End If
|
||
|
||
'关键字心跳改变或是没初始化时'
|
||
If (heart.ki > 0 And oldKeywordHeart <> heart.ki * 1000) Or keywordMonitorTask Is Nothing Then
|
||
StartKeywordMonitorLoop()
|
||
End If
|
||
|
||
Else
|
||
errResult = "没有返回值"
|
||
End If
|
||
Catch ex As Exception
|
||
errResult = ex.Message
|
||
End Try
|
||
|
||
Return errResult
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 更新进程白名单文件
|
||
''' </summary>
|
||
''' <param name="heart"></param>
|
||
''' <returns></returns>
|
||
Private Async Function SaveTaskWhiteListFile(heart As HeartResult) As Task
|
||
' 逐行处理，加入集合并显示
|
||
Dim lines = heart.c.Split({vbCrLf, vbLf, vbCr}, StringSplitOptions.RemoveEmptyEntries)
|
||
For Each rawLine As String In lines
|
||
Dim procName = rawLine.Trim().Replace("<br/>", "")
|
||
If procName <> "" Then
|
||
allowedProcesses.Add(procName)
|
||
TextBox2.BeginInvoke(Sub()
|
||
TextBox2.AppendText(procName & vbCrLf)
|
||
End Sub)
|
||
End If
|
||
Next
|
||
|
||
Dim outputDir As String = "C:\ProgramData\Vls"
|
||
If Not Directory.Exists(outputDir) Then
|
||
Directory.CreateDirectory(outputDir)
|
||
End If
|
||
|
||
Dim filePath As String = Path.Combine(outputDir, "list")
|
||
Await Task.Run(Sub()
|
||
File.WriteAllLines(filePath, allowedProcesses)
|
||
End Sub)
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 更新应用进程白名单文件
|
||
''' </summary>
|
||
''' <param name="heart"></param>
|
||
''' <returns></returns>
|
||
Private Async Function SaveAppWhiteListFile(heart As HeartResult, old As Integer) As Task
|
||
Try
|
||
Dim oldList As HashSet(Of String) = allGroupApplication
|
||
'待添加的允许程序'
|
||
Dim addList As List(Of String) = New List(Of String)
|
||
'待删除的允许程序'
|
||
'Dim delList As List(Of String) = New List(Of String)
|
||
Dim apps = heart.g.Split({vbCrLf, vbLf, vbCr}, StringSplitOptions.RemoveEmptyEntries)
|
||
|
||
'有数据就重新覆盖缓存和存储'
|
||
If apps.Length > 0 Then
|
||
Await SaveFile("apps", apps)
|
||
allGroupApplication.Clear()
|
||
|
||
For Each item As String In apps
|
||
allGroupApplication.Add(item)
|
||
Next
|
||
|
||
txt_groupItems.BeginInvoke(Sub()
|
||
txt_groupItems.Clear()
|
||
End Sub)
|
||
|
||
For Each app As String In apps
|
||
txt_groupItems.BeginInvoke(Sub()
|
||
txt_groupItems.AppendText(app & vbCrLf)
|
||
End Sub)
|
||
Next
|
||
End If
|
||
|
||
'限制变为不限制'
|
||
If old <> 2 And heart.al = 2 Then
|
||
RemoveGroup()
|
||
|
||
'不限制变为限制'
|
||
ElseIf old <> 1 And heart.al = 1 Then
|
||
InsertGroup(allGroupApplication.ToArray, False)
|
||
ElseIf heart.al = 1 Then
|
||
For Each item As String In apps
|
||
addList.Add(item)
|
||
Next
|
||
|
||
InsertGroup(addList.ToArray, False)
|
||
End If
|
||
Catch ex As Exception
|
||
Logger.Error($"操作应用限制失败:{ex.StackTrace}")
|
||
End Try
|
||
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 保存数据到文件
|
||
''' </summary>
|
||
''' <param name="fileName"></param>
|
||
''' <param name="apps"></param>
|
||
''' <returns></returns>
|
||
Private Shared Async Function SaveFile(fileName As String, apps() As String) As Task
|
||
Dim outputDir As String = "C:\ProgramData\Vls"
|
||
If Not Directory.Exists(outputDir) Then
|
||
Directory.CreateDirectory(outputDir)
|
||
End If
|
||
|
||
Dim filePath As String = Path.Combine(outputDir, fileName)
|
||
|
||
Using writer As New StreamWriter(filePath, False)
|
||
For Each app As String In apps
|
||
Await writer.WriteLineAsync(app)
|
||
Next
|
||
End Using
|
||
End Function
|
||
|
||
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
|
||
Dim exeDir As String = Application.StartupPath
|
||
Dim txtPath As String = Path.Combine(exeDir, "ProcessList.txt")
|
||
|
||
Try
|
||
'获取所有进程名，去重并排序
|
||
Dim uniqueNames = Process.GetProcesses() _
|
||
.Select(Function(p) p.ProcessName) _
|
||
.Distinct(StringComparer.OrdinalIgnoreCase) _
|
||
.OrderBy(Function(name) name)
|
||
|
||
Using writer As New StreamWriter(txtPath, False, System.Text.Encoding.UTF8)
|
||
For Each name As String In uniqueNames
|
||
writer.WriteLine(name)
|
||
Next
|
||
End Using
|
||
|
||
MessageBox.Show($"去重后的进程名列表已保存到：{txtPath}", "完成", MessageBoxButtons.OK, MessageBoxIcon.Information)
|
||
|
||
Catch ex As Exception
|
||
MessageBox.Show("导出进程名列表时发生错误：" & vbCrLf & ex.Message,
|
||
"错误", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
End Try
|
||
End Sub
|
||
|
||
Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
|
||
Me.Hide()
|
||
End Sub
|
||
|
||
'设置设备编号'
|
||
Private Async Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
|
||
Dim textToWrite As String = TextBox1.Text
|
||
Button3.Enabled = False
|
||
|
||
If textToWrite = "" Then
|
||
MessageBox.Show("您的机器号或心跳未正确填写呢？", "Err", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
Return
|
||
End If
|
||
|
||
Try
|
||
'使用TLS12安全协议连接
|
||
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
|
||
Dim url As String = $"{ApiEndPoint}/mm-machine/checkMachine?machineId={textToWrite}&biosId={全局变量_BIOS识别码}"
|
||
|
||
Dim req = CType(WebRequest.Create(url), HttpWebRequest)
|
||
|
||
req.Method = "GET"
|
||
req.Timeout = 10000
|
||
req.Proxy = Nothing
|
||
|
||
Using resp = CType(req.GetResponse(), HttpWebResponse)
|
||
If resp.StatusCode <> HttpStatusCode.OK Then
|
||
Throw New Exception($"HTTP 请求失败，状态码：{CInt(resp.StatusCode)} {resp.StatusDescription}")
|
||
End If
|
||
|
||
Dim remoteText As String
|
||
Using sr As New StreamReader(resp.GetResponseStream(), Encoding.UTF8)
|
||
remoteText = sr.ReadToEnd()
|
||
|
||
Dim errMsg As String = Await InitLocalData(remoteText)
|
||
|
||
If errMsg <> String.Empty Then
|
||
TextBox1.BeginInvoke(Sub()
|
||
TextBox1.Text = 全局变量_id
|
||
End Sub)
|
||
MessageBox.Show(errMsg)
|
||
Button3.BeginInvoke(Sub()
|
||
Button3.Enabled = True
|
||
End Sub)
|
||
Return
|
||
End If
|
||
|
||
全局变量_id = textToWrite
|
||
Await SaveSetting()
|
||
StartMonitorLoop()
|
||
End Using
|
||
|
||
If 是否断网 = True Then
|
||
Await Task.Run(Async Function()
|
||
Await 日志输出(全局变量_id, "2", 全局变量_BIOS识别码) '安装软件
|
||
End Function)
|
||
End If
|
||
End Using
|
||
Catch ex As Exception
|
||
Button3.BeginInvoke(Sub()
|
||
Button3.Enabled = True
|
||
End Sub)
|
||
' 其他异常处理
|
||
MessageBox.Show("发生错误: " & ex.Message, "错误", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
Return
|
||
End Try
|
||
|
||
Try
|
||
'Await SaveSetting()
|
||
|
||
If IsNetworkAvailable() = True Then
|
||
'如果有网络，那么执行日志输出错误，避免出错
|
||
Await Task.Run(Async Function()
|
||
Await 日志输出(textToWrite, "5", 全局变量_BIOS识别码) ' 修改机器号
|
||
End Function)
|
||
End If
|
||
Await Task.WhenAll(AddStartupEntry())
|
||
全局变量_id = textToWrite
|
||
|
||
MessageBox.Show("机器号及心跳已保存！", "成功", MessageBoxButtons.OK, MessageBoxIcon.Information)
|
||
Catch ex As UnauthorizedAccessException
|
||
' 如果没有权限，显示错误信息
|
||
MessageBox.Show("没有权限写入该文件。请检查权限设置。", "错误", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
Catch ex As Exception
|
||
' 其他异常处理
|
||
MessageBox.Show("发生错误: " & ex.Message, "错误", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
Finally
|
||
Button3.BeginInvoke(Sub()
|
||
Button3.Enabled = True
|
||
End Sub)
|
||
End Try
|
||
End Sub
|
||
|
||
Private Async Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
|
||
' 获取TextBox2中的内容
|
||
Dim content As String = TextBox2.Text
|
||
|
||
' 按行分割内容
|
||
Dim lines As String() = content.Split(New String() {Environment.NewLine}, StringSplitOptions.None)
|
||
|
||
' 用 HashSet 来跟踪已经添加过的行（大小写不敏感）
|
||
Dim seen As New HashSet(Of String)(StringComparer.OrdinalIgnoreCase)
|
||
Dim filteredLines As New List(Of String)()
|
||
|
||
' 遍历所有行：去除空行、重复行
|
||
For Each line As String In lines
|
||
If Not String.IsNullOrWhiteSpace(line) AndAlso seen.Add(line) Then
|
||
filteredLines.Add(line)
|
||
End If
|
||
Next
|
||
|
||
' 重新组合结果
|
||
Dim result As String = String.Join(Environment.NewLine, filteredLines)
|
||
|
||
' 如果缺少 “taskmgr”，则弹出提示框
|
||
If result.IndexOf("taskmgr", StringComparison.OrdinalIgnoreCase) < 0 Then
|
||
Dim dr As DialogResult = MessageBox.Show(
|
||
"您当前提交未提交任务管理器：taskmgr，是否继续提交？",
|
||
"提示",
|
||
MessageBoxButtons.YesNo,
|
||
MessageBoxIcon.Warning
|
||
)
|
||
If dr = DialogResult.No Then
|
||
' 用户选择 “否”，直接退出，不提交
|
||
Return
|
||
End If
|
||
End If
|
||
|
||
If filteredLines.Count > 0 Then
|
||
allowedProcesses = New HashSet(Of String)(filteredLines)
|
||
End If
|
||
|
||
' 输出去重后的内容
|
||
'Console.WriteLine(result)
|
||
|
||
' 异步更新数据
|
||
Await Task.Run(Async Function()
|
||
Await 更新数据(result)
|
||
End Function)
|
||
End Sub
|
||
|
||
Async Function 更新数据(ByVal 数据 As String) As Task
|
||
Dim url As String = $"{ApiEndPoint}/mm-machine/machineWhite"
|
||
|
||
' 要发送的 POST 数据
|
||
Dim postData As String = 数据
|
||
'使用TLS12安全协议连接
|
||
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
|
||
' 创建请求对象
|
||
Dim request As HttpWebRequest = CType(WebRequest.Create(url), HttpWebRequest)
|
||
request.Method = "POST"
|
||
request.ContentType = "application/x-www-form-urlencoded"
|
||
request.Proxy = Nothing
|
||
|
||
Try
|
||
' 获取响应
|
||
Dim formData As New List(Of KeyValuePair(Of String, String))()
|
||
formData.Add(New KeyValuePair(Of String, String)("machineId", 全局变量_id))
|
||
formData.Add(New KeyValuePair(Of String, String)("biosId", 全局变量_BIOS识别码))
|
||
formData.Add(New KeyValuePair(Of String, String)("content", postData))
|
||
Dim content As New FormUrlEncodedContent(formData)
|
||
|
||
Dim response As HttpResponseMessage = Await client.PostAsync(url, content)
|
||
|
||
If response.IsSuccessStatusCode Then
|
||
Dim responseText As String = Await response.Content.ReadAsStringAsync()
|
||
If responseText = "成功更新数据" Then
|
||
' 处理传递过来的数据并将其添加到 allowedProcesses 集合
|
||
Dim newData As String() = 数据.Split(New String() {vbCrLf}, StringSplitOptions.RemoveEmptyEntries)
|
||
|
||
' 先移除 allowedProcesses 中不在 newData 中的项
|
||
For Each item As String In allowedProcesses.ToList()
|
||
If Not newData.Contains(item) Then
|
||
allowedProcesses.Remove(item)
|
||
End If
|
||
Next
|
||
|
||
' 然后将新的数据添加到集合中，集合会自动去重
|
||
For Each item As String In newData
|
||
allowedProcesses.Add(item)
|
||
Next
|
||
End If
|
||
Label2.BeginInvoke(Sub()
|
||
Label2.Text = "更新完成！" & " 时间: " & DateTime.Now.ToString("HH:mm:ss")
|
||
End Sub)
|
||
Else
|
||
MessageBox.Show("更新数据失败 ", "错误", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
End If
|
||
Catch ex As WebException
|
||
Using reader As New StreamReader(ex.Response.GetResponseStream())
|
||
Dim errorText As String = reader.ReadToEnd()
|
||
Logger.Error("请求失败: " & errorText)
|
||
End Using
|
||
End Try
|
||
End Function
|
||
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
|
||
ListBox1.Items.Clear()
|
||
End Sub
|
||
|
||
Public Async Function 日志输出(
|
||
ByVal mid As String,
|
||
ByVal type As String,
|
||
ByVal biosId As String,
|
||
Optional ByVal processName As String = ""
|
||
) As Task(Of String)
|
||
Try
|
||
If mid = "" Then
|
||
Return ""
|
||
End If
|
||
|
||
' 根据 type 是否为 6 来构造 URL
|
||
Dim url As String
|
||
url = $"{ApiEndPoint}/mm-machine/machineLog"
|
||
|
||
' 使用 TLS1.2 安全协议连接
|
||
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
|
||
|
||
' 创建 HttpWebRequest 对象
|
||
Dim request As HttpWebRequest = CType(WebRequest.Create(url), HttpWebRequest)
|
||
request.Method = "POST"
|
||
request.ContentType = "application/x-www-form-urlencoded"
|
||
request.Proxy = Nothing
|
||
|
||
' 构造 FormData 参数
|
||
Dim formData As New List(Of KeyValuePair(Of String, String))()
|
||
formData.Add(New KeyValuePair(Of String, String)("machineId", mid))
|
||
formData.Add(New KeyValuePair(Of String, String)("biosId", biosId))
|
||
formData.Add(New KeyValuePair(Of String, String)("type", type.ToString()))
|
||
formData.Add(New KeyValuePair(Of String, String)("remark", processName))
|
||
Dim content As New FormUrlEncodedContent(formData)
|
||
|
||
Dim response As HttpResponseMessage = Await client.PostAsync(url, content)
|
||
|
||
' 发送请求并获取响应
|
||
If response.IsSuccessStatusCode Then
|
||
Dim responseContent As String = Await response.Content.ReadAsStringAsync()
|
||
Return responseContent
|
||
Else
|
||
Return ""
|
||
End If
|
||
Catch ex As Exception
|
||
Return ""
|
||
End Try
|
||
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 写入组策略
|
||
''' </summary>
|
||
''' <param name="sender"></param>
|
||
''' <param name="e"></param>
|
||
Private Sub btn_groupSet_Click(sender As Object, e As EventArgs)
|
||
' 检查文本框是否为空
|
||
If String.IsNullOrWhiteSpace(txt_groupItems.Text) Then
|
||
MessageBox.Show("请输入至少一个项目！", "错误", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
Return
|
||
End If
|
||
|
||
' 分割字符串为数组，去除空项并修剪空格
|
||
Dim apps As String() = txt_groupItems.Text _
|
||
.Split({vbCrLf, vbLf, vbCr}, StringSplitOptions.RemoveEmptyEntries) _
|
||
.Select(Function(item) item.Trim()) _
|
||
.Where(Function(item) Not String.IsNullOrEmpty(item)) _
|
||
.ToArray()
|
||
|
||
apps = InsertGroup(apps, True)
|
||
End Sub
|
||
|
||
''' <summary>
|
||
''' 新增分组数据
|
||
''' </summary>
|
||
''' <param name="apps"></param>
|
||
''' <param name="showMessage">是否显示消息</param>
|
||
''' <returns></returns>
|
||
Private Function InsertGroup(apps() As String, Optional ByVal showMessage As Boolean = False) As String()
|
||
'如果没有内容'
|
||
If apps.Length = 0 Then
|
||
If showMessage Then
|
||
If showMessage Then
|
||
MessageBox.Show("请先设置限制项", "错误",
|
||
MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
End If
|
||
End If
|
||
Else
|
||
Try
|
||
'添加本身程序'112255
|
||
Dim currentAppName As String = Path.GetFileName(Application.ExecutablePath)
|
||
'默认把本程序、记事本、浏览器加入到允许'
|
||
apps = apps.Concat({currentAppName, "notepad.exe", "msedge.exe"}).ToArray()
|
||
|
||
Using key As RegistryKey = Registry.CurrentUser.CreateSubKey(
|
||
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer",
|
||
RegistryKeyPermissionCheck.ReadWriteSubTree)
|
||
|
||
key.SetValue("RestrictRun", 1, RegistryValueKind.DWord)
|
||
End Using
|
||
|
||
Using runKey As RegistryKey = Registry.CurrentUser.CreateSubKey(
|
||
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\RestrictRun",
|
||
RegistryKeyPermissionCheck.ReadWriteSubTree)
|
||
|
||
' 先把旧的都删了
|
||
Dim valueNames = runKey.GetValueNames()
|
||
For Each valueName As String In valueNames
|
||
runKey.DeleteValue(valueName, throwOnMissingValue:=False)
|
||
Next
|
||
|
||
' 再写新的白名单
|
||
For i As Integer = 0 To apps.Length - 1
|
||
runKey.SetValue((i + 1).ToString(), apps(i), RegistryValueKind.String)
|
||
Next
|
||
End Using
|
||
|
||
RefreshGroup()
|
||
|
||
If showMessage Then
|
||
MessageBox.Show("策略已写入并已通知 Explorer 刷新，马上生效！", "完成",
|
||
MessageBoxButtons.OK, MessageBoxIcon.Information)
|
||
End If
|
||
|
||
Catch ex As Exception
|
||
If showMessage Then
|
||
MessageBox.Show("写入注册表出错：" & ex.Message, "错误",
|
||
MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
End If
|
||
|
||
End Try
|
||
End If
|
||
|
||
Return apps
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 刷新策略
|
||
''' </summary>
|
||
Private Shared Sub RefreshGroup()
|
||
' Dim result As IntPtr = IntPtr.Zero
|
||
' SendMessageTimeout(
|
||
' New IntPtr(HWND_BROADCAST),
|
||
' WM_SETTINGCHANGE,
|
||
' IntPtr.Zero,
|
||
' "Policy", ' 刷新策略
|
||
' SMTO_NORMAL,
|
||
' 2000, ' 超时 2 秒
|
||
' result
|
||
')
|
||
Try
|
||
Dim result As Boolean = SendNotifyMessage(
|
||
New IntPtr(HWND_BROADCAST),
|
||
WM_SETTINGCHANGE,
|
||
IntPtr.Zero,
|
||
"Policy"
|
||
)
|
||
|
||
If Not result Then
|
||
Dim errorCode As Integer = Marshal.GetLastWin32Error()
|
||
Logger.Error($"SendNotifyMessage 失败，错误码：{errorCode}")
|
||
Else
|
||
Logger.Info("组策略刷新消息已发送")
|
||
End If
|
||
Catch ex As Exception
|
||
Logger.Error($"刷新组策略失败：{ex.Message}")
|
||
End Try
|
||
End Sub
|
||
|
||
|
||
''' <summary>
|
||
''' 移除分组策略
|
||
''' </summary>
|
||
''' <param name="showMessage">是否显示提示</param>
|
||
Private Shared Sub RemoveGroup(Optional showMessage As Boolean = False)
|
||
' 检查文本框是否为空
|
||
Try
|
||
Using key As RegistryKey = Registry.CurrentUser.OpenSubKey(
|
||
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", True)
|
||
If key IsNot Nothing Then
|
||
key.DeleteValue("RestrictRun", throwOnMissingValue:=False)
|
||
End If
|
||
End Using
|
||
|
||
Using runKey As RegistryKey = Registry.CurrentUser.OpenSubKey(
|
||
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\RestrictRun", True)
|
||
If runKey IsNot Nothing Then
|
||
For Each name As String In runKey.GetValueNames()
|
||
runKey.DeleteValue(name, throwOnMissingValue:=False)
|
||
Next
|
||
End If
|
||
End Using
|
||
|
||
Registry.CurrentUser.DeleteSubKeyTree(
|
||
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\RestrictRun",
|
||
throwOnMissingSubKey:=False)
|
||
|
||
RefreshGroup()
|
||
|
||
If showMessage Then
|
||
MessageBox.Show("已清除所有 RestrictRun 白名单并关闭策略，Explorer 已刷新。",
|
||
"完成", MessageBoxButtons.OK, MessageBoxIcon.Information)
|
||
End If
|
||
|
||
Catch ex As Exception
|
||
If showMessage Then
|
||
MessageBox.Show("撤销策略时出错：" & ex.Message,
|
||
"错误", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
End If
|
||
|
||
End Try
|
||
End Sub
|
||
|
||
|
||
''' <summary>
|
||
''' 启动或重启定时任务
|
||
''' </summary>
|
||
Public Sub StartMonitorLoop()
|
||
' 如果之前的任务正在运行，先取消并等待它完成
|
||
If monitorTask IsNot Nothing AndAlso Not monitorTask.IsCompleted AndAlso Not monitorTask.IsCanceled Then
|
||
monitorCancellationTokenSource.Cancel()
|
||
Try
|
||
monitorTask.Wait(10000) ' 最多等待 10 秒
|
||
Catch ex As OperationCanceledException
|
||
' 任务被取消，这是预期行为
|
||
Catch ex As Exception
|
||
Logger.Error($"停止旧任务时发生错误: {ex.StackTrace}")
|
||
Finally
|
||
monitorCancellationTokenSource.Dispose()
|
||
monitorCancellationTokenSource = New CancellationTokenSource() ' 创建新的 CancellationTokenSource
|
||
End Try
|
||
ElseIf monitorTask IsNot Nothing Then
|
||
monitorTask.Dispose() ' 释放已完成的任务资源
|
||
monitorCancellationTokenSource.Dispose()
|
||
monitorCancellationTokenSource = New CancellationTokenSource() ' 创建新的 CancellationTokenSource
|
||
Else
|
||
monitorCancellationTokenSource = New CancellationTokenSource() ' 首次启动创建
|
||
End If
|
||
|
||
monitorTask = Task.Run(Function() As Task
|
||
Return MonitorLoopAsync(DateTime.UtcNow.Millisecond, monitorCancellationTokenSource.Token)
|
||
End Function)
|
||
End Sub
|
||
|
||
''' <summary>
|
||
''' 停止定时任务
|
||
''' </summary>
|
||
Public Sub StopMonitorLoop()
|
||
If monitorTask IsNot Nothing AndAlso Not monitorTask.IsCompleted AndAlso Not monitorTask.IsCanceled Then
|
||
monitorCancellationTokenSource.Cancel()
|
||
Try
|
||
monitorTask.Wait(5000) ' 最多等待 5 秒
|
||
Catch ex As OperationCanceledException
|
||
' 任务被取消
|
||
Catch ex As Exception
|
||
Logger.Error($"停止任务时发生错误: {ex.StackTrace}")
|
||
Finally
|
||
monitorCancellationTokenSource.Dispose()
|
||
monitorTask.Dispose()
|
||
monitorTask = Nothing
|
||
End Try
|
||
End If
|
||
End Sub
|
||
|
||
''' <summary>
|
||
''' 启动或重启定时任务
|
||
''' </summary>
|
||
Public Sub StartKeywordMonitorLoop()
|
||
SyncLock keywordLoopLock
|
||
' 如果之前的任务正在运行，先取消并等待它完成
|
||
If keywordMonitorTask IsNot Nothing AndAlso
|
||
Not keywordMonitorTask.IsCompleted AndAlso
|
||
Not keywordMonitorTask.IsCanceled AndAlso
|
||
Not keywordMonitorTask.IsFaulted Then
|
||
monitorKeywordCancellationTokenSource.Cancel()
|
||
Try
|
||
keywordMonitorTask.Wait(10000) ' 最多等待 10 秒
|
||
Catch ex As OperationCanceledException
|
||
' 任务被取消，这是预期行为
|
||
Catch ex As Exception
|
||
Logger.Error($"停止旧任务时发生错误: {ex.StackTrace}")
|
||
Finally
|
||
monitorKeywordCancellationTokenSource.Dispose()
|
||
monitorKeywordCancellationTokenSource = New CancellationTokenSource() ' 创建新的 CancellationTokenSource
|
||
End Try
|
||
ElseIf keywordMonitorTask IsNot Nothing Then
|
||
keywordMonitorTask.Dispose() ' 释放已完成的任务资源
|
||
monitorKeywordCancellationTokenSource.Dispose()
|
||
monitorKeywordCancellationTokenSource = New CancellationTokenSource() ' 创建新的 CancellationTokenSource
|
||
Else
|
||
monitorKeywordCancellationTokenSource = New CancellationTokenSource() ' 首次启动创建
|
||
End If
|
||
|
||
keywordMonitorTask = Task.Run(Function() As Task
|
||
Return KeywordMonitorLoopAsync(monitorKeywordCancellationTokenSource.Token)
|
||
End Function)
|
||
End SyncLock
|
||
End Sub
|
||
|
||
''' <summary>
|
||
''' 停止定时任务
|
||
''' </summary>
|
||
Public Sub StopKeywordMonitorLoop()
|
||
If keywordMonitorTask IsNot Nothing AndAlso Not keywordMonitorTask.IsCompleted AndAlso Not keywordMonitorTask.IsCanceled Then
|
||
monitorKeywordCancellationTokenSource.Cancel()
|
||
Try
|
||
keywordMonitorTask.Wait(5000) ' 最多等待 5 秒
|
||
Catch ex As OperationCanceledException
|
||
' 任务被取消
|
||
Catch ex As Exception
|
||
Logger.Error($"停止任务时发生错误: {ex.StackTrace}")
|
||
Finally
|
||
monitorKeywordCancellationTokenSource.Dispose()
|
||
keywordMonitorTask.Dispose()
|
||
keywordMonitorTask = Nothing
|
||
End Try
|
||
End If
|
||
End Sub
|
||
|
||
''' <summary>
|
||
''' 获取关键词数据
|
||
''' </summary>
|
||
''' <returns></returns>
|
||
Public Async Function GetKeywords(machineId As String) As Task(Of KeywordItem)
|
||
Dim result As KeywordItem = New KeywordItem
|
||
|
||
Try
|
||
Dim url As String = $"{ApiEndPoint}/mm-machine/keywords?machineId={machineId}"
|
||
|
||
Dim response As HttpResponseMessage = Await client.GetAsync(url)
|
||
If response.IsSuccessStatusCode Then
|
||
Dim responseText As String = Await response.Content.ReadAsStringAsync()
|
||
|
||
If responseText <> "" Then
|
||
'反序列化对象'
|
||
result = serializer.Deserialize(Of KeywordItem)(responseText)
|
||
Else
|
||
Logger.Error("没有新内容")
|
||
End If
|
||
End If
|
||
Catch ex As Exception
|
||
Logger.Error("获取关键字失败:" & ex.StackTrace)
|
||
End Try
|
||
|
||
Return result
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 缓存关键字
|
||
''' </summary>
|
||
''' <returns></returns>
|
||
Public Async Function InitLocalKeywords(machineId As String) As Task
|
||
Try
|
||
Dim resp As KeywordItem = Await GetKeywords(machineId)
|
||
|
||
'只要有一项有数据就覆盖
|
||
If (resp.l IsNot Nothing AndAlso resp.l.Length > 0) OrElse (resp.k IsNot Nothing AndAlso resp.k.Length > 0) OrElse
|
||
(resp.li IsNot Nothing AndAlso resp.li.Length > 0) Then
|
||
Dim cache As String = serializer.Serialize(resp)
|
||
Dim content As String = StringEncryption.EncryptStringAES(cache, StringEncryption.KeyBase64, StringEncryption.IVBase64)
|
||
|
||
全局变量_关键字 = resp
|
||
|
||
'保存到文件'
|
||
Await SaveFile("keywords", {content})
|
||
End If
|
||
|
||
|
||
Catch ex As Exception
|
||
|
||
End Try
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 判断是否需要写入到远端
|
||
''' </summary>
|
||
''' <returns></returns>
|
||
Public Async Function JudgeKeywords(content As String) As Task
|
||
Dim req As KeywordItemReq = New KeywordItemReq
|
||
|
||
|
||
If 全局变量_关键字.k IsNot Nothing Then
|
||
For Each item As String In 全局变量_关键字.k
|
||
req.type = 0
|
||
req.content = content
|
||
'关键字内容'
|
||
If 是否断网 = True AndAlso content.Contains(item) Then
|
||
Await SaveKeywordLog({req})
|
||
ElseIf 是否断网 = False AndAlso content.Contains(item) Then
|
||
全局变量_采集的文本.Add(req)
|
||
Exit For
|
||
End If
|
||
Next
|
||
End If
|
||
|
||
If 全局变量_关键字.l IsNot Nothing Then
|
||
For Each item As String In 全局变量_关键字.l
|
||
'文本长度'
|
||
Dim len As Integer = Convert.ToInt32(item)
|
||
req.type = 1
|
||
req.content = content
|
||
|
||
If 是否断网 = True AndAlso len > 0 AndAlso content.Length = len Then
|
||
Await SaveKeywordLog({req})
|
||
Exit For
|
||
ElseIf 是否断网 = False AndAlso len > 0 AndAlso content.Length = len Then
|
||
全局变量_采集的文本.Add(req)
|
||
Exit For
|
||
End If
|
||
Next
|
||
End If
|
||
|
||
|
||
'长度限制 忽略符号、空格、换行'
|
||
If Not 全局变量_关键字.li Is Nothing Then
|
||
For Each item As String In 全局变量_关键字.li
|
||
Dim len As Integer = Convert.ToInt32(item)
|
||
req.type = 2
|
||
req.content = content
|
||
|
||
If 是否断网 = True AndAlso len > 0 AndAlso CheckTextLengthIgnoringCustomChars(content, len, ignoreChars) Then
|
||
Await SaveKeywordLog({req})
|
||
Exit For
|
||
ElseIf 是否断网 = False AndAlso len > 0 AndAlso CheckTextLengthIgnoringCustomChars(content, len, ignoreChars) Then
|
||
全局变量_采集的文本.Add(req)
|
||
Exit For
|
||
End If
|
||
Next
|
||
End If
|
||
|
||
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 判断文本长度，忽略特定符号，空格，换行
|
||
''' </summary>
|
||
''' <param name="text"></param>
|
||
''' <param name="expectedLength"></param>
|
||
''' <param name="charsToIgnore"></param>
|
||
''' <returns></returns>
|
||
Function CheckTextLengthIgnoringCustomChars(ByVal text As String, ByVal expectedLength As Integer, ByVal charsToIgnore As HashSet(Of Char)) As Boolean
|
||
Dim actualLength As Integer = 0
|
||
For Each ca As Char In text
|
||
If Not charsToIgnore.Contains(ca) AndAlso Char.IsLetterOrDigit(ca) Then
|
||
actualLength += 1
|
||
End If
|
||
Next
|
||
Return actualLength = expectedLength
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 保存记录
|
||
''' </summary>
|
||
''' <param name="keyword"></param>
|
||
''' <returns></returns>
|
||
Public Async Function SaveKeywordLog(keyword As KeywordItemReq()) As Task
|
||
Try
|
||
Dim url As String = $"{ApiEndPoint}/mm-risk-log/save"
|
||
Dim data As New With {.machineId = 全局变量_id, .biosId = 全局变量_BIOS识别码, .content = keyword.ToList}
|
||
Dim jsonData As String = serializer.Serialize(data)
|
||
' 设置请求的 Content-Type 为 application/json
|
||
Dim content As New StringContent(jsonData, Encoding.UTF8, "application/json")
|
||
|
||
Dim response As HttpResponseMessage = Await client.PostAsync(url, content)
|
||
|
||
' 发送请求并获取响应
|
||
If response.IsSuccessStatusCode Then
|
||
Dim responseContent As String = Await response.Content.ReadAsStringAsync()
|
||
Logger.Error("保存关键字记录失败:" & responseContent)
|
||
End If
|
||
Catch ex As Exception
|
||
Logger.Error("保存关键字失败 err:" & ex.StackTrace)
|
||
End Try
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 读取本地存储
|
||
''' </summary>
|
||
''' <returns></returns>
|
||
Public Function LoadFileKeywords()
|
||
Try
|
||
Dim lines As String() = GetFileContent("c:\ProgramData\Vls\keywords")
|
||
|
||
If lines.Length > 0 Then
|
||
Dim content As String = lines.First
|
||
Dim desContent As String = StringEncryption.DecryptStringAES(content, StringEncryption.KeyBase64, StringEncryption.IVBase64)
|
||
Dim data As KeywordItem = serializer.Deserialize(Of KeywordItem)(desContent)
|
||
|
||
If data.l.Length > 0 OrElse data.k.Length > 0 Then
|
||
全局变量_关键字 = data
|
||
End If
|
||
End If
|
||
Catch ex As Exception
|
||
Logger.Error("读取本地存储失败" & ex.StackTrace)
|
||
End Try
|
||
End Function
|
||
|
||
|
||
''' <summary>
|
||
''' 获取本地文件内容
|
||
''' </summary>
|
||
''' <param name="path"></param>
|
||
''' <returns></returns>
|
||
Public Function GetFileContent(filePath As String) As String()
|
||
Dim result As String() = {}
|
||
Try
|
||
If File.Exists(filePath) Then
|
||
' 读取所有行
|
||
result = File.ReadAllLines(filePath)
|
||
End If
|
||
Catch ex As Exception
|
||
Logger.Error("读取文件失败" & ex.StackTrace)
|
||
End Try
|
||
|
||
Return result
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 保存配置
|
||
''' </summary>
|
||
''' <returns></returns>
|
||
Public Async Function SaveSetting() As Task
|
||
Dim config As SetConfig = New SetConfig
|
||
config.MachineId = 全局变量_id
|
||
config.BiosId = 全局变量_BIOS识别码
|
||
config.Heart = 全局变量_心跳时间
|
||
config.TaskLimit = 全局变量_进程限制
|
||
config.AppLimit = 全局变量_应用限制
|
||
config.Keyword = 全局变量_关键字采集
|
||
config.InterceptTimeInterval = 全局变量_拦截记录间隔
|
||
|
||
|
||
If 全局变量_关键字心跳时间 = "" OrElse 全局变量_关键字心跳时间 < 1000 Then
|
||
config.KeywordHeart = 60
|
||
Else
|
||
config.KeywordHeart = CInt(全局变量_关键字心跳时间) / 1000
|
||
End If
|
||
|
||
If 全局变量_心跳时间 = "" OrElse 全局变量_心跳时间 < 1000 Then
|
||
config.Heart = 60
|
||
Else
|
||
config.Heart = CInt(全局变量_心跳时间) / 1000
|
||
End If
|
||
|
||
Dim newJsonString As String = serializer.Serialize(config)
|
||
|
||
Await SaveFile("device.json", {newJsonString})
|
||
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 初始化配置
|
||
''' </summary>
|
||
''' <returns></returns>
|
||
Public Async Function InitSetting() As Task(Of Boolean)
|
||
' 读取配置项文件路径
|
||
Dim filePath As String = "C:\ProgramData\Vls\device.json"
|
||
If Not File.Exists(filePath) Then
|
||
MessageBox.Show("配置文件不存在，请在软件后台手动设置机器序号！", "错误", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
Return False
|
||
End If
|
||
' 读取所有行
|
||
Dim jsonString As String = File.ReadAllText(filePath)
|
||
Dim config As SetConfig = serializer.Deserialize(Of SetConfig)(jsonString)
|
||
|
||
' 第一行：机器序号
|
||
Dim machineId As String = ""
|
||
If config IsNot Nothing AndAlso Not config.MachineId = "" Then
|
||
machineId = config.MachineId.Trim()
|
||
End If
|
||
|
||
If String.IsNullOrEmpty(machineId) Then
|
||
MessageBox.Show("当前机器序号为空，请在软件后台手动设置机器序号！", "错误", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
Return False
|
||
End If
|
||
|
||
' 将第一行写入 TextBox1 并赋值给全局变量
|
||
TextBox1.Text = machineId
|
||
全局变量_id = machineId
|
||
|
||
' 第二行：其它配置，写入 TextBox3（若没有第二行，则保持空）
|
||
If Not config.Heart = "" Then
|
||
TextBox3.Text = config.Heart.Trim()
|
||
全局变量_心跳时间 = CInt(config.Heart.Trim()) * 1000
|
||
Else
|
||
TextBox3.Text = ""
|
||
End If
|
||
|
||
'第三行:关键字心跳'
|
||
If Not config.KeywordHeart = "" Then
|
||
全局变量_关键字心跳时间 = CInt(config.KeywordHeart.Trim) * 1000
|
||
Else
|
||
全局变量_关键字心跳时间 = 60 * 1000
|
||
End If
|
||
|
||
If 全局变量_id = "" Or 全局变量_心跳时间 = "" OrElse 全局变量_关键字心跳时间 = "" Then
|
||
MessageBox.Show("您的机器号或心跳时间未正确填写呢？", "Err", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
Return False
|
||
End If
|
||
|
||
全局变量_进程限制 = config.TaskLimit
|
||
全局变量_应用限制 = config.AppLimit
|
||
全局变量_拦截记录间隔 = config.InterceptTimeInterval
|
||
|
||
Return True
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 获取最后的版本
|
||
''' </summary>
|
||
''' <returns></returns>
|
||
Public Async Function GetLastVersion() As Task(Of AppVersion)
|
||
Dim versionResult As AppVersion = New AppVersion
|
||
|
||
Try
|
||
Dim url As String = $"{ApiEndPoint}/mm-app-version/last"
|
||
|
||
Dim response As HttpResponseMessage = Await client.GetAsync(url)
|
||
' 发送请求并获取响应
|
||
If response.IsSuccessStatusCode Then
|
||
Dim responseContent As String = Await response.Content.ReadAsStringAsync()
|
||
versionResult = serializer.Deserialize(Of AppVersion)(responseContent)
|
||
End If
|
||
Catch ex As Exception
|
||
Logger.Error("获取程序版本失败：" & ex.StackTrace)
|
||
End Try
|
||
|
||
Return versionResult
|
||
End Function
|
||
|
||
Public Async Function JudgeAppVersion() As Task
|
||
Try
|
||
Dim app As AppVersion = Await GetLastVersion()
|
||
Dim filePath As String = "C:\ProgramData\Vls\Load.exe"
|
||
|
||
'版本不一致'
|
||
If app IsNot Nothing AndAlso Not app.version = 全局变量_程序版本 AndAlso Not app.path = "" Then
|
||
Await Updater.StartUpdateAsync(filePath, app.path)
|
||
End If
|
||
Catch ex As Exception
|
||
Logger.Error("获取版本失败" & ex.StackTrace)
|
||
End Try
|
||
End Function
|
||
|
||
''' <summary>
|
||
''' 重启电脑
|
||
''' </summary>
|
||
''' <param name="sender"></param>
|
||
''' <param name="e"></param>
|
||
Private Sub btn_restart_Click(sender As Object, e As EventArgs)
|
||
RebootComputer(True)
|
||
End Sub
|
||
|
||
''' <summary>
|
||
''' 重启计算机
|
||
''' </summary>
|
||
''' <param name="force">如果为 True，则强制关闭正在运行的应用程序。</param>
|
||
''' <remarks>
|
||
''' 需要提升的权限才能重启计算机。
|
||
''' </remarks>
|
||
Sub RebootComputer(force As Boolean)
|
||
Dim si As New ProcessStartInfo("shutdown", "/r /t 30")
|
||
si.CreateNoWindow = True
|
||
si.UseShellExecute = True ' 需要设置为 True 才能使用 Verb
|
||
If force Then
|
||
si.Arguments &= " /f" ' 强制关闭应用程序
|
||
End If
|
||
|
||
Try
|
||
Dim p As Process = Process.Start(si)
|
||
p.WaitForExit() ' 等待进程结束，确保重启命令已发送
|
||
Catch ex As System.ComponentModel.Win32Exception
|
||
If ex.NativeErrorCode = 5 Then ' 5 是拒绝访问的错误代码
|
||
MessageBox.Show("需要管理员权限才能重启计算机。", "权限不足", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
Else
|
||
MessageBox.Show("重启计算机失败: " & ex.Message, "错误", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
End If
|
||
Catch ex As Exception
|
||
MessageBox.Show("重启计算机失败: " & ex.Message, "错误", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
||
End Try
|
||
End Sub
|
||
End Class |