Imports System.Net Imports System Imports System.IO Public Class Form6 Dim WithEvents WC As New WebClient Dim appPath As String = Application.StartupPath() Dim up As String Private IsFormBeingDragged As Boolean = False Private MouseDownX As Integer Dim file As System.IO.FileStream Private MouseDownY As Integer Dim downweb As String Dim z As String Dim road As String Private Sub Form6_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load For counter = 10 To 90 Step +20 Me.Opacity = counter / 100 Me.Refresh() Threading.Thread.Sleep(50) Next Me.Opacity = 100 For Each Dir As String In Directory.GetDirectories(appPath & "\system\minecraft") Dim filePath As String = Dir Dim split As String() = filePath.Split("\") Dim parentFolder As String = split(split.Length - 1) ListBox2.Items.Add(parentFolder) Next If My.Computer.FileSystem.FileExists(appPath & "\system\update.wtc") Then Try My.Computer.FileSystem.DeleteFile(appPath & "\system\update.wtc") Label1.Text = "正在刪除舊資料…" Catch ex As Exception End Try End If Label1.Text = "正連接伺服器取得最新更新列表" WC.DownloadFileAsync(New Uri("http://hkwtc.no-ip.org:8080/hkwtcbs/DreamMelody/Download/update.txt"), appPath & "\system\update.wtc") End Sub Private Sub Form6_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseDown If e.Button = MouseButtons.Left Then IsFormBeingDragged = True MouseDownX = e.X MouseDownY = e.Y End If End Sub Private Sub Form6_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseUp If e.Button = MouseButtons.Left Then IsFormBeingDragged = False End If End Sub Private Sub Form6_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseMove If IsFormBeingDragged Then Dim temp As Point = New Point() temp.X = Me.Location.X + (e.X - MouseDownX) temp.Y = Me.Location.Y + (e.Y - MouseDownY) Me.Location = temp temp = Nothing End If End Sub Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick If My.Computer.FileSystem.FileExists(appPath & "\system\update.wtc") Then Try up = My.Computer.FileSystem.ReadAllText(appPath & "\system\update.wtc") Timer1.Enabled = False 'Display Dim theObjContents As New ArrayList Using objReader As New IO.StreamReader(appPath & "\system\update.wtc") While objReader.EndOfStream = False ListBox1.Items.Add(objReader.ReadLine) Label1.Text = "已下載最新列表" End While End Using Catch ex As Exception Label1.Text = ex.Message End Try Else Label1.Text = "出現了錯誤,請檢查網絡" End If End Sub Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click Dim iCount As Integer For iCount = 90 To 10 Step -10 Me.Opacity = iCount / 100 Threading.Thread.Sleep(50) Next Me.Close() End Sub Private Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged End Sub Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Timer2.Enabled = True downweb = ListBox1.SelectedItem downweb = Replace(downweb, vbCrLf, "") downweb = Replace(downweb, vbNewLine, "") If ListBox1.SelectedItem = "" Then Label1.Text = "請選擇更新版本" Else If My.Computer.FileSystem.FileExists(appPath & "\system\data\download.wtc") Then My.Computer.FileSystem.DeleteFile(appPath & "\system\data\download.wtc") End If If My.Computer.FileSystem.DirectoryExists(appPath & "\system\minecraft\" & downweb) = True Then Label1.Text = "這版本已經存在,請先刪除舊版本再重新安裝。" ElseIf My.Computer.FileSystem.DirectoryExists(appPath & "\system\minecraft\" & downweb) = False Then Try file = System.IO.File.Create(appPath & "\system\data\download.wtc") file.Dispose() Dim sb As New System.Text.StringBuilder sb.AppendLine(downweb) IO.File.WriteAllText((appPath & "\system\data\download.wtc"), sb.ToString(), System.Text.Encoding.GetEncoding(950)) Threading.Thread.Sleep(100) Form7.Show() Catch ex As Exception End Try Else Label1.Text = "出現錯誤了" End If End If End Sub Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click If My.Computer.FileSystem.DirectoryExists(appPath & "\system\minecraft") Then Try System.IO.Directory.Delete(appPath & "\system\minecraft\", FileIO.DeleteDirectoryOption.DeleteAllContents) Catch ex As Exception MsgBox(ex.Message) End Try Threading.Thread.Sleep(50) ListBox2.Items.Clear() Try For Each Dir As String In Directory.GetDirectories(appPath & "\system\minecraft") Dim filePath As String = Dir Dim split As String() = filePath.Split("\") Dim parentFolder As String = split(split.Length - 1) ListBox2.Items.Add(parentFolder) Next Catch ex As Exception End Try If My.Computer.FileSystem.DirectoryExists(appPath & "\system\minecraft") = False Then My.Computer.FileSystem.CreateDirectory(appPath & "\system\minecraft") End If End If End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click If My.Computer.FileSystem.DirectoryExists(appPath & "\system\minecraft") Then Try System.IO.Directory.Delete(appPath & "\system\minecraft\" & ListBox2.SelectedItem, True) Catch ex As Exception MsgBox(ex.Message) End Try Threading.Thread.Sleep(50) ListBox2.Items.Clear() For Each Dir As String In Directory.GetDirectories(appPath & "\system\minecraft") Dim filePath As String = Dir Dim split As String() = filePath.Split("\") Dim parentFolder As String = split(split.Length - 1) ListBox2.Items.Add(parentFolder) Timer2.Enabled = False Next End If End Sub Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick If My.Computer.FileSystem.FileExists(appPath & "\system\data\download.wtc") = False Then ListBox2.Items.Clear() For Each Dir As String In Directory.GetDirectories(appPath & "\system\minecraft") Dim filePath As String = Dir Dim split As String() = filePath.Split("\") Dim parentFolder As String = split(split.Length - 1) ListBox2.Items.Add(parentFolder) Timer2.Enabled = False Next End If End Sub Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click Dim fd As OpenFileDialog = New OpenFileDialog() Dim strFileName As String Try fd.Title = "請選擇匯入的安裝檔" fd.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) fd.Filter = "夢裡的音符安裝檔|*.nar" fd.FilterIndex = 2 fd.RestoreDirectory = True Catch ex As Exception End Try If fd.ShowDialog() = DialogResult.OK Then strFileName = fd.FileName TextBox1.Text = strFileName Threading.Thread.Sleep(50) If My.Computer.FileSystem.FileExists(appPath & "\system\data\install.exe") Then My.Computer.FileSystem.DeleteFile(appPath & "\system\data\install.exe") End If Threading.Thread.Sleep(200) My.Computer.FileSystem.CopyFile(TextBox1.Text, appPath & "\system\data\install.exe") Shell(appPath & "\system\data\install.exe") Threading.Thread.Sleep(50) Dim filePath As String = TextBox1.Text Dim split As String() = filePath.Split(".") Dim parentFolder As String = split(split.Length - 2) Threading.Thread.Sleep(200) Do Until My.Computer.FileSystem.FileExists(appPath & "\info.txt") Label1.Text = "載入匯入安裝檔資訊…" Loop Do Until My.Computer.FileSystem.FileExists(appPath & "\info.txt") = False Try road = My.Computer.FileSystem.ReadAllText(appPath & "\info.txt") Threading.Thread.Sleep(200) Try Do While My.Computer.FileSystem.FileExists(appPath & "\info.txt") = True Try My.Computer.FileSystem.CopyDirectory(appPath & "\" & road, appPath & "\system\minecraft\" & road) My.Computer.FileSystem.DeleteDirectory(appPath & "\" & road, FileIO.DeleteDirectoryOption.DeleteAllContents) Timer2.Enabled = True Catch ex As Exception End Try If My.Computer.FileSystem.FileExists(appPath & "\info.txt") Then My.Computer.FileSystem.DeleteFile(appPath & "\info.txt") End If Loop Catch ex As Exception End Try Catch ex As Exception End Try Loop End If End Sub End Class