Imports Ionic.Zip
Public Class formDownloadLeft
'用于加载的Timer
Private Sub timerLoad_Tick() Handles timerLoad.Tick
Try
'获取基本信息
Dim NowState As LoadState
Select Case selecter.SelectIndexName
Case "Minecraft"
NowState = MinecraftState
Case "OptiFine"
NowState = OptiFineState
Case "Forge"
NowState = If(ForgeVersionState = LoadState.Loaded, ForgeState, ForgeVersionState)
Case Else
Exit Sub
End Select
If selecter.SelectIndexName = "Forge" And ForgeVersionState = LoadState.Loaded Then
'Forge状态处理
Select Case NowState
Case LoadState.Loaded
Exit Sub
Case LoadState.Loading
labRight.Content = "加载中"
Exit Sub
Case LoadState.Failed
labRight.Content = "加载失败"
Exit Sub
Case LoadState.NoConnection
labRight.Content = "没有网络连接"
Exit Sub
Case LoadState.Success
labRight.Content = ""
End Select
Else
'基本事态处理,这里自动控制了两个主UI的切换
Select Case NowState
Case LoadState.Loaded
Exit Sub
Case LoadState.Loading
labLoading.Content = "加载中"
labLoading.Visibility = Visibility.Visible
panFinish.Visibility = Visibility.Hidden
Exit Sub
Case LoadState.Failed
labLoading.Content = "加载失败,点击以重试"
labLoading.Visibility = Visibility.Visible
panFinish.Visibility = Visibility.Hidden
Exit Sub
Case LoadState.NoConnection
labLoading.Content = "没有网络连接"
labLoading.Visibility = Visibility.Visible
panFinish.Visibility = Visibility.Hidden
Exit Sub
Case LoadState.Success
'开始加载,把控件显示出来
labLoading.Visibility = Visibility.Collapsed
panFinish.Visibility = Visibility.Visible
End Select
End If
'加载
Select Case selecter.SelectIndexName
Case "Minecraft"
'结束显示
MinecraftState = LoadState.Loaded
'加载预览版,预览版总是列表第一个
item2.MainText = MinecraftArray(0).id
item2.Tag = MinecraftArray(0)
'是否加载正式版的标记
Dim item1Loaded As Boolean = False
'循环添加
For Each ver As MinecraftVersion In MinecraftArray
'判断正式版
If ver.type = "release" And Not item1Loaded Then
item1Loaded = True
item1.MainText = ver.id
item1.Tag = ver
End If
'判断Logo样式
Dim Photo As String = "Grass"
If ver.type = "snapshot" Then Photo = "CommandBlock"
If ver.type = "fool" Then Photo = "Dirt"
If ver.type.Contains("old") Then Photo = "CobbleStone"
'添加控件
Dim item As ListItem = New ListItem With {.UseLayoutRounding = True, .Tag = ver, .CanCheck = False, .ButtonLogo = New BitmapImage(New Uri("/Images/appbar.inbox.in.png", UriKind.Relative)), .MainText = ver.id, .SubText = ver.time, .Name = "list" & GetUUID(), .Logo = New BitmapImage(New Uri(PATH_IMAGE & "Block-" & Photo & ".png", UriKind.Absolute)), .ToolTip = If(Photo = "Dirt", "该版本由 PCL 特别提供", Nothing)}
AddHandler item.ButtonClick, AddressOf MinecraftDownloadClick
panVersion.Children.Add(item)
Next
'最新正式版与最新预览版一样则隐藏一个
If item1.MainText = item2.MainText Then
item2.Visibility = Visibility.Collapsed
Else
item2.Visibility = Visibility.Visible
End If
Case "OptiFine"
'结束显示
OptiFineState = LoadState.Loaded
'加载预览版,预览版总是列表第一个
item2.MainText = OptiFineArray(0).id.ToString
item2.Tag = OptiFineArray(0)
'是否加载正式版的标记
Dim item1Loaded = False
For Each ver As OptiFineVersion In OptiFineArray
'判断正式版
If Not (ver.id.Contains("pre") Or item1Loaded) Then
item1Loaded = True
item1.MainText = ver.id
item1.Tag = ver
End If
'判断Logo样式
Dim Photo = If(ver.id.Contains("pre"), "CommandBlock", "Grass")
'添加控件
Dim item As ListItem = New ListItem With {.UseLayoutRounding = True, .Tag = ver, .CanCheck = False, .ButtonLogo = New BitmapImage(New Uri("/Images/appbar.inbox.in.png", UriKind.Relative)), .MainText = ver.id, .SubText = ver.time, .Name = "list" & GetUUID(), .Logo = New BitmapImage(New Uri("/Images/Block-" & Photo & ".png", UriKind.Relative))}
AddHandler item.ButtonClick, AddressOf OptiFineDownloadStart
panVersion.Children.Add(item)
Next
'最新正式版与最新预览版一样则隐藏一个
If item1.MainText = item2.MainText Then
item2.Visibility = Visibility.Collapsed
Else
item2.Visibility = Visibility.Visible
End If
''使用 BMCLAPI 获取 OptiFine 源时进行隐藏
'If selecter.SelectIndexName = "OptiFine" Then
' If OptiFineArray.Count > 0 Then
' item1.Visibility = If(OptiFineArray(0).time = "", Visibility.Collapsed, Visibility.Visible)
' item2.Visibility = If(OptiFineArray(0).time = "", Visibility.Collapsed, Visibility.Visible)
' End If
'End If
Case "Forge"
If ForgeVersionState = LoadState.Success Then 'ForgeVersion
'结束显示
ForgeVersionState = LoadState.Loaded
'加载列表
panForge.Children.Clear()
For Each Version As String In ForgeVersionArray
'添加控件
Dim item As ListItem = New ListItem With {.SubText = "", .ShowButton = False, .UseLayoutRounding = True, .CanCheck = True, .MainText = Version, .Name = "list" & GetUUID(), .Logo = New BitmapImage(New Uri("/Images/Block-Grass.png", UriKind.Relative))}
AddHandler item.Change, AddressOf ChangeForgeVersionSelection
panForge.Children.Add(item)
Next
'引发第一个的改变事件
If panForge.Children.Count > 0 Then
CType(panForge.Children(0), ListItem).Checked = True
ChangeForgeVersionSelection(CType(panForge.Children(0), ListItem), Nothing)
End If
AniStart(AaStack(panForge), "DownloadLeftShowForge")
scrollForge.Value = 0
scrollVersion.Visibility = Visibility.Hidden
Else 'Forge
panVersionHost.Visibility = Visibility.Collapsed
scrollVersion.Visibility = Visibility.Visible
Try
'结束显示
ForgeState = LoadState.Loaded
labRight.Content = ""
Dim array = ForgeArray
panVersion.Children.Clear()
For Each ver As ForgeVersion In array
Dim item As ListItem = New ListItem With {.UseLayoutRounding = True, .Tag = ver, .CanCheck = False, .ButtonLogo = New BitmapImage(New Uri("/Images/appbar.inbox.in.png", UriKind.Relative)), .MainText = "Forge " & ver.version, .SubText = ver.time, .Name = "list" & GetUUID(), .Logo = New BitmapImage(New Uri("/Images/Block-Anvil.png", UriKind.Relative))}
AddHandler item.ButtonClick, AddressOf ForgeDownloadStart
panVersion.Children.Add(item)
Next
Catch
'时不时会出现集合已修改的Exception,事实证明重新加载一次就成了,管它啥原因嘞
ForgeState = LoadState.Success
End Try
End If
panVersionHost.Visibility = Visibility.Visible
End Select
Catch ex As Exception
ExShow(ex, "下载列表检测时钟出错", ErrorLevel.Slient)
End Try
End Sub
'改变左边选择条
Private Sub ChangeSelection(ByVal Selection As String) Handles selecter.SelectionChange
'初始化滚动条
panVersion.Children.Clear()
scrollVersion.ValueMe = 0
'初始化页面
labLoading.Content = "加载中"
labLoading.Visibility = Visibility.Visible
panFinish.Visibility = Visibility.Hidden
scrollVersion.Visibility = Visibility.Visible
'分情况处理
Select Case Selection
Case "Minecraft"
'状态改变
Select Case MinecraftState
Case LoadState.Loaded
'已经加载过了,需要刷新显示
MinecraftState = LoadState.Success
Case LoadState.Failed
'加载失败,自动刷新
MinecraftState = LoadState.Loading
Pool.Add(New Thread(Sub() GetMinecraftBasic(True)))
End Select
'对应页面
panForgeHost.Visibility = Visibility.Collapsed
scrollForge.Visibility = Visibility.Collapsed
item1.Visibility = Visibility.Visible
item2.Visibility = Visibility.Visible
labRight.Content = ""
Case "OptiFine"
'状态改变
Select Case OptiFineState
Case LoadState.Loaded
'已经加载过了,需要刷新显示
OptiFineState = LoadState.Success
Case LoadState.Failed
'加载失败,自动刷新
OptiFineState = LoadState.Loading
Pool.Add(New Thread(AddressOf GetOptiFineBasic))
End Select
'对应页面
panForgeHost.Visibility = Visibility.Collapsed
scrollForge.Visibility = Visibility.Collapsed
item1.Visibility = Visibility.Visible
item2.Visibility = Visibility.Visible
labRight.Content = ""
Case "Forge"
'状态改变
Select Case ForgeVersionState
Case LoadState.Loaded
'已经加载过了,需要刷新显示
ForgeVersionState = LoadState.Success
Case LoadState.Failed
'加载失败,自动刷新
ForgeVersionState = LoadState.Loading
Pool.Add(New Thread(AddressOf GetForgeVersionBasic))
End Select
'对应页面
panForgeHost.Visibility = Visibility.Visible
scrollForge.Visibility = Visibility.Visible
item1.Visibility = Visibility.Collapsed
item2.Visibility = Visibility.Collapsed
labRight.Content = "加载中"
End Select
End Sub
'点击重试
Private Sub labLoading_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Input.MouseButtonEventArgs) Handles labLoading.MouseDown
Select Case selecter.SelectIndexName
Case "Minecraft"
If MinecraftState = LoadState.Failed Then
Dim th As New Thread(Sub() GetMinecraftBasic(True))
th.Start()
End If
Case "OptiFine"
If OptiFineState = LoadState.Failed Then
Dim th As New Thread(AddressOf GetOptiFineBasic)
th.Start()
End If
Case "Forge"
If ForgeVersionState = LoadState.Failed Then
Dim th As New Thread(AddressOf GetForgeVersionBasic)
th.Start()
End If
End Select
End Sub
'加载的状态
Public Enum LoadState As Byte
'''
''' 正在加载
'''
'''
Loading = 0
'''
''' 已经加载结束,但是没有显示
'''
'''
Success = 1
'''
''' 加载失败
'''
'''
Failed = 2
'''
''' 加载失败(没有联网)
'''
'''
NoConnection = 3
'''
''' 已经加载结束,并且已显示,此时不执行Timer代码
'''
'''
Loaded = 4
End Enum
#Region "窗体基础"
Dim PageLoaded As Boolean = False
Private Sub panVersion_Loaded(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles panVersion.Loaded
Dim EnabledList As New ArrayList
If ReadIni("setup", "UiHiddenMinecraft", "False") = "False" Then EnabledList.Add("Minecraft")
If ReadIni("setup", "UiHiddenOptiFine", "False") = "False" Then EnabledList.Add("OptiFine")
If ReadIni("setup", "UiHiddenForge", "False") = "False" Then EnabledList.Add("Forge")
Select Case EnabledList.Count
Case 0
selecter.ShowList = {"Nothing"}
panMain.Visibility = Visibility.Collapsed
Case 1
selecter.ShowList = EnabledList.ToArray
selecter.Visibility = Visibility.Collapsed
panMain.Visibility = Visibility.Visible
Case 2, 3
selecter.ShowList = EnabledList.ToArray
selecter.Visibility = Visibility.Visible
panMain.Visibility = Visibility.Visible
End Select
If Not PageLoaded Then
PageLoaded = True
panMain.UpdateLayout()
End If
If scrollVersion.SetControl(panVersion, True) Then AddHandler panVersionHost.MouseWheel, AddressOf scrollVersion.RunMouseWheel
End Sub
Private Sub panForge_Loaded(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs) Handles panForge.Loaded
If scrollForge.SetControl(panForge, True) Then AddHandler panForgeHost.MouseWheel, AddressOf scrollForge.RunMouseWheel
End Sub
Private Sub panNew_SizeChanged(ByVal sender As Object, ByVal e As System.Windows.SizeChangedEventArgs) Handles panNew.SizeChanged
item2.Width = Int((panNew.ActualWidth - 9) / 2)
End Sub
#End Region
#Region "Minecraft"
Public MinecraftState As LoadState = LoadState.Failed '加载状态
Public MinecraftArray As New ArrayList '代码分析的数组
Public MinecraftInfo As String = "" '获取的代码
Public Structure MinecraftVersion
Dim id As String
Dim type As String
Dim url As String
Dim time As String
End Structure
Public Sub GetMinecraftBasic(ByVal IsShowHint As Boolean)
'初始化
MinecraftState = LoadState.Loading
MinecraftArray = New ArrayList
If MODE_OFFLINE Then
MinecraftState = LoadState.NoConnection
Exit Sub
End If
'获取版本列表
Try
If ReadIni("setup", "DownVersion", "0") = "0" Then
MinecraftInfo = GetWebsiteCode("https://launchermeta.mojang.com/mc/game/version_manifest.json", Encoding.Default)
If MinecraftInfo = "" Then
MinecraftInfo = GetWebsiteCode("http://bmclapi2.bangbang93.com/mc/game/version_manifest.json", Encoding.Default)
If IsShowHint And Not MinecraftInfo = "" Then ShowHint("获取官方 Minecraft 版本列表失败,自动切换为 BMCLAPI")
End If
Else
MinecraftInfo = GetWebsiteCode("http://bmclapi2.bangbang93.com/mc/game/version_manifest.json", Encoding.Default)
If MinecraftInfo = "" Then
MinecraftInfo = GetWebsiteCode("https://launchermeta.mojang.com/mc/game/version_manifest.json", Encoding.Default)
End If
End If
If Len(MinecraftInfo) < 300 Then Throw New WebException("获取到的列表长度不足:" & MinecraftInfo)
Catch ex As Exception
ExShow(ex, "获取 Minecraft 版本列表失败")
MinecraftInfo = ""
MinecraftState = LoadState.Failed
Exit Sub
End Try
log("[DownloadLeft] 获取 Minecraft 版本列表成功")
'加载版本列表信息
Try
log("[DownloadLeft] 加载 Minecraft 版本列表信息开始")
'预处理
Dim ids As ArrayList = RegexSearch(MinecraftInfo, "(?<=id"": "")[^""]+")
ids.AddRange(RegexSearch(MinecraftInfo, "(?<=id"":"")[^""]+"))
Dim urls As ArrayList = RegexSearch(MinecraftInfo, "(?<=url"": "")[^""]+")
urls.AddRange(RegexSearch(MinecraftInfo, "(?<=url"":"")[^""]+"))
Dim times As ArrayList = RegexSearch(MinecraftInfo, "(?<=releaseTime"": "")[^T]+")
times.AddRange(RegexSearch(MinecraftInfo, "(?<=releaseTime"":"")[^T]+"))
Dim types As ArrayList = RegexSearch(MinecraftInfo, "(?<=type"": "")[^""]+")
types.AddRange(RegexSearch(MinecraftInfo, "(?<=type"":"")[^""]+"))
'长度检查
If Not (ids.Count = urls.Count And urls.Count = times.Count And times.Count = types.Count) Then Throw New WebException("获取到的列表长度不等")
'添加
For i = 0 To ids.Count - 1
MinecraftArray.Add(New MinecraftVersion With {.id = ids(i), .url = urls(i), .time = times(i), .type = types(i)})
Next
'确认最新版本
If MinecraftArray.Count > 0 Then
Select Case ReadIni("setup", "LastMinecraftVersion")
Case ""
'没有执行过,不提醒
WriteIni("setup", "LastMinecraftVersion", CType(MinecraftArray(0), MinecraftVersion).id)
Case CType(MinecraftArray(0), MinecraftVersion).id
'相同,不提醒
Case Else
'不相同,提醒
WriteIni("setup", "LastMinecraftVersion", CType(MinecraftArray(0), MinecraftVersion).id)
If ReadIni("setup", "HomeUpdate", "True") = "True" Then
If Not (ReadIni("setup", "HomeUpdateRelease", "False") = "True" And (CType(MinecraftArray(0), MinecraftVersion).id.Contains("w") Or CType(MinecraftArray(0), MinecraftVersion).id.Contains("pre"))) Then
frmHomeRight.Dispatcher.Invoke(Sub() frmHomeRight.ShowUpdate("发现游戏更新:" & CType(MinecraftArray(0), MinecraftVersion).id, formHomeRight.UpdateType.MINECRAFT))
End If
End If
End Select
End If
Catch ex As Exception
ExShow(ex, "加载 Minecraft 版本列表信息失败")
MinecraftInfo = ""
MinecraftState = LoadState.Failed
Exit Sub
End Try
log("[DownloadLeft] 加载 Minecraft 版本列表信息成功")
MinecraftState = LoadState.Success
End Sub
Private Sub MinecraftDownloadClick(ByVal sender As ListItem, ByVal e As System.Windows.Input.MouseButtonEventArgs) Handles item1.ButtonClick, item2.ButtonClick
If IsNothing(sender.Tag) Or Not selecter.SelectIndexName = "Minecraft" Then Exit Sub
MinecraftDownloadStart(sender.Tag)
End Sub
Private Sub MinecraftDownloadStart(Ver As MinecraftVersion)
Dim realID As String = Ver.id
Dim local As String = PATH_MC & "versions\" & realID & "\"
If WebGroups.ContainsKey("Minecraft " & realID) Or WebGroups.ContainsKey("Minecraft " & realID & " 信息") Then
ShowHint(New HintConverter("正在下载中,请勿重复操作", HintState.Warn))
Exit Sub
End If
If Not Directory.Exists(local) Then Directory.CreateDirectory(local)
'检测已存在版本
If GetFileSize(local & realID & ".jar") > 1024 Then
If MyMsgbox("该版本已存在,是否要删除当前版本并且重新下载?", "提示", "确定", "取消") = 1 Then
Try
File.Delete(local & realID & ".json")
File.Delete(local & realID & ".jar")
Catch ex As Exception
ExShow(ex, "删除版本失败", ErrorLevel.MsgboxWithoutFeedback)
End Try
Else
Exit Sub
End If
End If
'下载
log("[DownloadLeft] 下载版本:" & realID)
ShowHint("Minecraft " & realID & " 开始下载")
SendStat("下载", "Minecraft", realID)
Dim th As New Thread(Sub()
Try
Directory.CreateDirectory(local)
Dim DownloadList As ArrayList
If ReadIni("setup", "DownMinecraft", "1") = "0" Then
'官方源优先
DownloadList = New ArrayList({
Ver.url.Replace("https://launcher.mojang.com", "http://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "http://bmclapi2.bangbang93.com"),
Ver.url
})
Else
'BMCLAPI 优先
DownloadList = New ArrayList({
Ver.url,
Ver.url.Replace("https://launcher.mojang.com", "http://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "http://bmclapi2.bangbang93.com")
})
End If
WebStart({
New WebRequireFile With {.WebURLs = DownloadList, .LocalFolder = local, .LocalName = realID & ".json", .KnownFileSize = 1024 * 2}}, "Minecraft " & realID & " 信息",
Sub()
Try
Dim json As JObject = Newtonsoft.Json.JsonConvert.DeserializeObject(ReadFileToEnd(local & realID & ".json"))
Dim size As Integer
Try
size = json("downloads")("client")("size").ToString
Catch
size = 1024 * 50
End Try
Dim url As New ArrayList
If ReadIni("setup", "DownMinecraft", "1") = "0" Then
'Mojang 优先
url.Add(json("downloads")("client")("url").ToString)
url.Add(json("downloads")("client")("url").ToString.Replace("https://launcher.mojang.com", "http://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "http://bmclapi2.bangbang93.com"))
url.Add(json("downloads")("client")("url").ToString)
url.Add(json("downloads")("client")("url").ToString.Replace("https://launcher.mojang.com", "http://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "http://bmclapi2.bangbang93.com"))
Else
'BMCLAPI 优先
url.Add(json("downloads")("client")("url").ToString.Replace("https://launcher.mojang.com", "http://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "http://bmclapi2.bangbang93.com"))
url.Add(json("downloads")("client")("url").ToString)
url.Add(json("downloads")("client")("url").ToString.Replace("https://launcher.mojang.com", "http://bmclapi2.bangbang93.com").Replace("https://launchermeta.mojang.com", "http://bmclapi2.bangbang93.com"))
url.Add(json("downloads")("client")("url").ToString)
End If
WebStart({New WebRequireFile With {.WebURLs = url, .LocalFolder = local, .LocalName = realID & ".jar", .KnownFileSize = size}}, "Minecraft " & realID, AddressOf MinecraftDownloadSuccess, AddressOf MinecraftDownloadFail, If(size = 1024 * 50, WebRequireSize.AtLeast, WebRequireSize.Known))
Catch ex As Exception
ExShow(ex, "下载版本失败:" & realID, ErrorLevel.AllUsers)
Try
File.Delete(local & realID & ".json")
File.Delete(local & realID & ".jar")
Catch : End Try
Application.Current.Dispatcher.Invoke(CType(AddressOf MinecraftDownloadFail, ParameterizedThreadStart), realID)
End Try
End Sub,
AddressOf MinecraftDownloadFail,
WebRequireSize.AtLeast)
Catch ex As Exception
ExShow(ex, "下载版本失败:" & realID, ErrorLevel.AllUsers)
Try
File.Delete(local & realID & ".json")
File.Delete(local & realID & ".jar")
Catch : End Try
Application.Current.Dispatcher.Invoke(CType(AddressOf MinecraftDownloadFail, ParameterizedThreadStart), realID)
End Try
End Sub)
th.Start()
End Sub
Private Sub MinecraftDownloadSuccess(ByVal Name As String)
Try
Pool.Add(New Thread(AddressOf PoolVersionList))
ShowHint(New HintConverter(Name & " 下载成功", HintState.Finish))
Catch ex As Exception
ExShow(ex, "Minecraft 下载结束后的处理异常:" & Name)
ShowHint(New HintConverter(Name & " 下载失败:" & GetStringFromException(ex) & "!", HintState.Critical))
End Try
End Sub
Private Sub MinecraftDownloadFail(ByVal Name As String)
ShowHint(New HintConverter(Name & " 下载失败", HintState.Critical))
End Sub
Private Function MinecraftGet(VersionName As String) As MinecraftVersion
If MinecraftArray.Count = 0 Then Return Nothing
If VersionName.EndsWith(".0") And VersionName.StartsWith("1.") Then VersionName = Mid(VersionName, 1, Len(VersionName) - 2)
'获取对应版本
Dim SelectVersion As MinecraftVersion = Nothing
For Each Ver As MinecraftVersion In MinecraftArray
If Ver.id = VersionName Then
SelectVersion = Ver
Exit For
End If
Next
Return SelectVersion
End Function
#End Region
#Region "OptiFine"
Public OptiFineState As LoadState = LoadState.Failed '加载状态
Public OptiFineArray As New ArrayList '代码分析的数组
Public OptiFineInfo As String = "" '获取的代码
Public Structure OptiFineVersion
Dim id As String
Dim url As String
Dim time As String
Dim getByBMCLAPI As Boolean
End Structure
Public Sub GetOptiFineBasic()
'初始化
OptiFineState = LoadState.Loading
OptiFineArray = New ArrayList
OptiFineInfo = ""
If MODE_OFFLINE Then
OptiFineState = LoadState.NoConnection
Exit Sub
End If
'官方源
'获取版本列表
Try
log("[DownloadLeft] 获取 OptiFine 版本列表开始")
OptiFineInfo = GetWebsiteCode("http://www.optifine.net/downloads", Encoding.Default)
If Len(OptiFineInfo) < 200 Then Throw New WebException("获取到的列表长度不足:" & OptiFineInfo)
Catch ex As Exception
ExShow(ex, "获取 OptiFine 版本列表失败")
OptiFineInfo = ""
GoTo BMCLAPI
End Try
log("[DownloadLeft] 获取 OptiFine 版本列表成功")
'加载版本列表信息
Try
'预处理
Dim ids As ArrayList = RegexSearch(OptiFineInfo, "(?<=downloadLineFile(First)?'>)[^<]*")
Dim urls As ArrayList = RegexSearch(OptiFineInfo, "(?<=downloadLineMirror'>)[^<]*")
'长度检查
If Not (ids.Count = urls.Count And urls.Count = times.Count) Then Throw New WebException("获取到的列表长度不等")
'添加
For i = 0 To ids.Count - 1
OptiFineArray.Add(New OptiFineVersion With {
.id = ids(i).Replace("OptiFine ", ""),
.url = urls(i),
.time = times(i).ToString.Split(".")(2) & "-" & times(i).ToString.Split(".")(1) & "-" & times(i).ToString.Split(".")(0),
.getByBMCLAPI = False})
Next
GoTo Success
Catch ex As Exception
ExShow(ex, "加载 OptiFine 版本列表信息失败")
OptiFineInfo = ""
GoTo BMCLAPI
End Try
'BMCLAPI 源
BMCLAPI:
'获取版本列表
Try
log("[DownloadLeft] 使用 BMCLAPI 源获取 OptiFine 版本列表开始")
OptiFineInfo = GetWebsiteCode("http://bmclapi2.bangbang93.com/optifine/versionList", Encoding.Default)
If Len(OptiFineInfo) < 200 Then Throw New WebException("获取到的列表长度不足:" & OptiFineInfo)
Catch ex As Exception
ExShow(ex, "使用 BMCLAPI 源获取 OptiFine 版本列表失败")
OptiFineInfo = ""
OptiFineState = LoadState.Failed
Exit Sub
End Try
log("[DownloadLeft] 使用 BMCLAPI 源获取 OptiFine 版本列表成功")
'加载版本列表信息
Try
'预处理
Dim filename As ArrayList = RegexSearch(OptiFineInfo, "(?<=filename"":"")[^""]*")
Dim id As ArrayList = RegexSearch(OptiFineInfo, "(?<=OptiFine_).*?(?=\.jar)")
'添加
For i = 0 To filename.Count - 1
OptiFineArray.Add(New OptiFineVersion With {
.id = id(i).Replace("_", " "),
.url = "http://optifine.net/adloadx?f=" & filename(i),
.time = "",
.getByBMCLAPI = True
})
Next
If selecter.SelectIndexName = "OptiFine" Then ShowHint("OptiFine 官方列表获取失败,列表由 BMCLAPI 提供")
GoTo Success
Catch ex As Exception
ExShow(ex, "加载 OptiFine 版本列表信息失败")
OptiFineInfo = ""
OptiFineState = LoadState.Failed
Exit Sub
End Try
Success:
log("[DownloadLeft] 加载 OptiFine 版本列表信息成功")
OptiFineState = LoadState.Success
End Sub
Private Sub OptiFineDownloadStart(ByVal sender As ListItem, ByVal e As System.Windows.Input.MouseButtonEventArgs) Handles item1.ButtonClick, item2.ButtonClick
If IsNothing(sender.Tag) Or Not selecter.SelectIndexName = "OptiFine" Then Exit Sub
'初始化信息
Dim ver As OptiFineVersion = sender.Tag
If WebGroups.ContainsKey("OptiFine " & ver.id) Then
ShowHint(New HintConverter("正在下载中,请勿重复操作", HintState.Warn))
Exit Sub
End If
'获取数据
Try
sender.ShowButton = False
Dim Version As String = Split(ver.id)(0)
Dim BMCLAPIAddress As String = ""
If ver.id.Contains("pre") Then
BMCLAPIAddress = "http://bmclapi2.bangbang93.com/maven/com/optifine/" & ver.id.Split(" ")(0) & "/preview_OptiFine_" & ver.id.Replace(" ", "_").Replace("_pre", "") & ".jar"
Else
BMCLAPIAddress = "http://bmclapi2.bangbang93.com/maven/com/optifine/" & ver.id.Split(" ")(0) & "/OptiFine_" & ver.id.Replace(" ", "_") & ".jar"
End If
'下载
log("[DownloadLeft] 下载 OptiFine:" & ver.id)
ShowHint("OptiFine " & ver.id & " 开始下载")
SendStat("下载", "OptiFine", ver.id)
Dim th As New Thread(Sub()
Try
If ver.getByBMCLAPI Then
WebStart({New WebRequireFile With {.WebURLs = New ArrayList From {
BMCLAPIAddress,
BMCLAPIAddress
}, .LocalFolder = PATH_DOWNLOAD, .LocalName = "OptiFine_" & ver.id.Replace(" ", "_") & ".jar", .KnownFileSize = 1024 * 64}
}, "OptiFine " & ver.id, AddressOf OptiFineDownloadSuccess, AddressOf OptiFineDownloadFail, WebRequireSize.AtLeast)
Else
Dim OfficialAddress As String = ""
Try
OfficialAddress = RegexSearch(GetWebsiteCode(ver.url, New UTF8Encoding(False)), "(?<=Download[^\\s\\S]+a href="")[^""]+")(0)
Catch
End Try
If ReadIni("setup", "DownOptiFine", "1") = "0" Then
'官方
WebStart({New WebRequireFile With {.WebURLs = New ArrayList From {
"http://optifine.net/" & OfficialAddress,
BMCLAPIAddress,
"http://optifine.net/" & OfficialAddress,
BMCLAPIAddress
}, .LocalFolder = PATH_DOWNLOAD, .LocalName = "OptiFine_" & ver.id.Replace(" ", "_") & ".jar", .KnownFileSize = 1024 * 64}
}, "OptiFine " & ver.id, AddressOf OptiFineDownloadSuccess, AddressOf OptiFineDownloadFail, WebRequireSize.AtLeast)
Else
'BMCLAPI
WebStart({New WebRequireFile With {.WebURLs = New ArrayList From {
BMCLAPIAddress,
"http://optifine.net/" & OfficialAddress,
BMCLAPIAddress,
"http://optifine.net/" & OfficialAddress
}, .LocalFolder = PATH_DOWNLOAD, .LocalName = "OptiFine_" & ver.id.Replace(" ", "_") & ".jar", .KnownFileSize = 1024 * 64}
}, "OptiFine " & ver.id, AddressOf OptiFineDownloadSuccess, AddressOf OptiFineDownloadFail, WebRequireSize.AtLeast)
End If
End If
Catch ex As Exception
ExShow(ex, "下载 OptiFine 失败:" & ver.id)
Application.Current.Dispatcher.Invoke(CType(AddressOf OptiFineDownloadFail, ParameterizedThreadStart), ver.id)
End Try
frmMain.Dispatcher.Invoke(Sub() sender.ShowButton = True)
End Sub)
th.Start()
'检查引用版本
If GetFileSize(PATH_MC & "versions\" & Version & "\" & Version & ".jar") < 1024 Then
'引用版本不存在
log("[DownloadLeft] OptiFine 对应的引用版本不存在:" & Version)
Dim RequireVersion As MinecraftVersion = MinecraftGet(Version)
If Not IsNothing(RequireVersion.id) Then MinecraftDownloadStart(RequireVersion)
End If
Catch ex As Exception
ExShow(ex, "处理下载地址时出错", ErrorLevel.MsgboxAndFeedback)
Exit Sub
End Try
End Sub
Private Sub OptiFineDownloadSuccess(ByVal Name As String)
Dim Version As String = Name.Replace("OptiFine ", "")
Try
'If ReadIni("setup", "DownOptiFineOpen", "True") Then RunCMD(PATH_DOWNLOAD & "OptiFine_" & Version.Replace(" ", "_") & ".jar", False)
Process.Start(PATH_DOWNLOAD)
ShowHint(New HintConverter("OptiFine " & Version & " 下载成功", HintState.Finish))
Catch ex As Exception
ExShow(ex, "OptiFine 下载结束后的处理异常")
Try
File.Delete(PATH_DOWNLOAD & "OptiFine_" & Version.Replace(" ", "_") & ".jar")
Catch : End Try
ShowHint(New HintConverter("OptiFine " & Version & " 下载失败:" & GetStringFromException(ex) & "!", HintState.Critical))
End Try
End Sub
Private Sub OptiFineDownloadFail(ByVal Name As String)
Dim Version As String = Name.Replace("OptiFine ", "")
ShowHint(New HintConverter("OptiFine " & Version & " 下载失败", HintState.Critical))
End Sub
#End Region
#Region "ForgeVersion"
Public ForgeVersionState As LoadState = LoadState.Failed '加载状态
Public ForgeVersionArray As New ArrayList '代码分析的数组
Public ForgeVersionInfo As String = "" '获取的代码
Public Sub GetForgeVersionBasic()
'初始化
ForgeVersionState = LoadState.Loading
ForgeVersionArray = New ArrayList
ForgeVersionInfo = ""
If MODE_OFFLINE Then
ForgeVersionState = LoadState.NoConnection
Exit Sub
End If
'获取版本列表
Try
log("[DownloadLeft] 获取Forge可用版本列表开始")
ForgeVersionInfo = GetWebsiteCode("http://bmclapi2.bangbang93.com/forge/minecraft", Encoding.Default)
If Len(ForgeVersionInfo) < 40 Then Throw New WebException("获取到的列表长度不足:" & ForgeVersionInfo)
Catch ex As Exception
ExShow(ex, "获取Forge可用版本列表失败")
ForgeVersionInfo = ""
ForgeVersionState = LoadState.Failed
Exit Sub
End Try
log("[DownloadLeft] 获取Forge可用版本列表成功")
'加载版本列表信息
Try
'添加
'ForgeVersionArray.AddRange(ForgeVersionInfo.Replace("[", "").Replace("]", "").Replace("""", "").Replace("null", "").Replace(",,", "").Split(",")) 'RegexSearch(ForgeVersionInfo, "1.([7-9]{1}.[0-9]+|[0-9]{2}[0-9.]*)(?="")")
ForgeVersionArray = RegexSearch(ForgeVersionInfo, "1.([0-9]{1,2}.[0-9]+|[0-9]{1,2}[0-9.]*)(?="")")
'排序
Dim CurrentPosition As Integer = 1
ForgeVersionArray.Reverse()
Do While CurrentPosition <= ForgeVersionArray.Count - 1
If CurrentPosition < 1 Then CurrentPosition = 1
Dim Smaller() As String = ForgeVersionArray(CurrentPosition).ToString.Split(".")
Dim Larger() As String = ForgeVersionArray(CurrentPosition - 1).ToString.Split(".")
'比较大小
For i = 0 To 2
Select Case Val(If(Larger.Length >= i + 1, Larger(i), "0"))
Case Val(If(Smaller.Length >= i + 1, Smaller(i), "0"))
'相等则不处理,继续比较下一位
Case Is < Val(If(Smaller.Length >= i + 1, Smaller(i), "0"))
'较小
GoTo Swap
Case Else
'较大
GoTo Finish
End Select
Next
GoTo Finish
Swap:
Dim c As String = ForgeVersionArray(CurrentPosition)
ForgeVersionArray(CurrentPosition) = ForgeVersionArray(CurrentPosition - 1)
ForgeVersionArray(CurrentPosition - 1) = c
CurrentPosition = CurrentPosition - 2
Finish:
CurrentPosition = CurrentPosition + 1
Loop
Catch ex As Exception
ExShow(ex, "加载Forge可用版本列表信息失败")
ForgeVersionInfo = ""
ForgeVersionState = LoadState.Failed
Exit Sub
End Try
log("[DownloadLeft] 加载Forge可用版本列表信息成功")
ForgeVersionState = LoadState.Success
End Sub
Private Sub ChangeForgeVersionSelection(ByVal sender As ListItem, ByVal e As EventArgs)
If Not sender.Checked Then Exit Sub
panVersion.Children.Clear()
scrollVersion.Visibility = Visibility.Collapsed
scrollVersion.Value = 0
labRight.Content = "加载中"
ForgeCurrent = sender.MainText
Dim th = New Thread(AddressOf GetForgeBasic)
th.Start(sender.MainText)
End Sub
#End Region
#Region "Forge"
Public ForgeState As LoadState = LoadState.Loading '加载状态
Public ForgeArray As New ArrayList '代码分析的数组
Public ForgeInfo As String = "" '获取的代码
Public ForgeCurrent As String = "" '目前的加载版本
Public Structure ForgeVersion
Dim version As String
Dim build As String
Dim time As String
Dim branch As String
End Structure
Public Sub GetForgeBasic(ByVal version As String)
Try
'初始化
ForgeState = LoadState.Loading
ForgeArray = New ArrayList
ForgeInfo = ""
If MODE_OFFLINE Then
ForgeState = LoadState.NoConnection
Exit Sub
End If
'获取版本列表
Try
log("[DownloadLeft] 获取Forge版本列表开始:" & version)
Dim Data = GetWebsiteCode("http://bmclapi2.bangbang93.com/forge/minecraft/" & version, Encoding.Default)
If Not ForgeCurrent = version Then Exit Sub
ForgeInfo = Data
If Len(ForgeInfo) < 400 Then Throw New WebException("获取到的列表长度不足:" & ForgeInfo)
Catch ex As Exception
ExShow(ex, "获取Forge版本列表失败:" & version)
ForgeInfo = ""
ForgeState = LoadState.Failed
Exit Sub
End Try
log("[DownloadLeft] 获取Forge版本列表成功")
'加载版本列表信息
Try
log("[DownloadLeft] 加载Forge版本列表信息开始")
'预处理
Dim builds As ArrayList = RegexSearch(ForgeInfo, "(?<=""build"":)[0-9]*")
Dim versions As ArrayList = RegexSearch(ForgeInfo, "(?<=""version"":"")[0-9.]*")
Dim branchs As ArrayList = RegexSearch(ForgeInfo, "(?<=""branch"":)[^,]*")
Dim times As ArrayList = RegexSearch(ForgeInfo, "(?<=modified"":"")[0-9.\-]*")
'检查
If Not (builds.Count = versions.Count And versions.Count = times.Count And branchs.Count = times.Count) Then Throw New WebException("获取到的列表长度不等")
If Not ForgeCurrent = version Then Exit Sub
'添加
For i = builds.Count - 1 To 0 Step -1
ForgeArray.Add(New ForgeVersion With {.build = builds(i), .version = versions(i), .time = times(i), .branch = branchs(i)})
Next
Catch ex As Exception
ExShow(ex, "加载Forge版本列表信息失败:" & version)
ForgeInfo = ""
ForgeState = LoadState.Failed
Exit Sub
End Try
log("[DownloadLeft] 加载Forge版本列表信息成功")
ForgeState = LoadState.Success
Catch
End Try
End Sub
Private Sub ForgeDownloadStart(ByVal sender As ListItem, ByVal e As System.Windows.Input.MouseButtonEventArgs)
If IsNothing(sender.Tag) Or Not selecter.SelectIndexName = "Forge" Then Exit Sub
'初始化信息
Dim ver As ForgeVersion = sender.Tag
If WebGroups.ContainsKey("Forge " & ver.version) Then
ShowHint(New HintConverter("正在下载中,请勿重复操作", HintState.Warn))
Exit Sub
End If
'选择操作
If Val(ReadIni("setup", "DownForgeAction", "-1")) = "-1" Then
WriteIni("setup", "DownForgeAction", MyMsgbox("在 Forge 下载结束后,是自动安装该版本,还是打开下载文件夹但是不安装?你稍候可以在设置页面中再修改这个设置。" & vbCrLf & "如果你不清楚如何手动安装 Forge,建议选择自动安装。", "选择默认动作", "自动安装", "只打开文件夹") - 1)
End If
'下载
log("[DownloadLeft] 下载Forge:" & ver.build)
ShowHint("Forge " & ver.version & " 开始下载")
SendStat("下载", "Forge", ver.version, ver.build)
Dim th As New Thread(Sub()
Try
Dim FileName As String = ForgeCurrent & "-" & ver.version & If(ver.branch = "null", "", "-" & ver.branch.Replace("""", ""))
WebStart({New WebRequireFile With {
.WebURLs = New ArrayList From {
"http://bmclapi2.bangbang93.com/forge/download/" & ver.build,
"http://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/" & FileName & "/forge-" & FileName & "-installer.jar",
"http://files.minecraftforge.net/maven/net/minecraftforge/forge/" & FileName & "/forge-" & FileName & "-installer.jar",
"http://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/" & FileName & "/forge-" & FileName & "-universal.zip",
"http://files.minecraftforge.net/maven/net/minecraftforge/forge/" & FileName & "/forge-" & FileName & "-universal.zip",
"http://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/" & FileName & "/forge-" & FileName & "-universal.jar",
"http://files.minecraftforge.net/maven/net/minecraftforge/forge/" & FileName & "/forge-" & FileName & "-universal.jar",
"http://bmclapi2.bangbang93.com/maven/net/minecraftforge/forge/" & FileName & "/forge-" & FileName & "-client.zip",
"http://files.minecraftforge.net/maven/net/minecraftforge/forge/" & FileName & "/forge-" & FileName & "-client.zip"},
.LocalFolder = PATH_DOWNLOAD, .KnownFileSize = 1024 * 16
}}, "Forge " & ver.version, AddressOf ForgeDownloadSuccess, AddressOf ForgeDownloadFail, WebRequireSize.AtLeast)
Catch ex As Exception
ExShow(ex, "下载Forge失败:" & ver.version)
Application.Current.Dispatcher.Invoke(CType(AddressOf ForgeDownloadFail, ParameterizedThreadStart), ver.version)
End Try
End Sub)
th.Start()
'检查引用版本
If GetFileSize(PATH_MC & "versions\" & ForgeCurrent & "\" & ForgeCurrent & ".jar") < 1024 Then
'引用版本不存在
log("[DownloadLeft] Forge 对应的引用版本不存在:" & ForgeCurrent)
Dim RequireVersion As MinecraftVersion = MinecraftGet(ForgeCurrent)
If Not IsNothing(RequireVersion.id) Then MinecraftDownloadStart(RequireVersion)
End If
End Sub
Private Sub ForgeDownloadSuccess(ByVal Name As String)
Dim Version = Name.Replace("Forge ", "")
Try
If Val(ReadIni("setup", "DownForgeAction", "1")) = 0 Then
'自动安装
Try
Dim FoundFile As Boolean = False
For Each File As FileInfo In New DirectoryInfo(PATH_DOWNLOAD).EnumerateFiles
If File.Name.Contains(Version) Then
log("[DownloadLeft] 自动安装目标文件:" & File.FullName)
FoundFile = True
If Not File.Name.Contains("installer") Then
NotSupport:
ShowHint(New HintConverter("Forge " & Version & " 下载成功,但该版本过老,不支持自动安装", HintState.Finish))
Process.Start(PATH_DOWNLOAD)
Exit Sub
End If
'自动安装
Dim InstallDir As String = PATH & "PCL\cache\forgeinstall\" & Version
Directory.CreateDirectory(InstallDir)
Using zip As New ZipFile(File.FullName)
zip.ExtractSelectedEntries("install_profile.json", "", InstallDir, ExtractExistingFileAction.OverwriteSilently)
Dim Json As JObject = ReadJson(ReadFileToEnd(InstallDir & "\install_profile.json"))
'判断是否为 1.5-1.6 的 Forge
Dim FilePath As String = Json("install")("filePath").ToString
If FilePath.Contains("-1.5") Or FilePath.Contains("-1.6") Then
Directory.Delete(InstallDir, True)
GoTo NotSupport
End If
ShowHint(New HintConverter("Forge " & Version & " 下载成功", HintState.Finish))
'解压Forge主文件
Dim LibPath As String = GetPathFromFullPath(GetPathFromLibrary(Json("install")("path")))
Directory.CreateDirectory(LibPath)
zip.ExtractSelectedEntries(FilePath, "", LibPath, ExtractExistingFileAction.OverwriteSilently)
IO.File.Delete(GetPathFromLibrary(Json("install")("path")))
FileSystem.Rename(LibPath & FilePath, GetPathFromLibrary(Json("install")("path")))
'输出Json
Dim VersionId As String = Json("versionInfo")("id")
Dim VersionPath As String = PATH_MC & "versions\" & VersionId & "\"
Directory.CreateDirectory(VersionPath)
WriteFile(VersionPath & VersionId & ".json", Json("versionInfo").ToString)
'删除缓存文件夹
Directory.Delete(InstallDir, True)
'刷新版本列表
Dim th As New Thread(AddressOf PoolVersionList)
th.Start()
End Using
ShowHint(New HintConverter("Forge " & Version & " 安装成功", HintState.Finish))
End If
If FoundFile Then GoTo FoundFile
Next
ShowHint(New HintConverter("Forge " & Version & " 下载成功,但未找到自动安装文件", HintState.Finish))
FoundFile:
Catch ex As Exception
ExShow(ex, "Forge " & Version & " 安装失败", ErrorLevel.AllUsers)
End Try
Else
'只打开文件夹
Process.Start(PATH_DOWNLOAD)
ShowHint(New HintConverter("Forge " & Version & " 下载成功", HintState.Finish))
End If
Catch ex As Exception
ExShow(ex, "Forge下载结束后的处理异常:" & Version)
Try
File.Delete(PATH_DOWNLOAD & "Forge_" & Version & ".jar")
Catch : End Try
ShowHint(New HintConverter("Forge " & Version & " 下载失败:" & GetStringFromException(ex) & "!", HintState.Critical))
End Try
End Sub
Private Sub ForgeDownloadFail(ByVal Name As String)
Dim Version As String = Name.Replace("Forge ", "")
ShowHint(New HintConverter("Forge " & Version & " 下载失败", HintState.Critical))
End Sub
#End Region
End Class