Visual Basic

"You can have everything in life you want if you will just help enough other people get what they want." --Zig Ziglar

Coming soon: The Second EuroCPian Event

Imports System.IO
Imports System.Net

Public Class frmMain
    Inherits System.Windows.Forms.Form

#Region " Windows Form Designer generated code "

    Public Sub New()
        MyBase.New()

        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Add any initialization after the InitializeComponent() call

    End Sub

    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    Friend WithEvents Button1 As System.Windows.Forms.Button
    Friend WithEvents RichTextBox1 As System.Windows.Forms.RichTextBox
    Friend WithEvents ProgressBar1 As System.Windows.Forms.ProgressBar
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(frmMain))
        Me.Button1 = New System.Windows.Forms.Button
        Me.RichTextBox1 = New System.Windows.Forms.RichTextBox
        Me.ProgressBar1 = New System.Windows.Forms.ProgressBar
        Me.SuspendLayout()
        '
        'Button1
        '
        Me.Button1.Enabled = False
        Me.Button1.FlatStyle = System.Windows.Forms.FlatStyle.System
        Me.Button1.Location = New System.Drawing.Point(360, 8)
        Me.Button1.Name = "Button1"
        Me.Button1.Size = New System.Drawing.Size(72, 32)
        Me.Button1.TabIndex = 2
        Me.Button1.Text = "Launch"
        '
        'RichTextBox1
        '
        Me.RichTextBox1.Location = New System.Drawing.Point(8, 48)
        Me.RichTextBox1.Name = "RichTextBox1"
        Me.RichTextBox1.Size = New System.Drawing.Size(424, 224)
        Me.RichTextBox1.TabIndex = 3
        Me.RichTextBox1.Text = ""
        '
        'ProgressBar1
        '
        Me.ProgressBar1.Location = New System.Drawing.Point(8, 8)
        Me.ProgressBar1.Name = "ProgressBar1"
        Me.ProgressBar1.Size = New System.Drawing.Size(344, 32)
        Me.ProgressBar1.TabIndex = 4
        '
        'frmMain
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
        Me.ClientSize = New System.Drawing.Size(442, 280)
        Me.ControlBox = False
        Me.Controls.Add(Me.ProgressBar1)
        Me.Controls.Add(Me.RichTextBox1)
        Me.Controls.Add(Me.Button1)
        Me.Font = New System.Drawing.Font("Verdana", 8.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
        Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
        Me.Name = "frmMain"
        Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
        Me.Text = "Updating Software..."
        Me.ResumeLayout(False)

    End Sub

#End Region

    Private Sub CopyFromInternet(ByVal Source As String, ByVal Destination As String, Optional ByVal Size As Long = 0)
        Dim wc As New WebClient

        ' Does the file exist?
        Dim str As Stream
        Dim outstr As Stream
        Dim bw As BinaryWriter
        Dim br As BinaryReader
        Try
            str = wc.OpenRead(Source)
            If wc.ResponseHeaders.Item("Content-Type") = "text/html" Then
                If wc.ResponseHeaders.Item("Content-Location").IndexOf("404") > 0 Then
                    Throw New FileNotFoundException("The file '" & Source & "' was not found.")
                End If
            End If
        Finally
            str.Close()
        End Try

        Debug.WriteLine("Destination: " & Destination)
        ' Download the file
        If Size = 0 Then
            wc.DownloadFile(Source, Destination)
        Else
            str = wc.OpenRead(Source)
            br = New BinaryReader(str)
            outstr = New FileStream(Destination, FileMode.Create)
            bw = New BinaryWriter(outstr)
            For x As Integer = 1 To Math.Floor(Size / 4096)
                bw.Write(br.ReadBytes(4096))
            Next
            bw.Write(br.ReadBytes(Size Mod 4096))
            bw.Close()
            br.Close()
            outstr.Close()
            str.Close()
        End If

        wc.Dispose()
    End Sub

    Private Sub RtfWrite(ByVal TextColor As Color, ByVal Text As String)
        RichTextBox1.SelectionColor = TextColor
        RichTextBox1.AppendText(Text)
        Application.DoEvents()
    End Sub

    Private Sub RtfWriteLine(ByVal TextColor As Color, ByVal Text As String)
        RtfWrite(TextColor, Text & ControlChars.CrLf)
    End Sub

    Private ReadOnly DEBUG_TEXT As Color = Color.Gray
    Private ReadOnly NORMAL_TEXT As Color = Color.Black
    Private ReadOnly ERROR_TEXT As Color = Color.Red

    Private LaunchPath As String
    Private BadInstall As Boolean = False

    Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim params() As String = Environment.GetCommandLineArgs

        If params.GetUpperBound(0) <> 3 Then ' Wrong parameter count
            MsgBox("This program was launched incorrectly.  Please contact support.", MsgBoxStyle.OKOnly, "Error AutoUpdating Application")
            Application.Exit()
            Exit Sub ' Used because in release mode, the application will continue past this point.
        End If

        LaunchPath = params(3)

        'Application.EnableVisualStyles()
        Me.Show()
        Application.DoEvents()

        ' Get our temp folder
        Dim temppath As String = Path.GetTempFileName
        If File.Exists(temppath) Then File.Delete(temppath)
        Directory.CreateDirectory(temppath)

        Dim sr As StreamReader

        Try
            RtfWrite(NORMAL_TEXT, "Retrieving update information...")
            CopyFromInternet(params(1), temppath & "\updateinfo.txt")
            RtfWriteLine(NORMAL_TEXT, "done.")

            sr = New StreamReader(temppath & "\updateinfo.txt")
            ProgressBar1.Value = 0
            ProgressBar1.Minimum = 0
            ProgressBar1.Maximum = sr.BaseStream.Length + 2 ' In case the last line doesn't have a CRLF
            While sr.Peek <> -1

                Dim s As String = sr.ReadLine
                ProgressBar1.Value += s.Length + 2
                s = s.Trim
                Dim process As Boolean = True

                If s.StartsWith("'") Then process = False
                If s.Length = 0 Then process = False
                If s.IndexOf(",") = -1 Then process = False

                If process Then

                    Dim fparams() As String = s.Split(",")

                    If fparams.GetUpperBound(0) < 1 Or fparams.GetUpperBound(0) > 2 Then
                        Throw New ArgumentException("The update file was not properly formed.")
                    End If
                    RtfWrite(NORMAL_TEXT, "Retrieving " & fparams(1) & "...")
                    If fparams.GetUpperBound(0) = 1 Then
                        CopyFromInternet(fparams(0), temppath & "\" & fparams(1))
                    Else
                        CopyFromInternet(fparams(0), temppath & "\" & fparams(1), CLng(fparams(2)))
                    End If
                    RtfWriteLine(NORMAL_TEXT, "done.")

                End If


            End While

            ProgressBar1.Value = 0
            Dim di As New DirectoryInfo(temppath)
            ProgressBar1.Maximum = di.GetFiles.GetUpperBound(0) + 1

            If Not Directory.Exists(params(2)) Then
                Directory.CreateDirectory(params(2))
            End If

            RtfWrite(NORMAL_TEXT, "Installing update to " & params(2) & "...")
            Try
                For Each f As FileInfo In di.GetFiles
                    Dim CopyTo As String = params(2) & "\" & f.Name
                    If File.Exists(CopyTo) Then
                        File.SetAttributes(CopyTo, FileAttributes.Archive)
                    End If
                    f.CopyTo(CopyTo, True)
                    ProgressBar1.Value += 1
                    Application.DoEvents()
                Next
                RtfWriteLine(NORMAL_TEXT, "done.")
            Catch ex As Exception
                RtfWriteLine(ERROR_TEXT, "ERROR!")
                RtfWriteLine(ERROR_TEXT, "DO NOT USE THIS PROGRAM UNTIL IT IS REINSTALLED!")
                RtfWriteLine(ERROR_TEXT, "One or more of the files necessary to use the program did not install properly.")
                RtfWriteLine(ERROR_TEXT, "Please contact support immediately.")
                BadInstall = True
                Button1.Text = "Close"
            End Try

        Catch ex As Exception
            RtfWriteLine(NORMAL_TEXT, "")
            RtfWriteLine(ERROR_TEXT, "ERROR: " & ex.Message)
            RtfWriteLine(ERROR_TEXT, ex.StackTrace)
        Finally
            ' Clean up temp files
            If Not sr Is Nothing Then sr.Close()
            If Directory.Exists(temppath) Then
                Directory.Delete(temppath, True)
            End If
            Button1.Enabled = True
        End Try

    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        If Not BadInstall Then
            Dim objProcess As New System.Diagnostics.Process
            objProcess.StartInfo.FileName = LaunchPath
            objProcess.StartInfo.WindowStyle = ProcessWindowStyle.Normal
            objProcess.Start()
        End If
        Application.Exit()
    End Sub
End Class

Module InPoint
    Sub Main()
        Application.EnableVisualStyles()
        Application.DoEvents()
        Dim f As New frmMain
        f.ShowDialog()
    End Sub
End Module