This commit is contained in:
龙腾猫跃
2024-08-31 02:39:45 +08:00
parent a74b2d55c7
commit 007b51b314
21 changed files with 388 additions and 370 deletions
+10 -1
View File
@@ -124,6 +124,15 @@ Public Class FormMain
'3:BUG+ IMP* FEAT- '3:BUG+ IMP* FEAT-
'2:BUG* IMP- '2:BUG* IMP-
'1:BUG- '1:BUG-
If LastVersion < 334 Then 'Snapshot 2.8.5
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "Mod 管理页面允许筛选可更新/启用/禁用的 Mod"))
If LastVersion = 333 Then
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法安装愚人节和预发布版本的 Bug"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(1, "修复无法导出错误报告的 Bug"))
End If
FeatureCount += 6
BugCount += 7
End If
If LastVersion < 333 Then 'Snapshot 2.8.4 If LastVersion < 333 Then 'Snapshot 2.8.4
FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "下载 Mod 时会使用 MCIM 国内镜像源")) FeatureList.Add(New KeyValuePair(Of Integer, String)(4, "下载 Mod 时会使用 MCIM 国内镜像源"))
FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "打开 PCL 时会自动安装同目录下的 modpack.zip")) FeatureList.Add(New KeyValuePair(Of Integer, String)(3, "打开 PCL 时会自动安装同目录下的 modpack.zip"))
@@ -744,7 +753,7 @@ Public Class FormMain
Try Try
If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then If PageCurrent = PageType.VersionSetup AndAlso PageCurrentSub = PageSubType.VersionMod Then
'Mod 管理自动刷新 'Mod 管理自动刷新
FrmVersionMod.RefreshList() FrmVersionMod.ReloadModList()
ElseIf PageCurrent = PageType.VersionSelect Then ElseIf PageCurrent = PageType.VersionSelect Then
'版本选择自动刷新 '版本选择自动刷新
LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\") LoaderFolderRun(McVersionListLoader, PathMcFolder, LoaderFolderRunType.RunOnUpdated, MaxDepth:=1, ExtraPath:="versions\")
+54 -62
View File
@@ -11,12 +11,12 @@ Public Module ModBase
#Region "声明" #Region "声明"
'下列版本信息由更新器自动修改 '下列版本信息由更新器自动修改
Public Const VersionBaseName As String = "2.8.4" '不含分支前缀的显示用版本名 Public Const VersionBaseName As String = "2.8.5" '不含分支前缀的显示用版本名
Public Const VersionStandardCode As String = "2.8.4." & VersionBranchCode '标准格式的四段式版本号 Public Const VersionStandardCode As String = "2.8.5." & VersionBranchCode '标准格式的四段式版本号
#If BETA Then #If BETA Then
Public Const VersionCode As Integer = 332 'Release Public Const VersionCode As Integer = 332 'Release
#Else #Else
Public Const VersionCode As Integer = 333 'Snapshot Public Const VersionCode As Integer = 334 'Snapshot
#End If #End If
'自动生成的版本信息 '自动生成的版本信息
Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
@@ -696,7 +696,7 @@ Public Module ModBase
If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini" If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
WriteFile(FileName, FileContent.ToString) WriteFile(FileName, FileContent.ToString)
Catch ex As Exception Catch ex As Exception
Log(ex, $"写入文件失败({FileName} -> {Key}:{Value})") Log(ex, $"写入文件失败({FileName} → {Key}:{Value})", LogLevel.Hint)
End Try End Try
End Sub End Sub
@@ -770,10 +770,10 @@ Public Module ModBase
End Try End Try
End Sub End Sub
''' <summary> ''' <summary>
''' 读取文件,如果失败则返回空字符串。 ''' 读取文件,如果失败则返回空数组。
''' </summary> ''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param> ''' <param name="FilePath">文件完整或相对路径。</param>
Public Function ReadFile(FilePath As String, Optional Encoding As Encoding = Nothing) As String Public Function ReadFileBytes(FilePath As String, Optional Encoding As Encoding = Nothing) As Byte()
Try Try
'还原文件路径 '还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
@@ -783,17 +783,25 @@ Public Module ModBase
ReDim FileBytes(ReadStream.Length - 1) ReDim FileBytes(ReadStream.Length - 1)
ReadStream.Read(FileBytes, 0, ReadStream.Length) ReadStream.Read(FileBytes, 0, ReadStream.Length)
End Using End Using
ReadFile = If(Encoding Is Nothing, DecodeBytes(FileBytes), Encoding.GetString(FileBytes)) Return FileBytes
Else Else
Log("[System] 欲读取的文件不存在,已返回空字符串:" & FilePath) Log("[System] 欲读取的文件不存在,已返回空内容:" & FilePath)
Return "" Return {}
End If End If
Catch ex As Exception Catch ex As Exception
Log(ex, "读取文件出错:" & FilePath) Log(ex, "读取文件出错:" & FilePath)
Return "" Return {}
End Try End Try
End Function End Function
''' <summary> ''' <summary>
''' 读取文件,如果失败则返回空字符串。
''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param>
Public Function ReadFile(FilePath As String, Optional Encoding As Encoding = Nothing) As String
Dim FileBytes = ReadFileBytes(FilePath)
ReadFile = If(Encoding Is Nothing, DecodeBytes(FileBytes), Encoding.GetString(FileBytes))
End Function
''' <summary>
''' 读取流中的所有文本。 ''' 读取流中的所有文本。
''' </summary> ''' </summary>
Public Function ReadFile(Stream As Stream, Optional Encoding As Encoding = Nothing) As String Public Function ReadFile(Stream As Stream, Optional Encoding As Encoding = Nothing) As String
@@ -818,50 +826,39 @@ Public Module ModBase
''' <param name="FilePath">文件完整或相对路径。</param> ''' <param name="FilePath">文件完整或相对路径。</param>
''' <param name="Text">文件内容。</param> ''' <param name="Text">文件内容。</param>
''' <param name="Append">是否将文件内容追加到当前文件,而不是覆盖它。</param> ''' <param name="Append">是否将文件内容追加到当前文件,而不是覆盖它。</param>
Public Function WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing) As Boolean Public Sub WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing)
Try '还原文件路径
'还原文件路径 If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath '确保目录存在
'确保目录存在 Directory.CreateDirectory(GetPathFromFullPath(FilePath))
Directory.CreateDirectory(GetPathFromFullPath(FilePath)) '写入文件
'写入文件 If File.Exists(FilePath) Then
If File.Exists(FilePath) Then '如果文件存在,刷新目前文件
'如果文件存在,刷新目前文件 Using writer As New StreamWriter(FilePath, Append, If(Encoding, GetEncoding(ReadFileBytes(FilePath))))
Using writer As New StreamWriter(FilePath, Append, If(Encoding, GetEncoding(FilePath))) writer.Write(Text)
writer.Write(Text) writer.Flush()
writer.Flush() writer.Close()
writer.Close() End Using
End Using Else
Else '如果文件不存在,则新建并写入
'如果文件不存在,则新建并写入 File.WriteAllText(FilePath, Text, If(Encoding, New UTF8Encoding(False)))
File.WriteAllText(FilePath, Text, If(Encoding, New UTF8Encoding(False))) End If
End If End Sub
Return True
Catch ex As Exception
Log(ex, "写入文件时出错:" & FilePath)
Return False
End Try
End Function
''' <summary> ''' <summary>
''' 写入文件。 ''' 写入文件。
''' 如果 CanThrow 设置为 False,返回是否写入成功。
''' </summary> ''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param> ''' <param name="FilePath">文件完整或相对路径。</param>
''' <param name="Content">文件内容。</param> ''' <param name="Content">文件内容。</param>
''' <param name="Append">是否将文件内容追加到当前文件,而不是覆盖它。</param> ''' <param name="Append">是否将文件内容追加到当前文件,而不是覆盖它。</param>
Public Function WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False) As Boolean Public Sub WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False)
Try '还原文件路径
'还原文件路径 If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath '确保目录存在
'确保目录存在 Directory.CreateDirectory(GetPathFromFullPath(FilePath))
Directory.CreateDirectory(GetPathFromFullPath(FilePath)) '写入文件
'写入文件 File.WriteAllBytes(FilePath, Content)
File.WriteAllBytes(FilePath, Content) End Sub
Return True
Catch ex As Exception
Log(ex, "写入文件时出错:" & FilePath)
Return False
End Try
End Function
''' <summary> ''' <summary>
''' 将流写入文件。 ''' 将流写入文件。
''' </summary> ''' </summary>
@@ -891,21 +888,11 @@ Public Module ModBase
'文件编码 '文件编码
''' <summary> ''' <summary>
''' 获取文件编码。 ''' 根据字节数组分析其编码。
''' </summary>
''' <param name="FilePath">文件完整或相对路径。</param>
Public Function GetEncoding(FilePath As String) As Encoding
'还原文件路径
If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
'获取编码
GetEncoding = GetEncoding(File.ReadAllBytes(FilePath))
End Function
''' <summary>
''' 获取 Bytes 的编码。
''' </summary> ''' </summary>
Public Function GetEncoding(Bytes As Byte()) As Encoding Public Function GetEncoding(Bytes As Byte()) As Encoding
Dim Length As Integer = Bytes.Count Dim Length As Integer = Bytes.Count
If Length <= 2 Then Return New UTF8Encoding(False) '不带 BOM 的 UTF8 If Length < 3 Then Return New UTF8Encoding(False) '不带 BOM 的 UTF8
'根据 BOM 判断编码 '根据 BOM 判断编码
If Bytes(0) >= &HEF Then If Bytes(0) >= &HEF Then
'有 BOM 类型 '有 BOM 类型
@@ -1649,10 +1636,15 @@ RetryDir:
End Function End Function
''' <summary> ''' <summary>
''' 输入 And 字符不会报错的 Val。 ''' 不会报错的 Val。
''' 如果输入有误,返回 0。
''' </summary> ''' </summary>
Public Function Val(Str As Object) As Double Public Function Val(Str As Object) As Double
Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str)) Try
Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str))
Catch
Return 0
End Try
End Function End Function
'转义 '转义
+18 -8
View File
@@ -268,12 +268,7 @@ RequestFinished:
'下载 '下载
Using Client As New WebClient Using Client As New WebClient
Try Try
If UseBrowserUserAgent Then SecretHeadersSign(Url, Client, UseBrowserUserAgent)
Client.Headers(HttpRequestHeader.UserAgent) = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else
Client.Headers(HttpRequestHeader.UserAgent) = "PCL2/" & VersionStandardCode
End If
Client.Headers(HttpRequestHeader.Referer) = "http://" & VersionCode & ".pcl2.server/"
Client.DownloadFile(Url, LocalFile) Client.DownloadFile(Url, LocalFile)
Catch ex As Exception Catch ex As Exception
File.Delete(LocalFile) File.Delete(LocalFile)
@@ -315,7 +310,7 @@ Retry:
Catch ex As ThreadInterruptedException Catch ex As ThreadInterruptedException
Throw Throw
Catch ex As Exception Catch ex As Exception
If ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message.Contains("(40") AndAlso DontRetryOnRefused Then RetryCount = 999 If ex.InnerException IsNot Nothing AndAlso ex.InnerException.Message.Contains("(40") AndAlso DontRetryOnRefused Then Throw
Select Case RetryCount Select Case RetryCount
Case 0 Case 0
If ModeDebug Then Log(ex, "[Net] 网络请求第一次失败(" & Url & ")") If ModeDebug Then Log(ex, "[Net] 网络请求第一次失败(" & Url & ")")
@@ -432,7 +427,11 @@ RequestFinished:
End Using End Using
Catch Catch
End Try End Try
ex = New WebException($"网络请求失败({ex.Status},{ex.Message},{Url}){If(String.IsNullOrEmpty(Res), "", vbCrLf & Res)}", ex) If Res = "" Then
ex = New WebException($"网络请求失败({ex.Status},{ex.Message},{Url})", ex)
Else
ex = New ResponsedWebException($"服务器返回错误({ex.Status},{ex.Message},{Url}){vbCrLf}{Res}", Res, ex)
End If
End If End If
If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer) If MakeLog Then Log(ex, "NetRequestOnce 失败", LogLevel.Developer)
Throw ex Throw ex
@@ -445,6 +444,17 @@ RequestFinished:
If Resp IsNot Nothing Then Resp.Dispose() If Resp IsNot Nothing Then Resp.Dispose()
End Try End Try
End Function End Function
Public Class ResponsedWebException
Inherits WebException
''' <summary>
''' 远程服务器给予的回复。
''' </summary>
Public Overloads Property Response As String
Public Sub New(Message As String, Response As String, InnerException As Exception)
MyBase.New(Message, InnerException)
Me.Response = Response
End Sub
End Class
''' <summary> ''' <summary>
''' 最大线程数。 ''' 最大线程数。
@@ -1077,7 +1077,7 @@ Retry:
If String.IsNullOrEmpty(Task.Input.SearchText) Then If String.IsNullOrEmpty(Task.Input.SearchText) Then
'如果没有搜索文本,按下载量将结果排序 '如果没有搜索文本,按下载量将结果排序
For Each Result As CompProject In RealResults For Each Result As CompProject In RealResults
Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 30)) Scores.Add(Result, Result.DownloadCount * If(Result.FromCurseForge, 1, 10))
Next Next
Else Else
'如果有搜索文本,按关联度将结果排序 '如果有搜索文本,按关联度将结果排序
@@ -1085,7 +1085,7 @@ Retry:
Dim Entry As New List(Of SearchEntry(Of CompProject)) Dim Entry As New List(Of SearchEntry(Of CompProject))
For Each Result As CompProject In RealResults For Each Result As CompProject In RealResults
Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) + Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) +
Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 30)) / 9) Math.Log10(Math.Max(Result.DownloadCount, 1) * If(Result.FromCurseForge, 1, 10)) / 9)
Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From { Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1), New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1),
New KeyValuePair(Of String, Double)(Result.Description, 0.05)}}) New KeyValuePair(Of String, Double)(Result.Description, 0.05)}})
@@ -844,8 +844,11 @@ NextStack:
Public Sub Output(IsHandAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing) Public Sub Output(IsHandAnalyze As Boolean, Optional ExtraFiles As List(Of String) = Nothing)
'弹窗提示 '弹窗提示
FrmMain.ShowWindowToTop() FrmMain.ShowWindowToTop()
Dim ShowLog As Action = Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
"确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"),
Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing,
Sub() Sub()
'弹窗选择:查看日志
If File.Exists(DirectFile.Value.Key) Then If File.Exists(DirectFile.Value.Key) Then
ShellOnly("notepad", DirectFile.Value.Key) ShellOnly("notepad", DirectFile.Value.Key)
Else Else
@@ -853,11 +856,9 @@ NextStack:
WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf)) WriteFile(FilePath, Join(DirectFile.Value.Value, vbCrLf))
ShellOnly(FilePath) ShellOnly(FilePath)
End If End If
End Sub End Sub))
Select Case MyMsgBox(GetAnalyzeResult(IsHandAnalyze), If(IsHandAnalyze, "错误报告分析结果", "Minecraft 出现错误"),
"确定", If(IsHandAnalyze OrElse DirectFile Is Nothing, "", "查看日志"), If(IsHandAnalyze, "", "导出错误报告"),
Button2Action:=If(IsHandAnalyze OrElse DirectFile Is Nothing, Nothing, ShowLog))
Case 3 Case 3
'弹窗选择:导出错误报告
Dim FileAddress As String = Nothing Dim FileAddress As String = Nothing
Try Try
'获取文件路径 '获取文件路径
@@ -881,7 +882,7 @@ NextStack:
FileName = "游戏崩溃前的输出.txt" FileName = "游戏崩溃前的输出.txt"
End Select End Select
If File.Exists(OutputFile) Then If File.Exists(OutputFile) Then
Dim FileEncoding As Encoding = GetEncoding(OutputFile) Dim FileEncoding As Encoding = GetEncoding(ReadFileBytes(OutputFile))
WriteFile(TempFolder & "Report\" & FileName, WriteFile(TempFolder & "Report\" & FileName,
SecretFilter(ReadFile(OutputFile, FileEncoding), If(FileName = "启动脚本.bat", "F", "*")), SecretFilter(ReadFile(OutputFile, FileEncoding), If(FileName = "启动脚本.bat", "F", "*")),
Encoding:=FileEncoding) Encoding:=FileEncoding)
@@ -216,8 +216,8 @@
'添加特定的 Java '添加特定的 Java
Dim JavaPreList As New Dictionary(Of String, Boolean) Dim JavaPreList As New Dictionary(Of String, Boolean)
If PathMcFolder.Split("\").Count > 3 Then If PathMcFolder.Split("\").Count > 3 AndAlso Not PathMcFolder.Contains("AppData\Roaming") Then
JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录的话) JavaSearchFolder(GetPathFromFullPath(PathMcFolder), JavaPreList, False, True) 'Minecraft 文件夹的父文件夹(如果不是根目录或 %APPDATA% 的话)
End If End If
JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹 JavaSearchFolder(PathMcFolder, JavaPreList, False, True) 'Minecraft 文件夹
JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")). JavaPreList = JavaPreList.Where(Function(j) Not j.Key.Contains(".minecraft\runtime")).
@@ -1,5 +1,4 @@
Imports System.IO.Compression Imports System.IO.Compression
Imports Newtonsoft.Json
Public Module ModLaunch Public Module ModLaunch
@@ -671,6 +670,7 @@ LoginFinish:
Url:=Data.Input.BaseUrl & "/validate", Url:=Data.Input.BaseUrl & "/validate",
Method:="POST", Method:="POST",
Data:=RequestData.ToString(0), Data:=RequestData.ToString(0),
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
ContentType:="application/json; charset=utf-8") '没有返回值的 ContentType:="application/json; charset=utf-8") '没有返回值的
'将登录结果输出 '将登录结果输出
Data.Output.AccessToken = AccessToken Data.Output.AccessToken = AccessToken
@@ -694,6 +694,7 @@ LoginFinish:
""name"":""" & Setup.Get("Cache" & Data.Input.Token & "Name") & """},", "") & " ""name"":""" & Setup.Get("Cache" & Data.Input.Token & "Name") & """},", "") & "
""accessToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Access") & """, ""accessToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Access") & """,
""clientToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Client") & """}", ""clientToken"":""" & Setup.Get("Cache" & Data.Input.Token & "Client") & """}",
Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
ContentType:="application/json; charset=utf-8")) ContentType:="application/json; charset=utf-8"))
'将登录结果输出 '将登录结果输出
If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Setup.Get("Cache" & Data.Input.Token & "Name") & " 无效!") If LoginJson("selectedProfile") Is Nothing Then Throw New Exception("选择的角色 " & Setup.Get("Cache" & Data.Input.Token & "Name") & " 无效!")
@@ -711,16 +712,6 @@ LoginFinish:
Setup.Set("Cache" & Data.Input.Token & "Pass", Data.Input.Password) Setup.Set("Cache" & Data.Input.Token & "Pass", Data.Input.Password)
McLaunchLog("刷新登录成功(Refresh, " & Data.Input.Token & ")") McLaunchLog("刷新登录成功(Refresh, " & Data.Input.Token & ")")
End Sub End Sub
Public Class AuthErrorResponse
Public Property [error] As String
Public Property errorMessage As String
End Class
Private Function ParseErrorResponse(ex As Exception) As AuthErrorResponse
Dim SplitEx As String = ex.ToString().Split(vbCrLf)(1).Split("-")(0).ToString().Trim()
Dim JsonEx As AuthErrorResponse = JsonConvert.DeserializeObject(Of AuthErrorResponse)(SplitEx)
Return JsonEx
End Function
Private Function McLoginRequestLogin(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult)) As Boolean Private Function McLoginRequestLogin(ByRef Data As LoaderTask(Of McLoginServer, McLoginResult)) As Boolean
Try Try
Dim NeedRefresh As Boolean = False Dim NeedRefresh As Boolean = False
@@ -730,13 +721,11 @@ LoginFinish:
New JProperty("username", Data.Input.UserName), New JProperty("username", Data.Input.UserName),
New JProperty("password", Data.Input.Password), New JProperty("password", Data.Input.Password),
New JProperty("requestUser", True)) New JProperty("requestUser", True))
Dim LHeaders As New Dictionary(Of String, String)
LHeaders.Add("Accept-Language", "zh_CN")
Dim LoginJson As JObject = GetJson(NetRequestRetry( Dim LoginJson As JObject = GetJson(NetRequestRetry(
Url:=Data.Input.BaseUrl & "/authenticate", Url:=Data.Input.BaseUrl & "/authenticate",
Method:="POST", Method:="POST",
Data:=RequestData.ToString(0), Data:=RequestData.ToString(0),
Headers:=LHeaders, Headers:=New Dictionary(Of String, String) From {{"Accept-Language", "zh_CN"}},
ContentType:="application/json; charset=utf-8")) ContentType:="application/json; charset=utf-8"))
'检查登录结果 '检查登录结果
If LoginJson("availableProfiles").Count = 0 Then If LoginJson("availableProfiles").Count = 0 Then
@@ -796,13 +785,19 @@ LoginFinish:
Catch ex As Exception Catch ex As Exception
Dim AllMessage As String = GetExceptionSummary(ex) Dim AllMessage As String = GetExceptionSummary(ex)
Log(ex, "登录失败原始错误信息", LogLevel.Normal) Log(ex, "登录失败原始错误信息", LogLevel.Normal)
'读取服务器返回的错误
If TypeOf ex Is ResponsedWebException Then
Dim ErrorMessage As String = Nothing
Try
ErrorMessage = GetJson(DirectCast(ex, ResponsedWebException).Response)("errorMessage")
Catch
End Try
If Not String.IsNullOrWhiteSpace(ErrorMessage) Then Throw New Exception("$登录失败:" & ErrorMessage)
End If
'通用关键字检测
If AllMessage.Contains("403") Then If AllMessage.Contains("403") Then
Select Case Data.Input.Type Select Case Data.Input.Type
Case McLoginType.Auth Case McLoginType.Auth
Dim ErrorResponse As AuthErrorResponse = ParseErrorResponse(ex)
If (ErrorResponse.errorMessage <> "") Then
Throw New Exception("$登录失败,以下为认证服务器提供的信息:" & vbCrLf & $" - {ErrorResponse.errorMessage}")
End If
Throw New Exception("$登录失败,以下为可能的原因:" & vbCrLf & Throw New Exception("$登录失败,以下为可能的原因:" & vbCrLf &
" - 输入的账号或密码错误。" & vbCrLf & " - 输入的账号或密码错误。" & vbCrLf &
" - 登录尝试过于频繁,导致被暂时屏蔽。请不要操作,等待 10 分钟后再试。" & vbCrLf & " - 登录尝试过于频繁,导致被暂时屏蔽。请不要操作,等待 10 分钟后再试。" & vbCrLf &
@@ -1349,20 +1344,28 @@ LoginFinish:
Dim WrapperPath As String = BaseDir & "\JavaWrapper.jar" Dim WrapperPath As String = BaseDir & "\JavaWrapper.jar"
Log("[Java] 选定的 Java Wrapper 路径:" & WrapperPath) Log("[Java] 选定的 Java Wrapper 路径:" & WrapperPath)
SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突 SyncLock ExtractJavaWrapperLock '避免 OptiFine 和 Forge 安装时同时释放 Java Wrapper 导致冲突
Dim IsWrapperWritten As Boolean = WriteFile(WrapperPath, GetResources("JavaWrapper")) Try
If Not IsWrapperWritten AndAlso File.Exists(WrapperPath) Then WriteFile(WrapperPath, GetResources("JavaWrapper"))
'以下为 #4243 的修复,因为未知原因 Java Wrapper 可能变为只读文件 Catch ex As Exception
Log("[Java] Java Wrapper 文件释放失败,但文件已存在,将在删除后尝试重新生成", LogLevel.Debug) If File.Exists(WrapperPath) Then
Try '因为未知原因 Java Wrapper 可能变为只读文件(#4243)
File.Delete(WrapperPath) Log(ex, "Java Wrapper 文件释放失败,但文件已存在,将在删除后尝试重新生成", LogLevel.Developer)
IsWrapperWritten = WriteFile(WrapperPath, GetResources("JavaWrapper")) Try
Catch ex As Exception File.Delete(WrapperPath)
Log(ex, "Java Wrapper 文件重新释放失败,将尝试更换文件名重新生成") WriteFile(WrapperPath, GetResources("JavaWrapper"))
WrapperPath = BaseDir & "\JavaWrapper2.jar" Catch ex2 As Exception
IsWrapperWritten = WriteFile(WrapperPath, GetResources("JavaWrapper")) Log(ex2, "Java Wrapper 文件重新释放失败,将尝试更换文件名重新生成", LogLevel.Developer)
End Try WrapperPath = BaseDir & "\JavaWrapper2.jar"
End If Try
If Not IsWrapperWritten Then Throw New FileNotFoundException("释放 Java Wrapper 失败,请查看 PCL 日志查找详细信息") WriteFile(WrapperPath, GetResources("JavaWrapper"))
Catch ex3 As Exception
Throw New FileNotFoundException("释放 Java Wrapper 最终尝试失败", ex3)
End Try
End Try
Else
Throw New FileNotFoundException("释放 Java Wrapper 失败", ex)
End If
End Try
End SyncLock End SyncLock
Return WrapperPath Return WrapperPath
End Function End Function
@@ -707,7 +707,7 @@ Finished:
End If End If
'读取文件 '读取文件
Dim data As New List(Of Byte) Dim data As New List(Of Byte)
For Each b As Byte In File.ReadAllBytes(Path) For Each b As Byte In ReadFileBytes(Path)
If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For If b = 9 OrElse b = 10 OrElse b = 13 OrElse b = 32 Then Continue For
data.Add(b) data.Add(b)
Next Next
@@ -1130,13 +1130,13 @@ Finished:
Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList() Mods = Mods.Where(Function(m) m.Comp IsNot Nothing).ToList()
Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存") Log($"[Mod] 联网获取本地 Mod 信息完成,为 {Mods.Count} 个 Mod 更新缓存")
If Not Mods.Any() Then Exit Sub If Not Mods.Any() Then Exit Sub
For Each Entry In Mods 'TODO: Bookshelf 的 Logo 会在两个网站间横跳 For Each Entry In Mods
Entry.CompLoaded = SucceedThreadCount = 2 Entry.CompLoaded = SucceedThreadCount = 2
Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson() Cache(Entry.ModrinthHash & McVersion & ModLoaders.Join("")) = Entry.ToJson()
Next Next
WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None))) WriteFile(PathTemp & "Cache\LocalMod.json", Cache.ToString(If(ModeDebug, Newtonsoft.Json.Formatting.Indented, Newtonsoft.Json.Formatting.None)))
'刷新下边栏(#4377) '刷新边栏
RunInUi(Sub() FrmVersionMod?.RefreshBottomBar()) RunInUi(Sub() FrmVersionMod?.RefreshBars())
End Sub End Sub
Private Function GetTargetModLoaders() As List(Of CompModLoaderType) Private Function GetTargetModLoaders() As List(Of CompModLoaderType)
Dim ModLoaders As New List(Of CompModLoaderType) Dim ModLoaders As New List(Of CompModLoaderType)
+7 -3
View File
@@ -98,8 +98,10 @@ Friend Module ModSecret
''' <summary> ''' <summary>
''' 设置 Headers 的 UA、Referer。 ''' 设置 Headers 的 UA、Referer。
''' </summary> ''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Client As CookieWebClient, Optional UseBrowserUserAgent As Boolean = False) Friend Sub SecretHeadersSign(Url As String, ByRef Client As WebClient, Optional UseBrowserUserAgent As Boolean = False)
If UseBrowserUserAgent Then If Url.Contains("modrinth.com") Then '根据 #4334,不添加 PCL 的 UA 反而能正常访问
Client.Headers("User-Agent") = "Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
ElseIf UseBrowserUserAgent Then
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36" Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else Else
Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode
@@ -111,7 +113,9 @@ Friend Module ModSecret
''' 设置 Headers 的 UA、Referer。 ''' 设置 Headers 的 UA、Referer。
''' </summary> ''' </summary>
Friend Sub SecretHeadersSign(Url As String, ByRef Request As HttpWebRequest, Optional UseBrowserUserAgent As Boolean = False) Friend Sub SecretHeadersSign(Url As String, ByRef Request As HttpWebRequest, Optional UseBrowserUserAgent As Boolean = False)
If UseBrowserUserAgent Then If Url.Contains("modrinth.com") Then '根据 #4334,不添加 PCL 的 UA 反而能正常访问
Request.UserAgent = "Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
ElseIf UseBrowserUserAgent Then
Request.UserAgent = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36" Request.UserAgent = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
Else Else
Request.UserAgent = "PCL2/" & VersionStandardCode Request.UserAgent = "PCL2/" & VersionStandardCode
@@ -51,6 +51,6 @@ Imports System.Runtime.InteropServices
' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号 ' 可以指定所有值,也可以使用以下所示的 "*" 预置版本号和修订号
' 方法是按如下所示使用“*” ' 方法是按如下所示使用“*”
<Assembly: AssemblyVersion("2.8.4.0")> <Assembly: AssemblyVersion("2.8.5.0")>
<Assembly: AssemblyFileVersion("2.8.4.0")> <Assembly: AssemblyFileVersion("2.8.5.0")>
<Assembly: NeutralResourcesLanguage("")> <Assembly: NeutralResourcesLanguage("")>
@@ -2021,7 +2021,7 @@ Sub(Task As LoaderTask(Of List(Of NetFile), Boolean))
If Request.LiteLoaderEntry IsNot Nothing Then LiteLoaderFolder = TempMcFolder & "versions\" & Request.MinecraftName & "-LiteLoader" If Request.LiteLoaderEntry IsNot Nothing Then LiteLoaderFolder = TempMcFolder & "versions\" & Request.MinecraftName & "-LiteLoader"
'判断 OptiFine 是否作为 Mod 进行下载 '判断 OptiFine 是否作为 Mod 进行下载
Dim MinecraftCode As Integer = If(Request.MinecraftName.Contains("."), Request.MinecraftName.Split(".")(1), 99) Dim MinecraftCode As Integer = If(Request.MinecraftName.Contains("."), Val(Request.MinecraftName.Split(".")(1)), 0)
Dim OptiFineAsMod As Boolean = Request.OptiFineEntry IsNot Nothing AndAlso '1. 选择了 OptiFine Dim OptiFineAsMod As Boolean = Request.OptiFineEntry IsNot Nothing AndAlso '1. 选择了 OptiFine
(Request.FabricVersion IsNot Nothing OrElse '2. 选择了 Fabric... (Request.FabricVersion IsNot Nothing OrElse '2. 选择了 Fabric...
(Request.ForgeEntry IsNot Nothing AndAlso MinecraftCode >= 14 AndAlso MinecraftCode <= 15)) '...或者 Forge 1.14~15(#4134) (Request.ForgeEntry IsNot Nothing AndAlso MinecraftCode >= 14 AndAlso MinecraftCode <= 15)) '...或者 Forge 1.14~15(#4134)
@@ -8,7 +8,7 @@
<StackPanel Orientation="Vertical" Margin="5"> <StackPanel Orientation="Vertical" Margin="5">
<local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="NeoForge 简介" x:Name="CardTip"> <local:MyCard Margin="20,20,20,0" Grid.IsSharedSizeScope="True" Title="NeoForge 简介" x:Name="CardTip">
<StackPanel Margin="25,40,15,20"> <StackPanel Margin="25,40,15,20">
<TextBlock Margin="0,0,0,11" Text="NeoForge 是支持 Minecraft 1.20.1 及以上的 Mod 加载器,你需要先安装它才能安装各种 NeoForge 模组。&#xa;本页面提供 NeoForge 安装器下载,在下载后你需要手动打开安装器进行安装。" TextWrapping="Wrap" /> <TextBlock Margin="0,0,0,11" Text="NeoForge 是 Minecraft 1.20.1+ 的 Mod 加载器,你需要先安装它才能安装各种 NeoForge 模组,它也兼容一些 Forge 模组。&#xa;本页面提供 NeoForge 安装器下载,在下载后你需要手动打开安装器进行安装。" TextWrapping="Wrap" />
<Grid Height="35"> <Grid Height="35">
<Grid.ColumnDefinitions> <Grid.ColumnDefinitions>
<ColumnDefinition Width="Auto" SharedSizeGroup="Button" /> <ColumnDefinition Width="Auto" SharedSizeGroup="Button" />
@@ -102,6 +102,10 @@ Download:
Log("[Page] 主页预设:Minecraft 皮肤推荐") Log("[Page] 主页预设:Minecraft 皮肤推荐")
Url = "https://forgepixel.com/pcl_sub_file" Url = "https://forgepixel.com/pcl_sub_file"
GoTo Download GoTo Download
Case 6
Log("[Page] 主页预设:OpenBMCLAPI 仪表盘 Lite")
Url = "https://pcl-bmcl.milulu.xyz/"
GoTo Download
End Select End Select
End Select End Select
RunInUi(Sub() LoadContent(Content)) RunInUi(Sub() LoadContent(Content))
@@ -99,7 +99,7 @@ Retry:
Client.DefaultRequestHeaders.UserAgent.Add(New Net.Http.Headers.ProductInfoHeaderValue("MojangSharp", "0.1")) Client.DefaultRequestHeaders.UserAgent.Add(New Net.Http.Headers.ProductInfoHeaderValue("MojangSharp", "0.1"))
Dim Contents As New Net.Http.MultipartFormDataContent From { Dim Contents As New Net.Http.MultipartFormDataContent From {
{New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"}, {New Net.Http.StringContent(If(SkinInfo.IsSlim, "slim", "classic")), "variant"},
{New Net.Http.ByteArrayContent(File.ReadAllBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)} {New Net.Http.ByteArrayContent(ReadFileBytes(SkinInfo.LocalFile)), "file", GetFileNameFromPath(SkinInfo.LocalFile)}
} }
Dim Result As String = Await (Await Client.PostAsync(New Uri("https://api.minecraftservices.com/minecraft/profile/skins"), Contents)).Content.ReadAsStringAsync Dim Result As String = Await (Await Client.PostAsync(New Uri("https://api.minecraftservices.com/minecraft/profile/skins"), Contents)).Content.ReadAsStringAsync
If Result.Contains("request requires user authentication") Then If Result.Contains("request requires user authentication") Then
@@ -107,7 +107,7 @@
{"ToolDownloadTranslate", New SetupEntry(0, Source:=SetupSource.Registry)}, {"ToolDownloadTranslate", New SetupEntry(0, Source:=SetupSource.Registry)},
{"ToolDownloadKeepModpack", New SetupEntry(False, Source:=SetupSource.Registry)}, {"ToolDownloadKeepModpack", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolDownloadIgnoreQuilt", New SetupEntry(True, Source:=SetupSource.Registry)}, {"ToolDownloadIgnoreQuilt", New SetupEntry(True, Source:=SetupSource.Registry)},
{"ToolDownloadCert", New SetupEntry(True, Source:=SetupSource.Registry)}, {"ToolDownloadCert", New SetupEntry(False, Source:=SetupSource.Registry)},
{"ToolDownloadMod", New SetupEntry(1, Source:=SetupSource.Registry)}, {"ToolDownloadMod", New SetupEntry(1, Source:=SetupSource.Registry)},
{"ToolUpdateAlpha", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)}, {"ToolUpdateAlpha", New SetupEntry(0, Source:=SetupSource.Registry, Encoded:=True)},
{"ToolUpdateRelease", New SetupEntry(False, Source:=SetupSource.Registry)}, {"ToolUpdateRelease", New SetupEntry(False, Source:=SetupSource.Registry)},
@@ -66,7 +66,7 @@
ToolTip="下载 Mod 时,若该 Mod 支持 Forge 和 Fabric,则显示为支持任意 Mod 加载器。&#xa;例如,开启时 JEI 显示支持全版本,关闭后 JEI 就会显示仅支持 Forge / Fabric 全版本。" /> ToolTip="下载 Mod 时,若该 Mod 支持 Forge 和 Fabric,则显示为支持任意 Mod 加载器。&#xa;例如,开启时 JEI 显示支持全版本,关闭后 JEI 就会显示仅支持 Forge / Fabric 全版本。" />
<local:MyCheckBox Margin="0,2,0,4" Text="验证 SSL 证书" Grid.Row="12" Height="22" Grid.ColumnSpan="2" <local:MyCheckBox Margin="0,2,0,4" Text="验证 SSL 证书" Grid.Row="12" Height="22" Grid.ColumnSpan="2"
x:Name="CheckDownloadCert" Tag="ToolDownloadCert" x:Name="CheckDownloadCert" Tag="ToolDownloadCert"
ToolTip="验证证书会提高安全性,但疑似有概率导致正版登录失败(#3018)。&#xa;如果在正版登录时因为 [根据验证过程,远程证书无效] 失败,可以尝试关闭此项。" /> ToolTip="开启验证会提高安全性、降低盗号风险(见 #2767),但也可能导致正版登录失败(见 #3018)。" />
</Grid> </Grid>
</StackPanel> </StackPanel>
</local:MyCard> </local:MyCard>
@@ -242,6 +242,7 @@
<local:MyComboBoxItem Content="简单主页(作者:MFn233)" /> <local:MyComboBoxItem Content="简单主页(作者:MFn233)" />
<local:MyComboBoxItem Content="每日整合包推荐(作者:wkea)" /> <local:MyComboBoxItem Content="每日整合包推荐(作者:wkea)" />
<local:MyComboBoxItem Content="Minecraft 皮肤推荐(作者:wkea)" /> <local:MyComboBoxItem Content="Minecraft 皮肤推荐(作者:wkea)" />
<local:MyComboBoxItem Content="OpenBMCLAPI 仪表盘 Lite(作者:Silverteal、Mxmilu666)" />
</local:MyComboBox> </local:MyComboBox>
</Grid> </Grid>
</StackPanel> </StackPanel>
@@ -96,7 +96,7 @@
Catch ex As Exception Catch ex As Exception
Log(ex, "强制刷新时清理本地 Mod 信息缓存失败") Log(ex, "强制刷新时清理本地 Mod 信息缓存失败")
End Try End Try
If FrmVersionMod IsNot Nothing Then FrmVersionMod.RefreshList(True) '无需 Else,还没加载刷个鬼的新 If FrmVersionMod IsNot Nothing Then FrmVersionMod.ReloadModList(True) '无需 Else,还没加载刷个鬼的新
ItemMod.Checked = True ItemMod.Checked = True
Hint("正在刷新……", Log:=False) Hint("正在刷新……", Log:=False)
End Sub End Sub
@@ -7,8 +7,7 @@
<Grid> <Grid>
<Grid x:Name="PanAllBack"> <Grid x:Name="PanAllBack">
<local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack"> <local:MyScrollViewer VerticalScrollBarVisibility="Auto" HorizontalScrollBarVisibility="Disabled" x:Name="PanBack">
<StackPanel x:Name="PanMain" Margin="25,10,25,10" Grid.IsSharedSizeScope="True"> <StackPanel x:Name="PanMain" Margin="25,10,25,10" Grid.IsSharedSizeScope="True"> <!-- 若显示多选模块则为 92 -->
<!-- 若显示多选模块则为 92 -->
<local:MySearchBox Margin="0,15" HintText="搜索 Mod 名称 / 描述 / 标签" x:Name="SearchBox" /> <local:MySearchBox Margin="0,15" HintText="搜索 Mod 名称 / 描述 / 标签" x:Name="SearchBox" />
<local:MyCard Grid.Row="0" Margin="0,0,0,15" x:Name="PanManage"> <local:MyCard Grid.Row="0" Margin="0,0,0,15" x:Name="PanManage">
<Grid Margin="15,15,0,15" Height="35"> <Grid Margin="15,15,0,15" Height="35">
@@ -24,19 +23,15 @@
<local:MyButton x:Name="BtnManageCheck" Grid.Column="3" MinWidth="140" Text="检查 Mod" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ToolTip="快速检查 Mod 的版本要求、重复、前置缺失等问题。&#xa;结果仅供参考,由于部分 Mod 标注的信息有误,可能并不准确。" Visibility="Collapsed" /> <local:MyButton x:Name="BtnManageCheck" Grid.Column="3" MinWidth="140" Text="检查 Mod" Padding="13,0" Margin="0,0,20,0" HorizontalAlignment="Left" ToolTip="快速检查 Mod 的版本要求、重复、前置缺失等问题。&#xa;结果仅供参考,由于部分 Mod 标注的信息有误,可能并不准确。" Visibility="Collapsed" />
</Grid> </Grid>
</local:MyCard> </local:MyCard>
<local:MyCard x:Name="PanListBack" VerticalAlignment="Top" Opacity="0" Margin="0,0,0,15" Title=" " MinHeight="40"> <local:MyCard x:Name="PanListBack" VerticalAlignment="Top" Opacity="0" Margin="0,0,0,14" Title=" " MinHeight="55">
<StackPanel Margin="0,8,9,0" Orientation="Horizontal" VerticalAlignment="Top" HorizontalAlignment="Right" Height="24"> <StackPanel x:Name="PanFilter" Margin="15,13,0,0" Orientation="Horizontal" VerticalAlignment="Top" HorizontalAlignment="Left" Height="28">
<local:MyRadioButton VerticalAlignment="Center" Height="24" Margin="2,0" Text="全部" x:Name="BtnTypeAll" ColorType="Highlight" Checked="True"/> <local:MyRadioButton Tag="0" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="全部" x:Name="BtnFilterAll" Checked="True" />
<TextBlock Text="|" Foreground="{StaticResource ColorBrushGray1}" VerticalAlignment="Center"/> <local:MyRadioButton Tag="1" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="已启用" x:Name="BtnFilterEnabled" />
<local:MyRadioButton VerticalAlignment="Center" Height="24" Margin="2,0" Text="已启用" x:Name="BtnTypeEnabled" ColorType="Highlight"/> <local:MyRadioButton Tag="2" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="已禁用" x:Name="BtnFilterDisabled" />
<TextBlock Text="|" Foreground="{StaticResource ColorBrushGray1}" VerticalAlignment="Center"/> <local:MyRadioButton Tag="3" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="可更新" x:Name="BtnFilterCanUpdate" />
<local:MyRadioButton VerticalAlignment="Center" Height="24" Margin="2,0" Text="已禁用" x:Name="BtnTypeDisabled" ColorType="Highlight"/> <local:MyRadioButton Tag="4" ColorType="Highlight" VerticalAlignment="Center" Margin="2,0" Text="错误" x:Name="BtnFilterError" />
<TextBlock Text="|" Foreground="{StaticResource ColorBrushGray1}" VerticalAlignment="Center"/>
<local:MyRadioButton VerticalAlignment="Center" Height="24" Margin="2,0" Text="可更新" x:Name="BtnTypeCanUpdate" ColorType="Highlight"/>
<TextBlock Text="|" Foreground="{StaticResource ColorBrushGray1}" VerticalAlignment="Center"/>
<local:MyRadioButton VerticalAlignment="Center" Height="24" Margin="2,0" Text="错误" x:Name="BtnTypeError" ColorType="Highlight"/>
</StackPanel> </StackPanel>
<StackPanel Margin="20,38,18,18" Name="PanList" VerticalAlignment="Top" /> <StackPanel Margin="20,48,18,22" Name="PanList" VerticalAlignment="Top" />
</local:MyCard> </local:MyCard>
</StackPanel> </StackPanel>
</local:MyScrollViewer> </local:MyScrollViewer>
@@ -4,16 +4,11 @@
Private IsLoad As Boolean = False Private IsLoad As Boolean = False
Public Sub PageOther_Loaded() Handles Me.Loaded Public Sub PageOther_Loaded() Handles Me.Loaded
BtnTypeAll.Tag = ViewType.All
BtnTypeEnabled.Tag = ViewType.Enabled
BtnTypeDisabled.Tag = ViewType.Disabled
BtnTypeCanUpdate.Tag = ViewType.CanUpdate
BtnTypeError.Tag = ViewType.InError
If FrmMain.PageLast.Page <> FormMain.PageType.CompDetail Then PanBack.ScrollToHome() If FrmMain.PageLast.Page <> FormMain.PageType.CompDetail Then PanBack.ScrollToHome()
AniControlEnabled += 1 AniControlEnabled += 1
SelectedMods.Clear() SelectedMods.Clear()
RefreshList() ReloadModList()
ChangeAllSelected(False) ChangeAllSelected(False)
AniControlEnabled -= 1 AniControlEnabled -= 1
@@ -21,6 +16,11 @@
If IsLoad Then Exit Sub If IsLoad Then Exit Sub
IsLoad = True IsLoad = True
'调整按钮边距(这玩意儿没法从 XAML 改)
For Each Btn As MyRadioButton In PanFilter.Children
Btn.LabText.Margin = New Thickness(-2, 0, 8, 0)
Next
#If DEBUG Then #If DEBUG Then
BtnManageCheck.Visibility = Visibility.Visible BtnManageCheck.Visibility = Visibility.Visible
#End If #End If
@@ -29,11 +29,10 @@
''' <summary> ''' <summary>
''' 刷新 Mod 列表。 ''' 刷新 Mod 列表。
''' </summary> ''' </summary>
Public Sub RefreshList(Optional ForceReload As Boolean = False) Public Sub ReloadModList(Optional ForceReload As Boolean = False)
If LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then If LoaderFolderRun(McModLoader, PageVersionLeft.Version.PathIndie & "mods\", If(ForceReload, LoaderFolderRunType.ForceRun, LoaderFolderRunType.RunOnUpdated)) Then
Log("[System] 已刷新 Mod 列表") Log("[System] 已刷新 Mod 列表")
ViewModType = ViewType.All Filter = FilterType.All
BtnTypeAll.Checked = True
PanBack.ScrollToHome() PanBack.ScrollToHome()
SearchBox.Text = "" SearchBox.Text = ""
End If End If
@@ -60,10 +59,9 @@
''' 将加载器结果的 Mod 列表加载为 UI。 ''' 将加载器结果的 Mod 列表加载为 UI。
''' </summary> ''' </summary>
Private Sub LoadUIFromLoaderOutput() Private Sub LoadUIFromLoaderOutput()
Dim Mods As List(Of McMod) = McModLoader.Output
Try Try
'判断应该显示哪一个页面 '判断应该显示哪一个页面
If Mods.Any() Then If McModLoader.Output.Any() Then
PanBack.Visibility = Visibility.Visible PanBack.Visibility = Visibility.Visible
PanEmpty.Visibility = Visibility.Collapsed PanEmpty.Visibility = Visibility.Collapsed
Else Else
@@ -71,13 +69,15 @@
PanBack.Visibility = Visibility.Collapsed PanBack.Visibility = Visibility.Collapsed
Exit Sub Exit Sub
End If End If
'输出结果 '修改缓存
ModItems.Clear() ModItems.Clear()
For Each ModEntity As McMod In Mods For Each ModEntity As McMod In McModLoader.Output
ModItems(ModEntity.RawFileName) = McModListItem(ModEntity) ModItems(ModEntity.RawFileName) = McModListItem(ModEntity)
Next Next
'显示结果
Filter = FilterType.All
SearchBox.Text = "" '这会触发结果刷新,所以需要在 ModItems 更新之后,详见 #3124 的视频 SearchBox.Text = "" '这会触发结果刷新,所以需要在 ModItems 更新之后,详见 #3124 的视频
RefreshResult(Mods) RefreshUI()
Catch ex As Exception Catch ex As Exception
Log(ex, "加载 Mod 列表 UI 失败", LogLevel.Feedback) Log(ex, "加载 Mod 列表 UI 失败", LogLevel.Feedback)
End Try End Try
@@ -129,86 +129,138 @@
End Sub End Sub
''' <summary> ''' <summary>
''' 刷新结果显示。 ''' 刷新整个 UI。
''' </summary> ''' </summary>
Private Sub RefreshResult(Mods As List(Of McMod)) Public Sub RefreshUI()
If PanList Is Nothing Then Exit Sub If PanList Is Nothing Then Exit Sub
Dim ShowMods As List(Of McMod) = New List(Of McMod) Dim ShowMods = GetShowingMods(True).ToList()
Select Case ViewModType '重新列出列表
Case ViewType.All AniControlEnabled += 1
ShowMods = Mods If ShowMods.Any() Then
Case ViewType.Enabled PanList.Visibility = Visibility.Visible
For Each Item In Mods PanList.Children.Clear()
If Item.State.Equals(McMod.McModState.Fine) Then ShowMods.Add(Item) For Each TargetMod In ShowMods
Next Dim Item As MyLocalModItem = ModItems(TargetMod.RawFileName)
Case ViewType.Disabled Item.Checked = SelectedMods.Contains(TargetMod.RawFileName) '更新选中状态
For Each Item In Mods PanList.Children.Add(Item)
If Item.State.Equals(McMod.McModState.Disabled) Then ShowMods.Add(Item) Next
Next
Case ViewType.CanUpdate
For Each Item In Mods
If Item.CanUpdate Then ShowMods.Add(Item)
Next
Case ViewType.InError
For Each Item In Mods
If Item.State.Equals(McMod.McModState.Unavaliable) Then ShowMods.Add(Item)
Next
End Select
PanList.Children.Clear()
For Each TargetMod In ShowMods
PanList.Children.Add(ModItems(TargetMod.RawFileName))
Next
Dim ModEnabled As Integer = 0
Dim ModDisabled As Integer = 0
Dim ModCanUpdate As Integer = 0
Dim ModError As Integer = 0
For Each ModItem In ModItems
If ModItem.Value.Entry.CanUpdate Then
ModCanUpdate += 1
End If
If ModItem.Value.Entry.State.Equals(McMod.McModState.Fine) Then
ModEnabled += 1
End If
If ModItem.Value.Entry.State.Equals(McMod.McModState.Disabled) Then
ModDisabled += 1
End If
If ModItem.Value.Entry.State.Equals(McMod.McModState.Unavaliable) Then
ModError += 1
End If
Next
BtnTypeAll.Text = $"全部 ({ModEnabled + ModDisabled + ModError}) "
BtnTypeCanUpdate.Text = $"可更新 ({ModCanUpdate}) "
BtnTypeEnabled.Text = $"已启用 ({ModEnabled}) "
BtnTypeDisabled.Text = $"已禁用 ({ModDisabled}) "
BtnTypeError.Text = $"错误 ({ModError}) "
RefreshTitle()
End Sub
''' <summary>
''' 刷新卡片标题。
''' </summary>
Private Sub RefreshTitle()
If Not IsSearching Then
PanListBack.Title = "Mod 列表 - "
ElseIf PanList.Children.Count > 0 Then
PanListBack.Title = "搜索结果 - "
Else Else
PanListBack.Title = "无搜索结果 - " PanList.Visibility = Visibility.Collapsed
End If End If
Select Case ViewModType AniControlEnabled -= 1
Case ViewType.All SelectedMods = SelectedMods.Where(Function(m) ShowMods.Any(Function(s) s.RawFileName = m)).ToList '取消选中已经不显示的 Mod
PanListBack.Title += BtnTypeAll.Text RefreshBars()
Case ViewType.Enabled
PanListBack.Title += BtnTypeEnabled.Text
Case ViewType.Disabled
PanListBack.Title += BtnTypeDisabled.Text
Case ViewType.CanUpdate
PanListBack.Title += BtnTypeCanUpdate.Text
Case ViewType.InError
PanListBack.Title += BtnTypeError.Text
End Select
PanList.Visibility = If(PanList.Children.Count > 0, Visibility.Visible, Visibility.Collapsed)
End Sub End Sub
''' <summary>
''' 刷新顶栏和底栏显示。
''' </summary>
Public Sub RefreshBars()
'-----------------
' 顶部栏
'-----------------
'计数
Dim AnyCount As Integer = 0
Dim EnabledCount As Integer = 0
Dim DisabledCount As Integer = 0
Dim UpdateCount As Integer = 0
Dim UnavalialeCount As Integer = 0
For Each ModItem In GetShowingMods(False)
AnyCount += 1
If ModItem.CanUpdate Then UpdateCount += 1
If ModItem.State.Equals(McMod.McModState.Fine) Then EnabledCount += 1
If ModItem.State.Equals(McMod.McModState.Disabled) Then DisabledCount += 1
If ModItem.State.Equals(McMod.McModState.Unavaliable) Then UnavalialeCount += 1
Next
'显示
BtnFilterAll.Text = If(IsSearching, "搜索结果", "全部") & $" ({AnyCount})"
BtnFilterCanUpdate.Text = $"可更新 ({UpdateCount})"
BtnFilterCanUpdate.Visibility = If(Filter = FilterType.CanUpdate OrElse
UpdateCount > 0, Visibility.Visible, Visibility.Collapsed)
BtnFilterEnabled.Text = $"启用 ({EnabledCount})"
BtnFilterEnabled.Visibility = If(Filter = FilterType.Enabled OrElse Filter = FilterType.Disabled OrElse
EnabledCount > 0 AndAlso EnabledCount <> AnyCount, Visibility.Visible, Visibility.Collapsed)
BtnFilterDisabled.Text = $"禁用 ({DisabledCount})"
BtnFilterDisabled.Visibility = If(Filter = FilterType.Enabled OrElse Filter = FilterType.Disabled OrElse
DisabledCount > 0, Visibility.Visible, Visibility.Collapsed)
BtnFilterError.Text = $"错误 ({UnavalialeCount})"
BtnFilterError.Visibility = If(Filter = FilterType.Unavaliable OrElse
UnavalialeCount > 0, Visibility.Visible, Visibility.Collapsed)
'-----------------
' 底部栏
'-----------------
'计数
Dim NewCount As Integer = SelectedMods.Count
Dim Selected = NewCount > 0
If Selected Then LabSelect.Text = $"已选择 {NewCount} 个文件" '取消所有选择时不更新数字
'按钮可用性
If Selected Then
Dim HasUpdate As Boolean = False
Dim HasEnabled As Boolean = False
Dim HasDisabled As Boolean = False
For Each ModEntity In McModLoader.Output
If SelectedMods.Contains(ModEntity.RawFileName) Then
If ModEntity.CanUpdate Then HasUpdate = True
If ModEntity.State = McMod.McModState.Fine Then
HasEnabled = True
ElseIf ModEntity.State = McMod.McModState.Disabled Then
HasDisabled = True
End If
End If
Next
BtnSelectDisable.IsEnabled = HasEnabled
BtnSelectEnable.IsEnabled = HasDisabled
BtnSelectUpdate.IsEnabled = HasUpdate
End If
'更新显示状态
If AniControlEnabled = 0 Then
PanListBack.Margin = New Thickness(0, 0, 0, If(Selected, 95, 15))
If Selected Then
'仅在数量增加时播放出现/跳跃动画
If BottomBarShownCount >= NewCount Then
BottomBarShownCount = NewCount
Return
Else
BottomBarShownCount = NewCount
End If
'出现/跳跃动画
CardSelect.Visibility = Visibility.Visible
AniStart({
AaOpacity(CardSelect, 1 - CardSelect.Opacity, 60),
AaTranslateY(CardSelect, -27 - TransSelect.Y, 120, Ease:=New AniEaseOutFluent(AniEasePower.Weak)),
AaTranslateY(CardSelect, 3, 150, 120, Ease:=New AniEaseInoutFluent(AniEasePower.Weak)),
AaTranslateY(CardSelect, -1, 90, 270, Ease:=New AniEaseInoutFluent(AniEasePower.Weak))
}, "Mod Sidebar")
Else
'不重复播放隐藏动画
If BottomBarShownCount = 0 Then Return
BottomBarShownCount = 0
'隐藏动画
AniStart({
AaOpacity(CardSelect, -CardSelect.Opacity, 90),
AaTranslateY(CardSelect, -10 - TransSelect.Y, 90, Ease:=New AniEaseInFluent(AniEasePower.Weak)),
AaCode(Sub() CardSelect.Visibility = Visibility.Collapsed, After:=True)
}, "Mod Sidebar")
End If
Else
AniStop("Mod Sidebar")
BottomBarShownCount = NewCount
If Selected Then
CardSelect.Visibility = Visibility.Visible
CardSelect.Opacity = 1
TransSelect.Y = -25
Else
CardSelect.Visibility = Visibility.Collapsed
CardSelect.Opacity = 0
TransSelect.Y = -10
End If
End If
End Sub
Private BottomBarShownCount As Integer = 0
#End Region #End Region
#Region "管理" #Region "管理"
@@ -247,15 +299,7 @@
''' 全选。 ''' 全选。
''' </summary> ''' </summary>
Private Sub BtnManageSelectAll_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageSelectAll.Click Private Sub BtnManageSelectAll_Click(sender As Object, e As MouseButtonEventArgs) Handles BtnManageSelectAll.Click
Dim CurrentSelected As Integer = 0 ChangeAllSelected(SelectedMods.Count < GetShowingMods(True).Count)
For Each Item In PanList.Children.OfType(Of MyLocalModItem).ToList
If Item.Checked Then CurrentSelected += 1
Next
If CurrentSelected < PanList.Children.Count Then
ChangeCurrentSelected(True)
Else
ChangeCurrentSelected(False)
End If
End Sub End Sub
''' <summary> ''' <summary>
@@ -282,110 +326,20 @@
Else Else
SelectedMods.Remove(SelectedKey) SelectedMods.Remove(SelectedKey)
End If End If
'更新下边栏 UI RefreshBars()
RefreshBottomBar()
End Sub
'改变下边栏状态
Private ShownCount As Integer = 0
Public Sub RefreshBottomBar()
'计数
Dim NewCount As Integer = SelectedMods.Count
Dim Selected = NewCount > 0
If Selected Then LabSelect.Text = $"已选择 {NewCount} 个文件" '取消所有选择时不更新数字
'按钮可用性
If Selected Then
Dim HasUpdate As Boolean = False
Dim HasEnabled As Boolean = False
Dim HasDisabled As Boolean = False
For Each ModEntity In McModLoader.Output
If SelectedMods.Contains(ModEntity.RawFileName) Then
If ModEntity.CanUpdate Then HasUpdate = True
If ModEntity.State = McMod.McModState.Fine Then
HasEnabled = True
ElseIf ModEntity.State = McMod.McModState.Disabled Then
HasDisabled = True
End If
End If
Next
BtnSelectDisable.IsEnabled = HasEnabled
BtnSelectEnable.IsEnabled = HasDisabled
BtnSelectUpdate.IsEnabled = HasUpdate
End If
'更新显示状态
If AniControlEnabled = 0 Then
If Selected Then
PanListBack.Margin = New Thickness(0, 0, 0, 95)
'仅在数量增加时播放出现/跳跃动画
If ShownCount >= NewCount Then
ShownCount = NewCount
Return
Else
ShownCount = NewCount
End If
'出现/跳跃动画
CardSelect.Visibility = Visibility.Visible
AniStart({
AaOpacity(CardSelect, 1 - CardSelect.Opacity, 60),
AaTranslateY(CardSelect, -27 - TransSelect.Y, 120, Ease:=New AniEaseOutFluent(AniEasePower.Weak)),
AaTranslateY(CardSelect, 3, 150, 120, Ease:=New AniEaseInoutFluent(AniEasePower.Weak)),
AaTranslateY(CardSelect, -1, 90, 270, Ease:=New AniEaseInoutFluent(AniEasePower.Weak))
}, "Mod Sidebar")
Else
PanListBack.Margin = New Thickness(0, 0, 0, 15)
'不重复播放隐藏动画
If ShownCount = 0 Then Return
ShownCount = 0
'隐藏动画
AniStart({
AaOpacity(CardSelect, -CardSelect.Opacity, 90),
AaTranslateY(CardSelect, -10 - TransSelect.Y, 90, Ease:=New AniEaseInFluent(AniEasePower.Weak)),
AaCode(Sub() CardSelect.Visibility = Visibility.Collapsed, After:=True)
}, "Mod Sidebar")
End If
Else
AniStop("Mod Sidebar")
ShownCount = NewCount
If Selected Then
CardSelect.Visibility = Visibility.Visible
CardSelect.Opacity = 1
TransSelect.Y = -25
Else
CardSelect.Visibility = Visibility.Collapsed
CardSelect.Opacity = 0
TransSelect.Y = -10
End If
End If
End Sub End Sub
'切换所有项的选择状态 '切换所有项的选择状态
Private Sub ChangeAllSelected(Value As Boolean) Private Sub ChangeAllSelected(Value As Boolean)
AniControlEnabled += 1 AniControlEnabled += 1
SelectedMods.Clear() SelectedMods.Clear()
For Each Item As MyLocalModItem In ModItems.Values.ToList For Each Item As MyLocalModItem In GetShowingMods(True).Select(Function(m) ModItems(m.RawFileName))
Item.Checked = Value Item.Checked = Value
If Value Then SelectedMods.Add(Item.Entry.RawFileName) If Value Then SelectedMods.Add(Item.Entry.RawFileName)
Next Next
AniControlEnabled -= 1 AniControlEnabled -= 1
'更新下边栏 UI RefreshBars()
RefreshBottomBar()
End Sub End Sub
Private Sub ChangeCurrentSelected(Value As Boolean)
AniControlEnabled += 1
For Each Item As MyLocalModItem In PanList.Children
Item.Checked = Value
If Value Then
If Not SelectedMods.Contains(Item.Entry.RawFileName) Then SelectedMods.Add(Item.Entry.RawFileName)
Else
If SelectedMods.Contains(Item.Entry.RawFileName) Then SelectedMods.Remove(Item.Entry.RawFileName)
End If
Next
AniControlEnabled -= 1
'更新下边栏 UI
RefreshBottomBar()
End Sub
Private Sub UnselectedAllWithAnimation() Handles Load.StateChanged, Me.PageExit Private Sub UnselectedAllWithAnimation() Handles Load.StateChanged, Me.PageExit
Dim CacheAniControlEnabled = AniControlEnabled Dim CacheAniControlEnabled = AniControlEnabled
AniControlEnabled = 0 AniControlEnabled = 0
@@ -393,26 +347,76 @@
AniControlEnabled += CacheAniControlEnabled AniControlEnabled += CacheAniControlEnabled
End Sub End Sub
Private Sub PageVersionMod_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown Private Sub PageVersionMod_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
If My.Computer.Keyboard.CtrlKeyDown AndAlso e.Key = Key.A Then ChangeCurrentSelected(True) If My.Computer.Keyboard.CtrlKeyDown AndAlso e.Key = Key.A Then ChangeAllSelected(True)
End Sub End Sub
Private ViewModType As ViewType = ViewType.All #End Region
Private Enum ViewType As Integer #Region "筛选"
All
Enabled Private _Filter As FilterType = FilterType.All
Disabled Private Property Filter As FilterType
CanUpdate Get
InError Return _Filter
End Get
Set(value As FilterType)
If _Filter = value Then Return
_Filter = value
Select Case value
Case FilterType.All
BtnFilterAll.Checked = True
Case FilterType.Enabled
BtnFilterEnabled.Checked = True
Case FilterType.Disabled
BtnFilterDisabled.Checked = True
Case FilterType.CanUpdate
BtnFilterCanUpdate.Checked = True
Case Else
BtnFilterError.Checked = True
End Select
RefreshUI()
End Set
End Property
Private Enum FilterType As Integer
All = 0
Enabled = 1
Disabled = 2
CanUpdate = 3
Unavaliable = 4
End Enum End Enum
Private Sub ChangeViewType(sender As MyRadioButton, raiseByMouse As Boolean) Handles BtnTypeAll.Check, BtnTypeCanUpdate.Check, BtnTypeDisabled.Check, BtnTypeEnabled.Check, BtnTypeError.Check ''' <summary>
ViewModType = sender.Tag ''' 获取所有应该显示在 UI 中的 Mod。
If IsSearching Then ''' </summary>
SearchRun() Private Function GetShowingMods(ApplyFilter As Boolean) As IEnumerable(Of McMod)
Else If McModLoader.Output Is Nothing Then Return New List(Of McMod)
RefreshResult(McModLoader.Output) Return If(IsSearching, SearchResult, McModLoader.Output).Where(Function(m) Not ApplyFilter OrElse CanPassFilter(m))
End If End Function
''' <summary>
''' 检查该 Mod 项是否符合当前筛选的类别。
''' </summary>
Private Function CanPassFilter(CheckingMod As McMod) As Boolean
Select Case Filter
Case FilterType.All
Return True
Case FilterType.Enabled
Return CheckingMod.State = McMod.McModState.Fine
Case FilterType.Disabled
Return CheckingMod.State = McMod.McModState.Disabled
Case FilterType.CanUpdate
Return CheckingMod.CanUpdate
Case FilterType.Unavaliable
Return CheckingMod.State = McMod.McModState.Unavaliable
Case Else
Return False
End Select
End Function
'点击筛选项触发的改变
Private Sub ChangeFilter(sender As MyRadioButton, raiseByMouse As Boolean) Handles BtnFilterAll.Check, BtnFilterCanUpdate.Check, BtnFilterDisabled.Check, BtnFilterEnabled.Check, BtnFilterError.Check
Filter = sender.Tag
RefreshUI()
End Sub End Sub
#End Region #End Region
@@ -424,7 +428,6 @@
EDMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)), EDMods(McModLoader.Output.Where(Function(m) SelectedMods.Contains(m.RawFileName)),
Not sender.Equals(BtnSelectDisable)) Not sender.Equals(BtnSelectDisable))
ChangeAllSelected(False) ChangeAllSelected(False)
RefreshResult(McModLoader.Output)
End Sub End Sub
Private Sub EDMods(ModList As IEnumerable(Of McMod), IsEnable As Boolean) Private Sub EDMods(ModList As IEnumerable(Of McMod), IsEnable As Boolean)
Dim IsSuccessful As Boolean = True Dim IsSuccessful As Boolean = True
@@ -459,7 +462,7 @@
FileSystem.Rename(ModEntity.Path, NewPath) FileSystem.Rename(ModEntity.Path, NewPath)
Catch ex As FileNotFoundException Catch ex As FileNotFoundException
Log(ex, $"未找到需要重命名的 Mod({If(ModEntity.Path, "null")})", LogLevel.Feedback) Log(ex, $"未找到需要重命名的 Mod({If(ModEntity.Path, "null")})", LogLevel.Feedback)
RefreshList(True) ReloadModList(True)
Return Return
Catch ex As Exception Catch ex As Exception
Log(ex, $"重命名 Mod 失败({If(ModEntity.Path, "null")})") Log(ex, $"重命名 Mod 失败({If(ModEntity.Path, "null")})")
@@ -479,12 +482,11 @@
PanList.Children.RemoveAt(IndexOfUi) PanList.Children.RemoveAt(IndexOfUi)
PanList.Children.Insert(IndexOfUi, NewItem) PanList.Children.Insert(IndexOfUi, NewItem)
Next Next
RefreshTitle() '改变数量显示 If IsSuccessful Then
If Not IsSuccessful Then RefreshBars()
Hint("由于文件被占用,Mod 的状态切换失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical)
RefreshList(True)
Else Else
RefreshBottomBar() Hint("由于文件被占用,Mod 的状态切换失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical)
ReloadModList(True)
End If End If
End Sub End Sub
@@ -601,7 +603,7 @@
LoaderTaskbarAdd(Loader) LoaderTaskbarAdd(Loader)
FrmMain.BtnExtraDownload.ShowRefresh() FrmMain.BtnExtraDownload.ShowRefresh()
FrmMain.BtnExtraDownload.Ribble() FrmMain.BtnExtraDownload.Ribble()
RefreshList(True) ReloadModList(True)
Catch ex As Exception Catch ex As Exception
Log(ex, "初始化 Mod 更新失败") Log(ex, "初始化 Mod 更新失败")
End Try End Try
@@ -635,7 +637,7 @@
End If End If
Catch ex As OperationCanceledException Catch ex As OperationCanceledException
Log(ex, "删除 Mod 被主动取消") Log(ex, "删除 Mod 被主动取消")
RefreshList(True) ReloadModList(True)
Return Return
Catch ex As Exception Catch ex As Exception
Log(ex, $"删除 Mod 失败({ModEntity.Path})", LogLevel.Msgbox) Log(ex, $"删除 Mod 失败({ModEntity.Path})", LogLevel.Msgbox)
@@ -649,14 +651,14 @@
Dim IndexOfUi As Integer = PanList.Children.IndexOf(PanList.Children.OfType(Of MyLocalModItem).FirstOrDefault(Function(i) i.Entry.Equals(ModEntity))) Dim IndexOfUi As Integer = PanList.Children.IndexOf(PanList.Children.OfType(Of MyLocalModItem).FirstOrDefault(Function(i) i.Entry.Equals(ModEntity)))
If IndexOfUi >= 0 Then PanList.Children.RemoveAt(IndexOfUi) If IndexOfUi >= 0 Then PanList.Children.RemoveAt(IndexOfUi)
Next Next
RefreshTitle() RefreshBars()
If Not IsSuccessful Then If Not IsSuccessful Then
Hint("由于文件被占用,Mod 删除失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical) Hint("由于文件被占用,Mod 删除失败,请尝试关闭正在运行的游戏后再试!", HintType.Critical)
RefreshList(True) ReloadModList(True)
ElseIf PanList.Children.Count = 0 Then ElseIf PanList.Children.Count = 0 Then
RefreshList(True) '删除了全部文件 ReloadModList(True) '删除了全部文件
Else Else
RefreshBottomBar() RefreshBars()
End If End If
'显示结果提示 '显示结果提示
If Not IsSuccessful Then Exit Sub If Not IsSuccessful Then Exit Sub
@@ -675,10 +677,10 @@
End If End If
Catch ex As OperationCanceledException Catch ex As OperationCanceledException
Log(ex, "删除 Mod 被主动取消") Log(ex, "删除 Mod 被主动取消")
RefreshList(True) ReloadModList(True)
Catch ex As Exception Catch ex As Exception
Log(ex, "删除 Mod 出现未知错误", LogLevel.Feedback) Log(ex, "删除 Mod 出现未知错误", LogLevel.Feedback)
RefreshList(True) ReloadModList(True)
End Try End Try
End Sub End Sub
@@ -791,8 +793,8 @@
Return Not String.IsNullOrWhiteSpace(SearchBox.Text) Return Not String.IsNullOrWhiteSpace(SearchBox.Text)
End Get End Get
End Property End Property
Private SearchResult As List(Of McMod)
Public Sub SearchRun() Handles SearchBox.TextChanged Public Sub SearchRun() Handles SearchBox.TextChanged
ChangeAllSelected(False)
If IsSearching Then If IsSearching Then
'构造请求 '构造请求
Dim QueryList As New List(Of SearchEntry(Of McMod)) Dim QueryList As New List(Of SearchEntry(Of McMod))
@@ -815,12 +817,9 @@
QueryList.Add(New SearchEntry(Of McMod) With {.Item = Entry, .SearchSource = SearchSource}) QueryList.Add(New SearchEntry(Of McMod) With {.Item = Entry, .SearchSource = SearchSource})
Next Next
'进行搜索 '进行搜索
Dim SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=6, MinBlurSimilarity:=0.35) SearchResult = Search(QueryList, SearchBox.Text, MaxBlurCount:=6, MinBlurSimilarity:=0.35).Select(Function(r) r.Item).ToList
RefreshResult(SearchResult.Select(Function(r) r.Item).ToList)
Else
'退出搜索状态
RefreshResult(McModLoader.Output)
End If End If
RefreshUI()
End Sub End Sub
#End Region #End Region
+2 -2
View File
@@ -3234,7 +3234,7 @@ memory-cleaner-mod|内存自动清理*
ore-flowers|矿物花卉* ore-flowers|矿物花卉*
aqua-creepers|水下苦力怕 (Aqua Creepers!) aqua-creepers|水下苦力怕 (Aqua Creepers!)
extrastorage|更多存储 (ExtraStorage) extrastorage|更多存储 (ExtraStorage)
thermal-locomotion@thermal-integration|热力运输* thermal-locomotion|热力运输*
external-tweaker external-tweaker
morebiomesxl morebiomesxl
notes@|笔记* notes@|笔记*
@@ -3821,7 +3821,7 @@ cat-jammies
rhino@|犀牛* rhino@|犀牛*
fastsuite|配方性能优化 (FastSuite) fastsuite|配方性能优化 (FastSuite)
twerkitmeal|跳舞生长一切 (Twerk To Grow All The Things) twerkitmeal|跳舞生长一切 (Twerk To Grow All The Things)
thermal-integration@thermal-locomotion|热力集成* thermal-integration|热力集成*
piggybanks|存钱罐* piggybanks|存钱罐*
in-control@ in-control@
mystical-agriculture-refabricated|神秘农业:Fabric版 (Mystical Agriculture: Refabricated) mystical-agriculture-refabricated|神秘农业:Fabric版 (Mystical Agriculture: Refabricated)