ModSecret.vb 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288
  1. '由于包含加解密等安全信息,本文件中的部分代码已被删除
  2. Imports System.Net
  3. Imports System.Reflection
  4. Imports System.Security.Cryptography
  5. Friend Module ModSecret
  6. #Region "杂项"
  7. '在开源版的注册表与常规版的注册表隔离,以防数据冲突
  8. Public Const RegFolder As String = "PCLDebug"
  9. '用于微软登录的 ClientId
  10. Public Const OAuthClientId As String = ""
  11. 'CurseForge API Key
  12. Public Const CurseForgeAPIKey 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](Result.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](Result.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. ''' <summary>
  65. ''' 打码字符串中的 AccessToken。
  66. ''' </summary>
  67. Friend Function SecretFilter(Raw As String, FilterChar As Char) As String
  68. '打码 "accessToken " 后的内容
  69. If Raw.Contains("accessToken ") Then
  70. For Each Token In RegexSearch(Raw, "(?<=accessToken ([^ ]{5}))[^ ]+(?=[^ ]{5})")
  71. Raw = Raw.Replace(Token, New String(FilterChar, Token.Count))
  72. Next
  73. End If
  74. '打码当前登录的结果
  75. Dim AccessToken As String = McLoginLoader.Output.AccessToken
  76. If AccessToken Is Nothing OrElse AccessToken.Length < 10 OrElse Not Raw.ContainsF(AccessToken, True) OrElse
  77. McLoginLoader.Output.Uuid = McLoginLoader.Output.AccessToken Then 'UUID 和 AccessToken 一样则不打码
  78. Return Raw
  79. Else
  80. Return Raw.Replace(AccessToken, Left(AccessToken, 5) & New String(FilterChar, AccessToken.Length - 10) & Right(AccessToken, 5))
  81. End If
  82. End Function
  83. #End Region
  84. #Region "网络鉴权"
  85. Friend Function SecretCdnSign(UrlWithMark As String)
  86. If Not UrlWithMark.EndsWithF("{CDN}") Then Return UrlWithMark
  87. Return UrlWithMark.Replace("{CDN}", "").Replace(" ", "%20")
  88. End Function
  89. ''' <summary>
  90. ''' 设置 Headers 的 UA、Referer。
  91. ''' </summary>
  92. Friend Sub SecretHeadersSign(Url As String, ByRef Client As WebClient, Optional UseBrowserUserAgent As Boolean = False)
  93. If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
  94. Client.Headers("User-Agent") = "LogStatistic" '#4951
  95. ElseIf UseBrowserUserAgent Then
  96. Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
  97. Else
  98. Client.Headers("User-Agent") = "PCL2/" & VersionStandardCode
  99. End If
  100. Client.Headers("Referer") = "http://" & VersionCode & ".pcl2.open.server/"
  101. Client.Headers("x-api-key") = CurseForgeAPIKey
  102. End Sub
  103. ''' <summary>
  104. ''' 设置 Headers 的 UA、Referer。
  105. ''' </summary>
  106. Friend Sub SecretHeadersSign(Url As String, ByRef Request As HttpWebRequest, Optional UseBrowserUserAgent As Boolean = False)
  107. If Url.Contains("baidupcs.com") OrElse Url.Contains("baidu.com") Then
  108. Request.UserAgent = "LogStatistic" '#4951
  109. ElseIf UseBrowserUserAgent Then
  110. Request.UserAgent = "PCL2/" & VersionStandardCode & " Mozilla/5.0 AppleWebKit/537.36 Chrome/63.0.3239.132 Safari/537.36"
  111. Else
  112. Request.UserAgent = "PCL2/" & VersionStandardCode
  113. End If
  114. Request.Referer = "http://" & VersionCode & ".pcl2.open.server/"
  115. Request.Headers("x-api-key") = CurseForgeAPIKey
  116. End Sub
  117. #End Region
  118. #Region "字符串加解密"
  119. ''' <summary>
  120. ''' 获取八位密钥。
  121. ''' </summary>
  122. Private Function SecretKeyGet(Key As String) As String
  123. Return "00000000"
  124. End Function
  125. ''' <summary>
  126. ''' 加密字符串。
  127. ''' </summary>
  128. Friend Function SecretEncrypt(SourceString As String, Optional Key As String = "") As String
  129. Key = SecretKeyGet(Key)
  130. Dim btKey As Byte() = Encoding.UTF8.GetBytes(Key)
  131. Dim btIV As Byte() = Encoding.UTF8.GetBytes("87160295")
  132. Dim des As New DESCryptoServiceProvider
  133. Using MS As New MemoryStream
  134. Dim inData As Byte() = Encoding.UTF8.GetBytes(SourceString)
  135. Using cs As New CryptoStream(MS, des.CreateEncryptor(btKey, btIV), CryptoStreamMode.Write)
  136. cs.Write(inData, 0, inData.Length)
  137. cs.FlushFinalBlock()
  138. Return Convert.ToBase64String(MS.ToArray())
  139. End Using
  140. End Using
  141. End Function
  142. ''' <summary>
  143. ''' 解密字符串。
  144. ''' </summary>
  145. Friend Function SecretDecrypt(SourceString As String, Optional Key As String = "") As String
  146. Key = SecretKeyGet(Key)
  147. Dim btKey As Byte() = Encoding.UTF8.GetBytes(Key)
  148. Dim btIV As Byte() = Encoding.UTF8.GetBytes("87160295")
  149. Dim des As New DESCryptoServiceProvider
  150. Using MS As New MemoryStream
  151. Dim inData As Byte() = Convert.FromBase64String(SourceString)
  152. Using cs As New CryptoStream(MS, des.CreateDecryptor(btKey, btIV), CryptoStreamMode.Write)
  153. cs.Write(inData, 0, inData.Length)
  154. cs.FlushFinalBlock()
  155. Return Encoding.UTF8.GetString(MS.ToArray())
  156. End Using
  157. End Using
  158. End Function
  159. #End Region
  160. #Region "主题"
  161. Public Color1 As New MyColor(52, 61, 74)
  162. Public Color2 As New MyColor(11, 91, 203)
  163. Public Color3 As New MyColor(19, 112, 243)
  164. Public Color4 As New MyColor(72, 144, 245)
  165. Public Color5 As New MyColor(150, 192, 249)
  166. Public Color6 As New MyColor(213, 230, 253)
  167. Public Color7 As New MyColor(222, 236, 253)
  168. Public Color8 As New MyColor(234, 242, 254)
  169. Public ColorBg0 As New MyColor(150, 192, 249)
  170. Public ColorBg1 As New MyColor(190, Color7)
  171. Public ColorGray1 As New MyColor(64, 64, 64)
  172. Public ColorGray2 As New MyColor(115, 115, 115)
  173. Public ColorGray3 As New MyColor(140, 140, 140)
  174. Public ColorGray4 As New MyColor(166, 166, 166)
  175. Public ColorGray5 As New MyColor(204, 204, 204)
  176. Public ColorGray6 As New MyColor(235, 235, 235)
  177. Public ColorGray7 As New MyColor(240, 240, 240)
  178. Public ColorGray8 As New MyColor(245, 245, 245)
  179. Public ColorSemiTransparent As New MyColor(1, Color8)
  180. Public ThemeNow As Integer = -1
  181. Public ColorHue As Integer = 210, ColorSat As Integer = 85, ColorLightAdjust As Integer = 0, ColorHueTopbarDelta As Object = 0
  182. Public ThemeDontClick As Integer = 0
  183. Public Sub ThemeRefresh(Optional NewTheme As Integer = -1)
  184. Hint("该版本中不包含主题功能……")
  185. End Sub
  186. Public Sub ThemeRefreshMain()
  187. RunInUi(
  188. Sub()
  189. If Not FrmMain.IsLoaded Then Exit Sub
  190. '顶部条背景
  191. Dim Brush = New LinearGradientBrush With {.EndPoint = New Point(1, 0), .StartPoint = New Point(0, 0)}
  192. If ThemeNow = 5 Then
  193. Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 25)})
  194. Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 15)})
  195. Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 25)})
  196. FrmMain.PanTitle.Background = Brush
  197. FrmMain.PanTitle.Background.Freeze()
  198. ElseIf Not (ThemeNow = 12 OrElse ThemeDontClick = 2) Then
  199. If TypeOf ColorHueTopbarDelta Is Integer Then
  200. Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue - ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
  201. Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue, ColorSat, 54 + ColorLightAdjust)})
  202. Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta, ColorSat, 48 + ColorLightAdjust)})
  203. Else
  204. Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(0), ColorSat, 48 + ColorLightAdjust)})
  205. Brush.GradientStops.Add(New GradientStop With {.Offset = 0.5, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(1), ColorSat, 54 + ColorLightAdjust)})
  206. Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + ColorHueTopbarDelta(2), ColorSat, 48 + ColorLightAdjust)})
  207. End If
  208. FrmMain.PanTitle.Background = Brush
  209. FrmMain.PanTitle.Background.Freeze()
  210. Else
  211. Brush.GradientStops.Add(New GradientStop With {.Offset = 0, .Color = New MyColor().FromHSL2(ColorHue - 21, ColorSat, 53 + ColorLightAdjust)})
  212. Brush.GradientStops.Add(New GradientStop With {.Offset = 0.33, .Color = New MyColor().FromHSL2(ColorHue - 7, ColorSat, 47 + ColorLightAdjust)})
  213. Brush.GradientStops.Add(New GradientStop With {.Offset = 0.67, .Color = New MyColor().FromHSL2(ColorHue + 7, ColorSat, 47 + ColorLightAdjust)})
  214. Brush.GradientStops.Add(New GradientStop With {.Offset = 1, .Color = New MyColor().FromHSL2(ColorHue + 21, ColorSat, 53 + ColorLightAdjust)})
  215. FrmMain.PanTitle.Background = Brush
  216. End If
  217. '主页面背景
  218. If Setup.Get("UiBackgroundColorful") Then
  219. Brush = New LinearGradientBrush With {.EndPoint = New Point(0.1, 1), .StartPoint = New Point(0.9, 0)}
  220. Brush.GradientStops.Add(New GradientStop With {.Offset = -0.1, .Color = New MyColor().FromHSL2(ColorHue - 20, Math.Min(60, ColorSat) * 0.5, 80)})
  221. Brush.GradientStops.Add(New GradientStop With {.Offset = 0.4, .Color = New MyColor().FromHSL2(ColorHue, ColorSat * 0.9, 90)})
  222. Brush.GradientStops.Add(New GradientStop With {.Offset = 1.1, .Color = New MyColor().FromHSL2(ColorHue + 20, Math.Min(60, ColorSat) * 0.5, 80)})
  223. FrmMain.PanForm.Background = Brush
  224. Else
  225. FrmMain.PanForm.Background = New MyColor(245, 245, 245)
  226. End If
  227. FrmMain.PanForm.Background.Freeze()
  228. End Sub)
  229. End Sub
  230. Public Sub ThemeCheckAll(EffectSetup As Boolean)
  231. End Sub
  232. Public Function ThemeCheckOne(Id As Integer) As Boolean
  233. Return True
  234. End Function
  235. Friend Function ThemeUnlock(Id As Integer, Optional ShowDoubleHint As Boolean = True, Optional UnlockHint As String = Nothing) As Boolean
  236. Return False
  237. End Function
  238. Public Function ThemeCheckGold(Optional Code As String = Nothing) As Boolean
  239. Return False
  240. End Function
  241. Public Function DonateCodeInput() As Boolean?
  242. Return Nothing
  243. End Function
  244. #End Region
  245. #Region "更新"
  246. Public IsUpdateStarted As Boolean = False
  247. Public IsUpdateWaitingRestart As Boolean = False
  248. Public Sub UpdateCheckByButton()
  249. Hint("该版本中不包含更新功能……")
  250. End Sub
  251. Public Sub UpdateStart(BaseUrl As String, Slient As Boolean, Optional ReceivedKey As String = Nothing, Optional ForceValidated As Boolean = False)
  252. End Sub
  253. Public Sub UpdateRestart(TriggerRestartAndByEnd As Boolean)
  254. End Sub
  255. Public Sub UpdateReplace(ProcessId As Integer, OldFileName As String, NewFileName As String, TriggerRestart As Boolean)
  256. End Sub
  257. #End Region
  258. #Region "联网通知"
  259. Public ServerLoader As New LoaderTask(Of Integer, Integer)("PCL 服务", Sub() Log("[Server] 该版本中不包含更新通知功能……"), Priority:=ThreadPriority.BelowNormal)
  260. #End Region
  261. End Module