ModSecret.vb 15 KB

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