JavaDetector.vb

Imports System
Imports System.Collections.Generic
Imports System.Diagnostics
Imports System.IO
Imports System.Text.RegularExpressions

' ============================================================
' Java 环境检测模块：扫描系统中已安装的 Java 并验证其版本
' 参照 PCL 的 JavaList 设计：多线程 Check + 关键字扫描
' ============================================================
Public Module JavaDetector

    Private _cachedList As List(Of JavaEntry) = Nothing

    ''' <summary>
    ''' 若缓存存在，直接返回缓存；否则重新扫描所有 Java。
    ''' </summary>
    Public Function GetJavaList() As List(Of JavaEntry)
        If _cachedList Is Nothing Then
            Return RefreshJavaList()
        End If
        Return _cachedList
    End Function

    ''' <summary>
    ''' 清除缓存，重新扫描系统中的 Java。
    ''' </summary>
    Public Function RefreshJavaList() As List(Of JavaEntry)
        Dim candidates As New HashSet(Of String)(StringComparer.OrdinalIgnoreCase)

        ' 1) 从环境变量 PATH 扫描
        Try
            Dim pathEnv As String = If(Environment.GetEnvironmentVariable("PATH"), "")
            Dim javaHome As String = If(Environment.GetEnvironmentVariable("JAVA_HOME"), "")
            For Each raw In (pathEnv & ";" & javaHome).Split(";"c)
                Dim p As String = raw.Trim({" "c, """"c})
                If String.IsNullOrWhiteSpace(p) Then Continue For
                Try
                    ' 如果是 bin 目录，且其下存在 java.exe
                    If File.Exists(Path.Combine(p, "java.exe")) Then
                        If Not p.EndsWith("\") Then p &= "\"
                        candidates.Add(p)
                        Continue For
                    End If
                Catch
                End Try
                ' 可能是一个 JDK/JRE 根目录（<root>\bin\java.exe）
                Dim binDir As String = Path.Combine(p, "bin")
                Try
                    If File.Exists(Path.Combine(binDir, "java.exe")) Then
                        If Not binDir.EndsWith("\") Then binDir &= "\"
                        candidates.Add(binDir)
                    End If
                Catch
                End Try
            Next
        Catch
        End Try

        ' 2) 常见安装目录：Program Files / Program Files (x86)
        Dim commonRoots As New List(Of String)()
        Try
            commonRoots.Add(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles))
            commonRoots.Add(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFilesX86))
            commonRoots.Add(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData))
            commonRoots.Add(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData))
        Catch
        End Try

        Dim searchKeywords As String() = {"Java", "Eclipse Adoptium", "Microsoft", "AdoptOpenJDK",
                                          "BellSoft", "Amazon Corretto", "jdk", "jre", "temurin",
                                          "liberica", "zulu", "graalvm"}

        For Each root In commonRoots
            Try
                If String.IsNullOrWhiteSpace(root) Then Continue For
                If Not Directory.Exists(root) Then Continue For
                For Each dirName As String In Directory.EnumerateDirectories(root)
                    Try
                        Dim simpleName As String = Path.GetFileName(dirName)
                        Dim match As Boolean = False
                        For Each k In searchKeywords
                            If simpleName.IndexOf(k, StringComparison.OrdinalIgnoreCase) >= 0 Then
                                match = True
                                Exit For
                            End If
                        Next
                        If Not match Then Continue For
                        ' 一级子目录扫描
                        For Each subDir As String In Directory.EnumerateDirectories(dirName)
                            Try
                                Dim binPath As String = Path.Combine(subDir, "bin")
                                If File.Exists(Path.Combine(binPath, "java.exe")) Then
                                    If Not binPath.EndsWith("\") Then binPath &= "\"
                                    candidates.Add(binPath)
                                End If
                            Catch
                            End Try
                        Next
                    Catch
                    End Try
                Next
            Catch
            End Try
        Next

        ' 3) 用户 AppData 下的 .minecraft/runtime
        Try
            Dim mcRuntime As String = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData), ".minecraft", "runtime")
            If Directory.Exists(mcRuntime) Then
                For Each subDir As String In Directory.EnumerateDirectories(mcRuntime)
                    Try
                        For Each deeper As String In Directory.EnumerateDirectories(subDir)
                            Dim binPath As String = Path.Combine(deeper, "bin")
                            If File.Exists(Path.Combine(binPath, "java.exe")) Then
                                If Not binPath.EndsWith("\") Then binPath &= "\"
                                candidates.Add(binPath)
                            End If
                        Next
                    Catch
                    End Try
                Next
            End If
        Catch
        End Try

        ' 4) 注册表
        Try
            Dim regBaseKeys As Microsoft.Win32.RegistryKey() = {
                Microsoft.Win32.Registry.LocalMachine.OpenSubKey("SOFTWARE\JavaSoft"),
                Microsoft.Win32.Registry.LocalMachine.OpenSubKey("SOFTWARE\WOW6432Node\JavaSoft"),
                Microsoft.Win32.Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\JDK"),
                Microsoft.Win32.Registry.CurrentUser.OpenSubKey("SOFTWARE\JavaSoft")
            }
            For Each base In regBaseKeys
                If base Is Nothing Then Continue For
                Try
                    For Each subName In base.GetSubKeyNames()
                        Try
                            Using subKey = base.OpenSubKey(subName)
                                If subKey Is Nothing Then Continue For
                                Dim javaHome As String = CStr(subKey.GetValue("JavaHome"))
                                Dim binPath As String = ""
                                If Not String.IsNullOrWhiteSpace(javaHome) Then
                                    binPath = Path.Combine(javaHome, "bin")
                                    If File.Exists(Path.Combine(binPath, "java.exe")) Then
                                        If Not binPath.EndsWith("\") Then binPath &= "\"
                                        candidates.Add(binPath)
                                    End If
                                End If
                            End Using
                        Catch
                        End Try
                    Next
                Finally
                    base.Dispose()
                End Try
            Next
        Catch
        End Try

        ' 5) 对每个候选路径进行校验，并解析版本
        Dim result As New List(Of JavaEntry)()
        Dim checkTasks As New List(Of Action)()

        For Each folder In candidates
            Dim capturedFolder As String = folder
            checkTasks.Add(
                Sub()
                    Try
                        Dim entry As New JavaEntry(capturedFolder, False)
                        entry.Check()
                        SyncLock result
                            If Not result.Any(Function(e) e.PathFolder.Equals(entry.PathFolder, StringComparison.OrdinalIgnoreCase)) Then
                                result.Add(entry)
                            End If
                        End SyncLock
                    Catch
                    End Try
                End Sub
            )
        Next

        ' 串行执行（避免多线程对 java.exe 的并发调用）
        For Each t In checkTasks
            t.Invoke()
        Next

        ' 排序：64 位优先，版本高的优先
        result.Sort(Function(a, b)
                        If a.Is64Bit AndAlso Not b.Is64Bit Then Return -1
                        If Not a.Is64Bit AndAlso b.Is64Bit Then Return 1
                        If a.MajorVersion <> b.MajorVersion Then Return b.MajorVersion.CompareTo(a.MajorVersion)
                        If a.MinorVersion <> b.MinorVersion Then Return b.MinorVersion.CompareTo(a.MinorVersion)
                        If a.IsJre <> b.IsJre Then Return If(a.IsJre, 1, -1)
                        Return 0
                    End Function)

        _cachedList = result
        Return _cachedList
    End Function

    ''' <summary>
    ''' 返回最匹配的 Java 条目：64 位优先，主版本号介于 min~max 之间。
    ''' </summary>
    Public Function FindBestJava(minMajorVersion As Integer, Optional maxMajorVersion As Integer = Integer.MaxValue) As JavaEntry
        Dim list = GetJavaList()
        If list Is Nothing OrElse list.Count = 0 Then Return Nothing

        Dim filtered = list.Where(Function(j) j.Is64Bit AndAlso j.MajorVersion >= minMajorVersion AndAlso j.MajorVersion <= maxMajorVersion)
        Return filtered.FirstOrDefault()
    End Function

    ' ============================================================
    ' JavaEntry：单个 Java 环境条目（参照 PCL JavaEntry）
    ' ============================================================
    Public Class JavaEntry

        ''' <summary>
        ''' java.exe 所在文件夹路径（以 \ 结尾）
        ''' </summary>
        Public PathFolder As String

        ''' <summary>
        ''' 原始版本字符串（如 "1.8.0_381" / "17.0.2"）
        ''' </summary>
        Public VersionString As String

        ''' <summary>
        ''' Java 主版本号：8、11、17、21...
        ''' </summary>
        Public MajorVersion As Integer

        ''' <summary>
        ''' Java 次版本号：对于 1.x.y ，x 为 minor；否则为 .z
        ''' </summary>
        Public MinorVersion As Integer

        ''' <summary>
        ''' 是否为 JRE（不存在 javac.exe）
        ''' </summary>
        Public IsJre As Boolean

        ''' <summary>
        ''' 是否为 64 位
        ''' </summary>
        Public Is64Bit As Boolean

        ''' <summary>
        ''' 是否为用户手动导入
        ''' </summary>
        Public IsUserImport As Boolean

        Public Sub New()
        End Sub

        Public Sub New(folder As String, isUserImport As Boolean)
            If String.IsNullOrWhiteSpace(folder) Then
                PathFolder = ""
            Else
                Dim p As String = folder.Replace("/", "\")
                If Not p.EndsWith("\") Then p &= "\"
                PathFolder = p
            End If
            Me.IsUserImport = isUserImport
        End Sub

        ''' <summary>
        ''' 运行 java.exe -version 并解析版本信息
        ''' </summary>
        Public Sub Check()
            If String.IsNullOrWhiteSpace(PathFolder) Then Throw New FileNotFoundException("Java 路径为空")
            Dim javaPath As String = Path.Combine(PathFolder.TrimEnd("\"c), "java.exe")
            If Not File.Exists(javaPath) Then Throw New FileNotFoundException("未找到 java.exe：" & javaPath)

            IsJre = Not File.Exists(Path.Combine(PathFolder.TrimEnd("\"c), "javac.exe"))

            Dim output As String = RunProcessGetOutput(javaPath, "-version", 15000)
            If String.IsNullOrWhiteSpace(output) Then Throw New ApplicationException("尝试运行该 Java 失败（无输出）")

            Dim verString As String = ""
            Dim m As Match = Regex.Match(output, "version\s+""([^""]+)""")
            If m.Success Then
                verString = m.Groups(1).Value.Trim()
            Else
                Dim m2 As Match = Regex.Match(output, "openjdk\s+([0-9]+(\.[0-9]+)*)")
                If m2.Success Then
                    verString = m2.Groups(1).Value.Trim()
                Else
                    Dim m3 As Match = Regex.Match(output, "([0-9]+(\.[0-9]+){1,3})")
                    If m3.Success Then verString = m3.Groups(1).Value.Trim()
                End If
            End If

            If String.IsNullOrWhiteSpace(verString) Then Throw New ApplicationException("无法解析该 Java 的版本信息")
            VersionString = verString

            ' 解析为 major.minor
            Dim clean As String = verString.Replace("_", ".").Split("-"c)(0)
            Dim parts As String() = clean.Split("."c)
            Dim numParts As New List(Of Integer)()
            For Each p In parts
                Dim v As Integer = 0
                If Integer.TryParse(p, v) Then numParts.Add(v)
            Next
            If numParts.Count = 0 Then Throw New ApplicationException("解析版本号失败：" & verString)

            If numParts.Count >= 2 AndAlso numParts(0) = 1 Then
                ' 1.x.y 格式：取第二部分为主版本号
                MajorVersion = numParts(1)
                MinorVersion = If(numParts.Count > 2, numParts(2), 0)
            Else
                MajorVersion = numParts(0)
                MinorVersion = If(numParts.Count > 1, numParts(1), 0)
            End If

            ' 32/64 位判断
            Is64Bit = output.Contains("64-Bit") OrElse output.Contains("64-bit") OrElse
                       output.Contains("64-Bit Server") OrElse output.Contains("mixed mode")
            ' 兜底：64 位系统上一般都是 64 位 Java
            If Not Is64Bit AndAlso IntPtr.Size = 8 Then
                ' 无法可靠判断时保守判断为 64 位
                Is64Bit = True
            End If
        End Sub

        Public Overrides Function ToString() As String
            Dim bitsText As String = If(Is64Bit, "64 位", "32 位")
            Dim typeText As String = If(IsJre, "JRE", "JDK")
            Dim folderText As String = If(String.IsNullOrWhiteSpace(PathFolder), "", "：" & PathFolder)
            Return typeText & " " & MajorVersion & "." & MinorVersion & " (" & VersionString & ") " & bitsText & folderText
        End Function
    End Class

    ''' <summary>
    ''' 启动进程捕获 stderr/stdout（合并输出）
    ''' </summary>
    Private Function RunProcessGetOutput(exePath As String, args As String, timeoutMs As Integer) As String
        Try
            Using proc As New Process()
                With proc.StartInfo
                    .FileName = exePath
                    .Arguments = args
                    .RedirectStandardOutput = True
                    .RedirectStandardError = True
                    .UseShellExecute = False
                    .CreateNoWindow = True
                    .StandardOutputEncoding = Text.Encoding.UTF8
                    .StandardErrorEncoding = Text.Encoding.UTF8
                End With
                proc.Start()

                Dim sbOut As New Text.StringBuilder()
                Dim sbErr As New Text.StringBuilder()

                Dim readOut = Sub() sbOut.Append(proc.StandardOutput.ReadToEnd())
                Dim readErr = Sub() sbErr.Append(proc.StandardError.ReadToEnd())

                Dim outTask As New Task(readOut)
                Dim errTask As New Task(readErr)
                outTask.Start()
                errTask.Start()

                If proc.WaitForExit(timeoutMs) Then
                    Task.WaitAll({outTask, errTask}, 2000)
                Else
                    Try : proc.Kill() : Catch : End Try
                End If

                Return sbOut.ToString() & vbCrLf & sbErr.ToString()
            End Using
        Catch ex As Exception
            Return "Exception: " & ex.Message
        End Try
    End Function

End Module