ModSecret.vb 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284
  1. '由于包含加解密等安全信息,本文件中的部分代码已被删除
  2. Imports System.Security.Cryptography
  3. Friend Module ModSecret
  4. #Region "杂项"
  5. '在开源版的注册表与常规版的注册表隔离,以防数据冲突
  6. Public Const RegFolder As String = "PCLDebug"
  7. '用于微软登录的 ClientId
  8. Public OAuthClientId As String = If(Environment.GetEnvironmentVariable("PCL_MS_CLIENT_ID"), "")
  9. 'CurseForge API Key
  10. Public CurseForgeAPIKey As String = If(Environment.GetEnvironmentVariable("PCL_CURSEFORGE_API_KEY"), "")
  11. Friend Sub SecretOnApplicationStart()
  12. '提升 UI 线程优先级
  13. Thread.CurrentThread.Priority = ThreadPriority.Highest
  14. '确保 .NET Framework 版本
  15. Try
  16. Dim VersionTest As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
  17. Catch ex As UriFormatException '修复 #3555
  18. Environment.SetEnvironmentVariable("windir", Environment.GetEnvironmentVariable("SystemRoot"), EnvironmentVariableTarget.User)
  19. Dim VersionTest As New FormattedText("", Globalization.CultureInfo.CurrentCulture, FlowDirection.LeftToRight, Fonts.SystemTypefaces.First, 96, New MyColor, DPI)
  20. End Try
  21. '检测当前文件夹权限
  22. Try
  23. Directory.CreateDirectory(Path & "PCL")
  24. Catch ex As Exception
  25. MsgBox($"PCL 无法创建 PCL 文件夹({Path & "PCL"}),请尝试:" & vbCrLf &
  26. "1. 将 PCL 移动到其他文件夹" & If(Path.StartsWithF("C:", True), ",例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
  27. "2. 删除当前目录中的 PCL 文件夹,然后再试。" & vbCrLf &
  28. "3. 右键 PCL 选择属性,打开 兼容性 中的 以管理员身份运行此程序。",
  29. MsgBoxStyle.Critical, "运行环境错误")
  30. Environment.[Exit](ProcessReturnValues.Cancel)
  31. End Try
  32. If Not CheckPermission(Path & "PCL") Then
  33. MsgBox("PCL 没有对当前文件夹的写入权限,请尝试:" & vbCrLf &
  34. "1. 将 PCL 移动到其他文件夹" & If(Path.StartsWithF("C:", True), ",例如 C 盘和桌面以外的其他位置。", "。") & vbCrLf &
  35. "2. 删除当前目录中的 PCL 文件夹,然后再试。" & vbCrLf &
  36. "3. 右键 PCL 选择属性,打开 兼容性 中的 以管理员身份运行此程序。",
  37. MsgBoxStyle.Critical, "运行环境错误")
  38. Environment.[Exit](ProcessReturnValues.Cancel)
  39. End If
  40. '开源版本提示
  41. MyMsgBox($"该版本中无法使用以下特性:
  42. - CurseForge API 调用:需要你自行申请 API Key,然后添加到 ModSecret.vb 的开头
  43. - 正版登录:需要你自行申请 Client ID,然后添加到 ModSecret.vb 的开头
  44. - 更新与联网通知:避免滥用隐患
  45. - 主题切换:这是需要赞助解锁的纪念性质的功能,别让赞助者太伤心啦……
  46. - 百宝箱:开发早期往里面塞了些开发工具,整理起来太麻烦了", "开源版本说明")
  47. End Sub
  48. ''' <summary>
  49. ''' 获取设备标识码。
  50. ''' </summary>
  51. Friend Function SecretGetUniqueAddress() As String
  52. Return "0000-0000-0000-0000"
  53. End Function
  54. Friend Sub SecretLaunchJvmArgs(ByRef DataList As List(Of String))
  55. Dim DataJvmCustom As String = Setup.Get("VersionAdvanceJvm", Version:=McVersionCurrent)
  56. DataList.Insert(0, If(DataJvmCustom = "", Setup.Get("LaunchAdvanceJvm"), DataJvmCustom)) '可变 JVM 参数
  57. McLaunchLog("当前剩余内存:" & Math.Round(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024 / 1024 * 10) / 10 & "G")
  58. DataList.Add("-Xmn" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024 * 0.15) & "m")
  59. DataList.Add("-Xmx" & Math.Floor(PageVersionSetup.GetRam(McVersionCurrent) * 1024) & "m")
  60. If Not DataList.Any(Function(d) d.Contains("-Dlog4j2.formatMsgNoLookups=true")) Then DataList.Add("-Dlog4j2.formatMsgNoLookups=true")
  61. End Sub
  62. #End Region
  63. #Region "网络鉴权"
  64. Friend Function SecretCdnSign(UrlWithMark As String) As String
  65. If Not UrlWithMark.EndsWithF("{CDN}") Then Return UrlWithMark
  66. Return UrlWithMark.Replace("{CDN}", "").Replace(" ", "%20")
  67. End Function
  68. ''' <summary>
  69. ''' 设置 Headers 的 UA、Referer。
  70. ''' </summary>
  71. Friend Sub SecretHeadersSign(Url As String, ByRef Req As HttpRequestMessage, Optional UseBrowserUserAgent As Boolean = False)
  72. If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
  73. Req.Headers.Add("User-Agent", "LogStatistic") '#4951
  74. ElseIf UseBrowserUserAgent Then
  75. Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode} Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36")
  76. Else
  77. Req.Headers.Add("User-Agent", $"PCL2/{VersionStandardCode}")
  78. End If
  79. Req.Headers.Add("Referer", $"http://{VersionCode}.open.pcl2.server/")
  80. If Url.Contains("api.curseforge.com") Then Req.Headers.Add("x-api-key", CurseForgeAPIKey)
  81. End Sub
  82. #End Region
  83. #Region "字符串加解密"
  84. ''' <summary>
  85. ''' 获取八位密钥。
  86. ''' </summary>
  87. Private Function SecretKeyGet(Key As String) As String
  88. Return "00000000"
  89. End Function
  90. ''' <summary>
  91. ''' 加密字符串。
  92. ''' </summary>
  93. Friend Function SecretEncrypt(SourceString As String, Optional Key As String = "") As String
  94. Key = SecretKeyGet(Key)
  95. Dim btKey As Byte() = Encoding.UTF8.GetBytes(Key)
  96. Dim btIV As Byte() = Encoding.UTF8.GetBytes("87160295")
  97. Dim des As New DESCryptoServiceProvider
  98. Using MS As New MemoryStream
  99. Dim inData As Byte() = Encoding.UTF8.GetBytes(SourceString)
  100. Using cs As New CryptoStream(MS, des.CreateEncryptor(btKey, btIV), CryptoStreamMode.Write)
  101. cs.Write(inData, 0, inData.Length)
  102. cs.FlushFinalBlock()
  103. Return Convert.ToBase64String(MS.ToArray())
  104. End Using
  105. End Using
  106. End Function
  107. ''' <summary>
  108. ''' 解密字符串。
  109. ''' </summary>
  110. Friend Function SecretDecrypt(SourceString As String, Optional Key As String = "") As String
  111. Key = SecretKeyGet(Key)
  112. Dim btKey As Byte() = Encoding.UTF8.GetBytes(Key)
  113. Dim btIV As Byte() = Encoding.UTF8.GetBytes("87160295")
  114. Dim des As New DESCryptoServiceProvider
  115. Using MS As New MemoryStream
  116. Dim inData As Byte() = Convert.FromBase64String(SourceString)
  117. Using cs As New CryptoStream(MS, des.CreateDecryptor(btKey, btIV), CryptoStreamMode.Write)
  118. cs.Write(inData, 0, inData.Length)
  119. cs.FlushFinalBlock()
  120. Return Encoding.UTF8.GetString(MS.ToArray())
  121. End Using
  122. End Using
  123. End Function
  124. #End Region
  125. #Region "主题"
  126. Public Color1 As New MyColor(52, 61, 74)
  127. Public Color2 As New MyColor(11, 91, 203)
  128. Public Color3 As New MyColor(19, 112, 243)
  129. Public Color4 As New MyColor(72, 144, 245)
  130. Public Color5 As New MyColor(150, 192, 249)
  131. Public Color6 As New MyColor(213, 230, 253)
  132. Public Color7 As New MyColor(222, 236, 253)
  133. Public Color8 As New MyColor(234, 242, 254)
  134. Public ColorBg0 As New MyColor(150, 192, 249)
  135. Public ColorBg1 As New MyColor(190, Color7)
  136. Public ColorGray1 As New MyColor(64, 64, 64)
  137. Public ColorGray2 As New MyColor(115, 115, 115)
  138. Public ColorGray3 As New MyColor(140, 140, 140)
  139. Public ColorGray4 As New MyColor(166, 166, 166)
  140. Public ColorGray5 As New MyColor(204, 204, 204)
  141. Public ColorGray6 As New MyColor(235, 235, 235)
  142. Public ColorGray7 As New MyColor(240, 240, 240)
  143. Public ColorGray8 As New MyColor(245, 245, 245)
  144. Public ColorSemiTransparent As New MyColor(1, Color8)
  145. Public ThemeNow As Integer = -1
  146. Public ColorHue As Integer = 210, ColorSat As Integer = 85, ColorLightAdjust As Integer = 0, ColorHueTopbarDelta As Object = 0
  147. Public ThemeDontClick As Integer = 0
  148. Public Sub ThemeRefresh(Optional NewTheme As Integer = -1)
  149. Try
  150. If ThemeNow = NewTheme AndAlso NewTheme >= 0 Then Return
  151. If NewTheme >= 0 Then ThemeNow = NewTheme
  152. Color1 = New MyColor().FromHSL2(ColorHue, ColorSat * 0.2, 25 + ColorLightAdjust * 0.3)
  153. Color2 = New MyColor().FromHSL2(ColorHue, ColorSat, 45 + ColorLightAdjust)
  154. Color3 = New MyColor().FromHSL2(ColorHue, ColorSat, 55 + ColorLightAdjust)
  155. Color4 = New MyColor().FromHSL2(ColorHue, ColorSat, 65 + ColorLightAdjust)
  156. Color5 = New MyColor().FromHSL2(ColorHue, ColorSat, 80 + ColorLightAdjust * 0.4)
  157. Color6 = New MyColor().FromHSL2(ColorHue, ColorSat, 91 + ColorLightAdjust * 0.1)
  158. Color7 = New MyColor().FromHSL2(ColorHue, ColorSat, 95)
  159. Color8 = New MyColor().FromHSL2(ColorHue, ColorSat, 97)
  160. ColorBg0 = Color4 * 0.4 + Color5 * 0.4 + ColorGray4 * 0.2
  161. ColorBg1 = New MyColor(190, Color7)
  162. ColorSemiTransparent = New MyColor(1, Color8)
  163. Application.Current.Resources("ColorBrush1") = New SolidColorBrush(Color1)
  164. Application.Current.Resources("ColorBrush2") = New SolidColorBrush(Color2)
  165. Application.Current.Resources("ColorBrush3") = New SolidColorBrush(Color3)
  166. Application.Current.Resources("ColorBrush4") = New SolidColorBrush(Color4)
  167. Application.Current.Resources("ColorBrush5") = New SolidColorBrush(Color5)
  168. Application.Current.Resources("ColorBrush6") = New SolidColorBrush(Color6)
  169. Application.Current.Resources("ColorBrush7") = New SolidColorBrush(Color7)
  170. Application.Current.Resources("ColorBrush8") = New SolidColorBrush(Color8)
  171. Application.Current.Resources("ColorBrushBg0") = New SolidColorBrush(ColorBg0)
  172. Application.Current.Resources("ColorBrushBg1") = New SolidColorBrush(ColorBg1)
  173. Application.Current.Resources("ColorObject1") = CType(Color1, Color)
  174. Application.Current.Resources("ColorObject2") = CType(Color2, Color)
  175. Application.Current.Resources("ColorObject3") = CType(Color3, Color)
  176. Application.Current.Resources("ColorObject4") = CType(Color4, Color)
  177. Application.Current.Resources("ColorObject5") = CType(Color5, Color)
  178. Application.Current.Resources("ColorObject6") = CType(Color6, Color)
  179. Application.Current.Resources("ColorObject7") = CType(Color7, Color)
  180. Application.Current.Resources("ColorObject8") = CType(Color8, Color)
  181. Application.Current.Resources("ColorObjectBg0") = CType(ColorBg0, Color)
  182. Application.Current.Resources("ColorObjectBg1") = CType(ColorBg1, Color)
  183. ThemeRefreshMain()
  184. Catch ex As Exception
  185. Log(ex, "刷新主题颜色失败", LogLevel.Hint)
  186. End Try
  187. End Sub
  188. Public Sub ThemeRefreshMain()
  189. RunInUi(
  190. Sub()
  191. If Not FrmMain.IsLoaded Then Return
  192. '顶部条背景
  193. Dim Brush = New LinearGradientBrush With {.EndPoint = New Point(1, 0), .StartPoint = New Point(0, 0)}
  194. If TypeOf ColorHueTopbarDelta Is Integer Then
  195. Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue - ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
  196. Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 54 + ColorLightAdjust)})
  197. Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
  198. Else
  199. Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(0), ColorSat, 48 + ColorLightAdjust)})
  200. Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(1), ColorSat, 54 + ColorLightAdjust)})
  201. Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(2), ColorSat, 48 + ColorLightAdjust)})
  202. End If
  203. FrmMain.PanTitle.Background = Brush
  204. FrmMain.PanTitle.Background.Freeze()
  205. '主页面背景
  206. If Setup.Get("UiBackgroundColorful") Then
  207. Brush = New LinearGradientBrush With {.EndPoint = New Point(0.1, 1), .StartPoint = New Point(0.9, 0)}
  208. Brush.GradientStops.Add(New GradientStop With {.Offset = -0.1, .Color = New MyColor().FromHSL2(ColorHue - 15, ColorSat * 0.8, 91)})
  209. Brush.GradientStops.Add(New GradientStop With {.Offset = 0.4, .Color = New MyColor().FromHSL2(ColorHue, ColorSat * 0.8, 91)})
  210. Brush.GradientStops.Add(New GradientStop With {.Offset = 1.1, .Color = New MyColor().FromHSL2(ColorHue + 15, ColorSat * 0.8, 91)})
  211. FrmMain.PanForm.Background = Brush
  212. Else
  213. FrmMain.PanForm.Background = New MyColor(245, 245, 245)
  214. End If
  215. FrmMain.PanForm.Background.Freeze()
  216. End Sub)
  217. End Sub
  218. Friend Sub ThemeCheckAll(EffectSetup As Boolean)
  219. End Sub
  220. Friend Function ThemeCheckOne(Id As Integer) As Boolean
  221. Return True
  222. End Function
  223. Friend Function ThemeUnlock(Id As Integer, Optional ShowDoubleHint As Boolean = True, Optional UnlockHint As String = Nothing) As Boolean
  224. Return False
  225. End Function
  226. Friend Function ThemeCheckGold(Optional Code As String = Nothing) As Boolean
  227. Return False
  228. End Function
  229. Friend Function DonateCodeInput() As Boolean?
  230. Return Nothing
  231. End Function
  232. #End Region
  233. #Region "更新"
  234. Public IsUpdateStarted As Boolean = False
  235. Public IsUpdateWaitingRestart As Boolean = False
  236. Public Sub UpdateCheckByButton()
  237. Hint("该版本中不包含更新功能……")
  238. End Sub
  239. Public Sub UpdateStart(BaseUrl As String, Slient As Boolean, Optional ReceivedKey As String = Nothing, Optional ForceValidated As Boolean = False)
  240. End Sub
  241. Public Sub UpdateRestart(TriggerRestartAndByEnd As Boolean)
  242. End Sub
  243. Public Sub UpdateReplace(ProcessId As Integer, OldFileName As String, NewFileName As String, TriggerRestart As Boolean)
  244. End Sub
  245. ''' <summary>
  246. ''' 确保 PathTemp 下的 Latest.exe 是最新正式版的 PCL,它会被用于整合包打包。
  247. ''' 如果不是,则下载一个。
  248. ''' </summary>
  249. Friend Sub DownloadLatestPCL(Optional LoaderToSyncProgress As LoaderBase = Nothing)
  250. '注意:如果要自行实现这个功能,请换用另一个文件路径,以免与官方版本冲突
  251. End Sub
  252. #End Region
  253. #Region "联网通知"
  254. Public ServerLoader As New LoaderTask(Of Integer, Integer)("PCL 服务", Sub() Log("[Server] 该版本中不包含更新通知功能……"), Priority:=ThreadPriority.BelowNormal)
  255. #End Region
  256. End Module