liteWait PowerPoint to HTML Converter

Imports System
Imports System.IO
Imports System.Collections
Imports System.ComponentModel
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Resources
Imports System.Threading

'liteWait PowerPoint converter by James Coleman colema18@pilot.msu.edu
'liteWait is a small little app that runs in the system tray
'it will can a particular directory for .ppt files that were created or modified since the last time it ran
'each .ppt file will be converted to html and stored in a specified location
'this will allow users to view the html version if they have low bandwidth or just want to preview it before downloading the entire .ppt


Public Class Form1
    Inherits System.Windows.Forms.Form

    Private components As System.ComponentModel.IContainer
    Private mSmileIcon As New Icon("face02.ico")
    Private mFrownIcon As New Icon("face04.ico")
    Private ScanDir As String
    Private ScanInterval As Integer
    Private HTMLdir As String
    Private LastRun As Date = Date.Parse("4/1/2002")
    Private FinishedLastJob As Boolean = True
    Private pptsConverted As Integer = 0
    Private pptArray As ArrayList = New ArrayList()
    Private FTargetFile As String = ""
    Private ppApp As PowerPoint.Application

    Public Sub New()
        MyBase.New()
        InitializeComponent()

        'initialize the tracer for debuggin and log entries
        Dim myTraceLog As New System.IO.FileStream("liteWait_log.txt", IO.FileMode.OpenOrCreate)
        Dim myListener As New TextWriterTraceListener(myTraceLog)
        Trace.Listeners.Add(myListener)

        'hide this form because their is no GUI
        Me.Hide()

        'setup the tray icon
        Initializenotifyicon()

        'get the settings from the xml file
        InitializeSettings()

        ppApp = New PowerPoint.Application()
    End Sub

    'gets the settings from the xml file
    Public Function InitializeSettings()
        Dim dsSettings As New DataSet("settings")
        dsSettings.ReadXml("settings.xml")
        ScanDir = dsSettings.Tables("settings").Rows(0).Item("scanDirectory")
        ScanInterval = CInt(dsSettings.Tables("settings").Rows(0).Item("scanInterval"))
        HTMLdir = dsSettings.Tables("settings").Rows(0).Item("htmlDirectory")
        If Not dsSettings.Tables("settings").Rows(0).Item("lastRun") = "" Then
            LastRun = CDate(dsSettings.Tables("settings").Rows(0).Item("lastRun"))
        End If
        Timer1.Interval = ScanInterval * 60000
        Timer1.Enabled = True
        Timer1.Start()
    End Function

    'save the form values to the xml file
    Public Sub saveSettings()
        Dim dsSettings As New DataSet("settings")
        dsSettings.ReadXml("settings.xml")
        dsSettings.Tables("settings").Rows(0).Item("scanDirectory") = ScanDir
        dsSettings.Tables("settings").Rows(0).Item("scanInterval") = ScanInterval.ToString
        dsSettings.Tables("settings").Rows(0).Item("htmlDirectory") = HTMLdir
        dsSettings.Tables("settings").Rows(0).Item("lastRun") = LastRun.ToString
        dsSettings.WriteXml("settings.xml")
        dsSettings = Nothing
    End Sub

    'call RunCrawl from timer tick event
    Private Sub Timer1_Tick(ByVal Sender As Object, ByVal e As EventArgs) Handles Timer1.Tick
        RunCrawl()
    End Sub

    'start the crawl
    Private Sub RunCrawl()
        'make sure we are finished with our last crawl before we crawl again
        If FinishedLastJob = True Then
            FinishedLastJob = False
            InitializeSettings()
            Dim newLastRun As Date = Now
            Try
                ProcessDirectory(ScanDir)
            Catch ex As Exception
                HandleMessage("LiteWait Error: ProcessDirectory - " & Now.ToString, ex.Message & vbCr & ex.Source & vbCr & ex.StackTrace)
            End Try
            Try
                ProcessArrayList()
            Catch ex As Exception
                HandleMessage("LiteWait Error: ProcessArrayList - " & Now.ToString, ex.Message & vbCr & ex.Source & vbCr & ex.StackTrace)
            End Try
            LastRun = newLastRun
            traceIt(Now.ToString & ": ppt crawl completed (" & pptsConverted.ToString & " files converted)")
            pptsConverted = 0
            saveSettings()
            FinishedLastJob = True
        Else
            traceIt(Now.ToString & ": did not start crawl due to the fact that the last crawl has not finished yet")
        End If
    End Sub

    'email someone to keep them in the loop
    Private Sub HandleMessage(ByVal subject As String, ByVal body As String)
        'if you want the system to send an email when it encounters and
        'Dim mailMsg As CDONTS.NewMail = New CDONTS.NewMail()
        'mailMsg.From = "david_dickinson@sbpt.com"
        'mailMsg.To = "david_dickinson@sbpt.com"
        'mailMsg.Cc = "jcoleman@agency.com"
        'mailMsg.Subject = subject
        'mailMsg.Body = body
        'mailMsg.Send()
        'mailMsg = Nothing
        traceIt(subject & " : " & body)
    End Sub

    'process all ppt files in the pptArrayList
    Private Sub ProcessArrayList()
        Dim s As String
        For Each s In pptArray
            FTargetFile = s
            Try
                pptConvertFile()
                'threadManger was an attempt to catch the timeout of powerpoint but the overhead was too
                'great and caused the application to be really slow
                'threadManager()
            Catch ex As Exception
                HandleMessage("LiteWait Error: ProcessArrayList - " & Now.ToString, ex.Message & vbCr & ex.Source & vbCr & ex.StackTrace)
            End Try
        Next
    End Sub

    Private Sub threadManager()
        Dim t As Thread = New Thread(New ThreadStart(AddressOf pptConvertFile))
        t.Priority = ThreadPriority.Normal
        t.Start()

        Dim delay As Date = DateAdd(DateInterval.Second, 120, Now())
        While Not FTargetFile = ""
            If Now() > delay Then
                t.Abort()
                t = Nothing
                traceIt("ERROR! " & Now.ToString & ": could not process " & FTargetFile)
            End If
            Thread.CurrentThread.Sleep(1000)
        End While
        t = Nothing
    End Sub

    'save the ppt file as an html file
    Private Sub pptConvertFile()
        Dim targetFile As String = FTargetFile
        Dim prsPres As PowerPoint.Presentation = ppApp.Presentations.Open(targetFile, True, False, False)
        Dim testStr As String = prsPres.Name
        Dim fileHTM As String = Microsoft.VisualBasic.Left(targetFile, targetFile.Length - 3) & "htm"
        Dim slashArray() As String = fileHTM.Split("\")
        fileHTM = HTMLdir + slashArray(slashArray.Length - 1).ToString
        prsPres.SaveCopyAs(fileHTM, PowerPoint.PpSaveAsFileType.ppSaveAsHTML, True)
        'prsPres.SaveAs(fileHTM, PowerPoint.PpSaveAsFileType.ppSaveAsHTML, True)
        prsPres.Close()
        FTargetFile = ""
        pptsConverted += 1
    End Sub


    'crawl the directory and search for ppt files
    Private Sub ProcessDirectory(ByVal targetDirectory As String)
        If Directory.Exists(targetDirectory) Then
            Dim fileEntries As String() = Directory.GetFiles(targetDirectory)
            Dim fileName As String
            For Each fileName In fileEntries
                'if it is a powerpoint file
                If Microsoft.VisualBasic.Right(fileName, 3).ToUpper = "PPT" Then
                    Dim testDate As Date = File.GetLastWriteTime(fileName)
                    'if the file has been added or changed since the last time we ran
                    If File.GetLastWriteTime(fileName) > LastRun Then
                        pptArray.Add(fileName)
                    End If
                End If
            Next

            Dim subDirectoryEntries As String() = Directory.GetDirectories(targetDirectory)
            Dim subDirectory As String
            'do the same thing for each sub directory
            For Each subDirectory In subDirectoryEntries
                ProcessDirectory(subDirectory)
            Next
        Else
            traceIt("ERROR! " & targetDirectory & " is not a valid directory")
        End If
    End Sub

    'trace and flush a message
    Private Sub traceIt(ByVal message As String)
        Trace.Write(Now.ToString & " : " & message & vbCrLf)
        Trace.Flush()
    End Sub

    'show the icon in the system tray
    Private Sub Initializenotifyicon()
        'setup the default icon
        notifyicon = New System.Windows.Forms.NotifyIcon()
        notifyicon.Icon = mSmileIcon
        notifyicon.Text = "Right Click for the menu"
        notifyicon.Visible = True

        'Insert all MenuItem objects into an array and add them to
        'the context menu simultaneously
        Dim mnuItms(3) As MenuItem
        mnuItms(0) = New MenuItem("Settings...", New EventHandler(AddressOf Me.ShowFormSelect))
        mnuItms(0).DefaultItem = True
        mnuItms(1) = New MenuItem("Run Now", New EventHandler(AddressOf Me.RunNow))
        mnuItms(2) = New MenuItem("-")
        mnuItms(3) = New MenuItem("Exit", New EventHandler(AddressOf Me.ExitSelect))
        Dim notifyiconMnu As ContextMenu = New ContextMenu(mnuItms)
        notifyicon.ContextMenu = notifyiconMnu
    End Sub

    'show the settings form
    Public Sub ShowFormSelect(ByVal sender As Object, ByVal e As System.EventArgs)
        'Display the settings dialog
        Dim SettingsForm As New SettingsForm()
        SettingsForm.ShowDialog()
    End Sub

    'run ProcessDirectory without a timer tick
    Public Sub RunNow(ByVal sender As Object, ByVal e As System.EventArgs)
        'called when the user selects the 'Run Now' context menu
        notifyicon.Icon = mFrownIcon
        notifyicon.Text = "Running"
        RunCrawl()
        notifyicon.Icon = mSmileIcon
        notifyicon.Text = "Idle"
    End Sub

    'close the application and remove from system tray
    Public Sub ExitSelect(ByVal sender As Object, ByVal e As System.EventArgs)
        'called when the user selects the 'Exit' context menu

        'hide the tray icon
        notifyicon.Visible = False

        'close up
        Me.Close()
    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

#Region " Windows Form Designer generated code "

    'Required by the Windows Form Designer
    Private WithEvents notifyicon As System.Windows.Forms.NotifyIcon

    Dim WithEvents Form1 As System.Windows.Forms.Form

    '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 Timer1 As System.Windows.Forms.Timer
    Private Sub InitializeComponent()
        Me.components = New System.ComponentModel.Container()
        Me.notifyicon = New System.Windows.Forms.NotifyIcon(Me.components)
        Me.Timer1 = New System.Windows.Forms.Timer(Me.components)
        '
        'notifyicon
        '
        Me.notifyicon.Text = ""
        Me.notifyicon.Visible = True
        '
        'Form1
        '
        Me.AccessibleRole = System.Windows.Forms.AccessibleRole.None
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.ClientSize = New System.Drawing.Size(1, 7)
        Me.ControlBox = False
        Me.Enabled = False
        Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.None
        Me.MaximizeBox = False
        Me.MinimizeBox = False
        Me.Name = "Form1"
        Me.Opacity = 0
        Me.ShowInTaskbar = False
        Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
        Me.StartPosition = System.Windows.Forms.FormStartPosition.Manual

    End Sub

#End Region

End Class