GadgetPacker - Windows Gadget Build Tool

Imports System.IO
Imports System.IO.Packaging

Public Class FormMain
Private zipFilePath As String
Private zipFileName As String
Private zipFileNameTemp As String
Private zipFullName As String

Private stopWatch As New System.Diagnostics.Stopwatch()
Private WithEvents timer As New Timer()
Private buildFiles As New List(Of String)

Private shiftPressed As Boolean = False

Private Sub FormMain_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
    shiftPressed = e.Shift
    Me.Text = "Gadget Packer : Shift Pressed : Will Not AutoClose"
End Sub

Private Sub FormMain_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

    'This is a basic timer to allow the mainform time to load before starting the build process
    timer.Interval = 1000
    timer.Start()
End Sub

Private Sub timer_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles timer.Tick
    'Finished with the timer
    timer.Stop()

    'Start the build process running
    BeginProcess()
End Sub

Private Sub BeginProcess()

    'Set the start time
    stopWatch.Reset()
    stopWatch.Start()

    'Clear the text box, this may be a retry
    TextBoxLog.Text = String.Empty

    WriteMessage("Commence Gadget Build Process", True)
    WriteMessage(New String("-", 50), True)
    ProgressBar.Value = 0

    'Create the required filenames etc.
    BuildFileNames()

    ProgressBar.Value = 5

    'Delete the existing temp file
    WriteMessage(String.Empty, True)
    WriteMessage("Remove Existing temporary build file: ")
    If File.Exists(zipFilePath + "\" + zipFileNameTemp) Then
        WriteMessage("Found.", True)
        File.Delete(zipFilePath + "\" + zipFileNameTemp)
    Else
        WriteMessage("Not Found.", True)
    End If

    ProgressBar.Value = 10

    'Locate all the build files
    getBuildFiles()

    ProgressBar.Value = 15

    'Display the Build Queue
    WriteMessage(String.Empty, True)
    WriteMessage("Build Queue Contains the following files;", True)
    For Each item As String In buildFiles
        WriteMessage(item, True)
    Next
    WriteMessage(buildFiles.Count.ToString + " item(s).", True)
    ProgressBar.Value = 20

    'Generate Gadget
    buildGadget()

    WriteMessage(String.Empty, True)

    'Make / replace existing temp file the final one
    WriteMessage("Creating final gadget file: " + zipFileName, True)
    File.Copy(zipFilePath + "\" + zipFileNameTemp, zipFilePath + "\" + zipFileName, True)
    ProgressBar.Value = 95
    'delete the old temporary build file
    WriteMessage("Removing temporary gadget file: " + zipFileNameTemp, True)
    File.Delete(zipFilePath + "\" + zipFileNameTemp)
    ProgressBar.Value = 100

    Stopwatch.Stop()

    WriteMessage(String.Empty, True)
    WriteMessage("Build Process completed.", True)
    WriteMessage("Duration: " + stopWatch.ElapsedMilliseconds.ToString + "ms.")

    WriteMessage(String.Empty, True)
    WriteMessage("Start Gadget Installation........", True)
    Process.Start(New String(zipFilePath + "\" + zipFileName))

    ButtonReRun.Enabled = True

    If shiftPressed Then
        WriteMessage("Shift was pressed......not exiting.", True)
        Else
        WriteMessage("Closing application", True)
        Me.Close()
    End If

End Sub

Private Sub BuildFileNames()
    'Get the path for the new zipfile
    WriteMessage("Getting Path Information:", True)
    zipFilePath = Application.StartupPath
    WriteMessage("Path = " + zipFilePath, True)

    'Get the name for the new zipfile
    zipFileName = New FileInfo(Application.ExecutablePath).Name
    zipFileName = Mid(zipFileName, 1, zipFileName.LastIndexOf(".")) + ".gadget"
    zipFileNameTemp = zipFileName + ".temp"
    WriteMessage("Temporary Name: " + zipFileNameTemp, True)
    WriteMessage("Gadget Name: " + zipFileName, True)

End Sub

Private Sub getBuildFiles()

    WriteMessage("Locating buildfiles;", True)

    'Clear the existing list, maybe a retry
    buildFiles.Clear()

    'Start the search
    Dir(zipFilePath)

    'The search will also find the exe and any previous gadget file build
    'these must be removed
    WriteMessage("Removing previous Gadget file from queue: ")
    If buildFiles.Contains(New String(zipFilePath + "\" + zipFileName).ToLower) Then
        WriteMessage("Found: ")
        If buildFiles.Remove(New String(zipFilePath + "\" + zipFileName).ToLower) Then
            WriteMessage("Removed.", True)
        End If
        Else
        WriteMessage("Not Found.", True)
    End If
    WriteMessage("Removing packer From queue: ")
    If buildFiles.Contains(Application.ExecutablePath.ToLower) Then
        WriteMessage("Found: ")
        If buildFiles.Remove(Application.ExecutablePath.ToLower) Then
            WriteMessage("Removed.", True)
        End If
        Else
        WriteMessage("Not Found.", True)
    End If

End Sub

Private Sub buildGadget()
    WriteMessage(String.Empty, True)
    WriteMessage("Build Gadget File.........", True)

    Dim progressStartVal = ProgressBar.Value
    Dim progressTargetVal = 90

    Dim fileCount As Integer = 0
    'Create the temp package
    Using zip As ZipPackage = ZipPackage.Open(zipFilePath + "\" + zipFileNameTemp, FileMode.CreateNew, FileAccess.ReadWrite, FileShare.None)

        'Process each part
        For Each item As String In buildFiles
            'Take each file, create the relevant info for the zip file
            Dim partUri As Uri = PackUriHelper.CreatePartUri(New Uri(getURI(item), UriKind.Relative))
            WriteMessage("Adding: " + partUri.ToString, True)

            'Create the package part
            Dim zipPart As ZipPackagePart = zip.CreatePart(partUri, getMimeType(item))

            'Copy the Source data to the package part
            Using fileStream As New FileStream(item, FileMode.Open, FileAccess.Read)
                CopyStream(fileStream, zipPart.GetStream())
            End Using

            fileCount += 1

            ProgressBar.Value = ((progressTargetVal - progressStartVal) * (fileCount / buildFiles.Count)) + progressStartVal

        Next

    End Using

    WriteMessage("Added " + fileCount.ToString + " item(s) to gadget.", True)

End Sub

Private Function getURI(ByVal Path As String) As String
    'Take an incoming path and convert it to a suitable uri
    'each file is relative to the path that this app is running in

    'create the relative part
    Dim uri = Mid(Path, Len(zipFilePath) + 1)

    Return uri
End Function

        Private Shared Sub CopyStream(ByVal source As Stream, ByVal target As Stream)
            Const bufSize As Integer = &H1000
            Dim buf(bufSize - 1) As Byte
            Dim bytesRead As Integer = 0
            bytesRead = source.Read(buf, 0, bufSize)
            Do While bytesRead > 0
                target.Write(buf, 0, bytesRead)
                bytesRead = source.Read(buf, 0, bufSize)
            Loop
        End Sub


Private Sub WriteMessage(ByVal Message As String)

    'Write the message
    TextBoxLog.AppendText(Message)

    'move to the end
    TextBoxLog.SelectionStart = Len(TextBoxLog.Text.Length)

    'Scroll to the current position
    TextBoxLog.ScrollToCaret()
End Sub

Private Sub WriteMessage(ByVal Message As String, ByVal AddNewLine As Boolean)

TextBoxLog.Focus()
    'Write the message
    WriteMessage(Message)
    'Write the new line / carriage return
    If AddNewLine Then TextBoxLog.AppendText(vbCrLf)

    TextBoxLog.SelectionStart = TextBoxLog.TextLength
    TextBoxLog.SelectionLength = 0

    'Scroll to the current position
    TextBoxLog.ScrollToCaret()

End Sub


Private Sub Dir(ByVal Path As String)

    Dim files As New List(Of String)
    Dim dirs As New List(Of String)

    files = Directory.GetFiles(Path).ToList
    dirs = Directory.GetDirectories(Path).ToList

    For Each item As String In files
        buildFiles.Add(item.ToLower)            'switch everything to lower case
        WriteMessage(item, True)
    Next

    For Each item As String In dirs
        Dir(item)
    Next

End Sub

'Perfrom a registry lookup for the mime types
Private Function getMimeType(ByVal path As String) As String

    Dim mime = String.Empty
    Dim ext = System.IO.Path.GetExtension(path).ToLower()

    Dim rk As Microsoft.Win32.RegistryKey = My.Computer.Registry.ClassesRoot.OpenSubKey(ext)

    Try
        mime = rk.GetValue("Content Type").ToString()
    Catch ex As Exception
        WriteMessage("ERROR: Cannot determine content type for: " + path + "; Setting to contentype/unknown", True)
        mime = "contenttype/uknown"
    End Try

    Return mime

End Function

Private Sub ButtonReRun_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonReRun.Click
    'Rerun the process
    ButtonReRun.Enabled = False
    BeginProcess()
End Sub
End Class