'Reads audio and picture files and creates an HTM slideshow.
'Released to Public Domain by Eric Phelps 2004

Option Explicit

Main

Sub Main()
Dim strSoundExtensions, strSoundExtension, strSoundPath, strSoundUrlPath, strSoundFile
Dim strPictureExtensions, strPictureExtension, strPicturePath, strPictureUrlPath, strPictureFile
Dim strHtmNames, strHtmFile, strHtmPath
Dim strTitle, strTemp
Dim blnZero, blnReserved, blnAcceptDefaults
Dim intCount
Dim fs, fol, fils, fil, list()
	Set fs = CreateObject("Scripting.FileSystemObject")
	
	'If we got a good argument, see if user will accept all defaults.
	blnAcceptDefaults = False
	If WScript.Arguments.Count = 1 Then
		strHtmPath = WScript.Arguments(0)
		If fs.FileExists(strHtmPath) Then
			strHtmPath = fs.GetParentFolderName(strHtmPath)
		End If
		If fs.FolderExists(strHtmPath) Then
			blnAcceptDefaults = MsgBox("Accept defaults? If you've used this script before and you know the automatic choices will work for you, choose ""Yes"". Otherwise choose ""No"" to be given the opportunity to make custom choices.", vbYesNo, "Accept Defaults") = vbYes
		End If
	End If
	
	'HTM destination
	If WScript.Arguments.Count = 1 Then
		strHtmPath = WScript.Arguments(0)
		If fs.FileExists(strHtmPath) Then
			strHtmPath = fs.GetParentFolderName(strHtmPath)
		End If
		If Not fs.FolderExists(strHtmPath) Then
			strHtmPath = fs.GetFolder(".").Path
		End If
	Else
		strHtmPath = fs.GetFolder(".").Path
	End If
	If Not blnAcceptDefaults Then
		strTemp = strHtmPath
		strHtmPath = BrowseForFolder("Create HTM files where: Cancel =" & vbCrLf & """" & strHtmPath & """")
		If strHtmPath = "" Then strHtmPath = strTemp
	End If
	'HTM names
	strHtmNames = "index.htm, navigate.htm, intro.htm, blank.htm"
	If Not blnAcceptDefaults Then
		strHtmNames = InputBox("An ""index"" (main) web page, a ""navigation"" (buttons and links) web page, an ""introductory"" (instructions) web page, and a ""blank"" (empty) web page will be created. Enter the comma-separated names for these files:", "HTM File Names", strHtmNames)
		strHtmNames = Trim(strHtmNames)
		If strHtmNames = "" Then Exit Sub
	End If
	
	'Sound source
	strSoundPath = strHtmPath
	If Not blnAcceptDefaults Then
		strSoundPath = BrowseForFolder("Existing sound files location: Cancel =" & vbCrLf & """" & strSoundPath & """")
		If strSoundPath = "" Then strSoundPath = strHtmPath
	End If
	'Sound extensions
	strSoundExtensions = ".wav, .mp3, .wma, .asf"
	If Not blnAcceptDefaults Then
		strSoundExtensions = InputBox("Sound file extensions (comma delimited string):", "Sound File Types", strSoundExtensions)
		If Trim(strSoundExtensions = "") Then Exit Sub
	End If
	'Sound URL
	strSoundUrlPath = RelativePath(strHtmPath, strSoundPath)
	If strSoundUrlPath = "" Then strSoundUrlPath = "./"
	If Not blnAcceptDefaults Then
		strSoundUrlPath = InputBox("What (if any) directory information should preceed each sound file so that it can be located from the HTM file?", "Sound URL Path", strSoundUrlPath)
	End If
	If strSoundUrlPath <> "" Then
		If Right(strSoundUrlPath, 1) <> "/" Then strSoundUrlPath = strSoundUrlPath & "/"
	End If
	
	'Picture source
	strPicturePath = strSoundPath
	If Not blnAcceptDefaults Then
		strPicturePath = BrowseForFolder("Existing picture files location: Cancel =" & vbCrLf & """" & strPicturePath & """")
		If strPicturePath = "" Then strPicturePath = strSoundPath
	End If
	'Picture extensions
	strPictureExtensions = ".htm, .html, .png, .jpg, .jpeg, .gif, .bmp"
	If Not blnAcceptDefaults Then
		strPictureExtensions = InputBox("Picture file extensions (comma delimited string):", "Picture File Types", strPictureExtensions)
		If Trim(strPictureExtensions = "") Then Exit Sub
	End If
	'Picture URL
	strPictureUrlPath = RelativePath(strHtmPath, strPicturePath)
	If strPictureUrlPath = "" Then strPictureUrlPath = "./"
	If Not blnAcceptDefaults Then
		strPictureUrlPath = InputBox("What (if any) directory information should preceed each picture file so that it can be located from the HTM file?", "Picture URL Path", strPictureUrlPath)
	End If
	If strPictureUrlPath <> "" Then
		If Right(strPictureUrlPath, 1) <> "/" Then strPictureUrlPath = strPictureUrlPath & "/"
	End If
	
	'Get the title
	If ((Len(fs.GetBaseName(strHtmPath)) > 2) And (Instr(fs.GetBaseName(strHtmPath), " ") = 0)) Then
		strTitle = Left(fs.GetBaseName(strHtmPath), 1)
		For intCount = 2 To Len(fs.GetBaseName(strHtmPath))
			If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Mid(fs.GetBaseName(strHtmPath), intCount, 1)) <> 0 Then
				strTitle = strTitle & " " & Mid(fs.GetBaseName(strHtmPath), intCount, 1)
			Else
				strTitle = strTitle & Mid(fs.GetBaseName(strHtmPath), intCount, 1)
			End If
		Next
	Else
		strTitle = fs.GetBaseName(strHtmPath)
	End If
	If Not blnAcceptDefaults Then
		strTitle = InputBox("Enter the ""title"" of this presentation", "Title", strTitle)
	End If
	
	'Confirm
	If Not blnAcceptDefaults Then
		If MsgBox("Last question! Build the HTM files for a presentation?", vbOkCancel, "Proceed?") = vbCancel Then 
			Exit Sub
		End If
	End If
	
	'Check all files in the sound directory
	Set fol = fs.GetFolder(strSoundPath)
	Set fils = fol.Files
	ReDim list(0)
	blnZero = True
	Status "Reading sound file names..."
	For Each fil In fils
		For Each strSoundExtension In Split(strSoundExtensions, ",")
			strSoundExtension = Trim(strSoundExtension)
			If Lcase(Right(fil.Name, Len(Trim(strSoundExtension))))  = Lcase(Trim(strSoundExtension)) Then
				'If the file has one of the desired extensions, add it to our list
				If Not blnZero Then ReDim Preserve list(UBound(list) + 1)
				blnZero = False
				list(UBound(list)) = fil.name
				Exit For
			End If
		Next
	Next
	'Sort the list
	Status "Sorting names..."
	SortAscending list, "*", 0
	
	'Check the sound list for first matching picture file
	For intCount = LBound(list) To UBound(list)
		strSoundFile = list(intCount)
		strPictureFile = fs.GetBaseName(strSoundFile)
		strPictureFile = fs.BuildPath(strPicturePath, strPictureFile)
		list(intCount) = "," & strSoundUrlPath & list(intCount)
		For Each strPictureExtension In Split(strPictureExtensions, ",")
			strPictureExtension = Trim(strPictureExtension)
			If fs.FileExists(strPictureFile & Trim(strPictureExtension)) Then
				blnReserved = False
				For Each strHtmFile In Split(strHtmNames)
					strHtmFile = Trim(LCase(strHtmFile))
					If strHtmFile = Lcase(fs.GetFileName(strPictureFile & Trim(strPictureExtension))) Then
						blnReserved = True
					End If
				Next
				If Not blnReserved Then
					list(intCount) = strPictureUrlPath & fs.GetFileName(strPictureFile & Trim(strPictureExtension)) & list(intCount)
					Exit For
				End If
			End If
		Next
	Next
	
	'Write the Index file
	strHtmFile = Split(strHtmNames, ",")(0)
	strHtmFile = Trim(strHtmFile)
	strHtmFile = fs.BuildPath(strHtmPath, strHtmFile)
	Status "Creating """ & strHtmFile & """"
	String2File IndexFile(strTitle, Trim(Split(strHtmNames, ",")(1)), Trim(Split(strHtmNames, ",")(2)), Trim(Split(strHtmNames, ",")(3))), strHtmFile
	
	'Write the Navigate file
	strHtmFile = Split(strHtmNames, ",")(1)
	strHtmFile = Trim(strHtmFile)
	strHtmFile = fs.BuildPath(strHtmPath, strHtmFile)
	Status "Creating """ & strHtmFile & """"
	String2File NavigateBegin(), strHtmFile
	For intCount = LBound(list) To UBound(list)
		AppendToFile strHtmFile, NavigateEntry(list(intCount))
	Next
	AppendToFile strHtmFile, vbCrLf & NavigateEnd()
	
	'Write the Intro file
	strHtmFile = Split(strHtmNames, ",")(2)
	strHtmFile = Trim(strHtmFile)
	strHtmFile = fs.BuildPath(strHtmPath, strHtmFile)
	Status "Creating """ & strHtmFile & """"
	String2File IntroFile(strTitle), strHtmFile

	'Write the Blank file
	strHtmFile = Split(strHtmNames, ",")(3)
	strHtmFile = Trim(strHtmFile)
	strHtmFile = fs.BuildPath(strHtmPath, strHtmFile)
	Status "Creating """ & strHtmFile & """"
	String2File BlankFile(), strHtmFile
	
	MsgBox "Files have been created."
End Sub
	
Sub AppendToFile(strFile, strText)
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Const ForAppending = 8
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.OpenTextFile(strFile, ForAppending, True)
	ts.Write strText
	ts.Close
End Sub

Sub SortAscending(strArray, strSplitCharacter, intSortByElement)
Dim blnChanged 'As Boolean
Dim strBuffer 'As String
Dim intCounter 'As Integer
	blnChanged = True
	Do Until Not blnChanged
		blnChanged = False
		For intCounter = Lbound(strArray) + 1 to Ubound(strArray)
			If Split(strArray(intCounter -1), strSplitCharacter)(intSortByElement) > Split(strArray(intCounter), strSplitCharacter)(intSortByElement) Then
				blnChanged = True
				strBuffer = strArray(intCounter -1)
				strArray(intCounter -1) = strArray(intCounter)
				strArray(intCounter) = strBuffer
			End If
		Next
	Loop
End Sub

Sub String2File(strData, strFileName)
'Writes a string to a file
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Dim lngChar, strBlock, intChar
Const ForWriting = 2
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.OpenTextFile(strFileName, ForWriting, True)
	Err.Clear
	On Error Resume Next
	ts.Write strData
	If Err.Number <> 0 Then
		'Must have hit one of the "problem characters" between 128 and 159
		For lngChar = 1 To Len(strData) Step 100
			Err.Clear
			ts.Write Mid(strData, lngChar, 100)
			If Err.Number <> 0 Then
				'This block of 100 must have the problem. Write them one-at-a-time
				strBlock = Mid(strData, lngChar, 100)
				For intChar = 1 To Len(strBlock)
					ts.Write Chr(255 And AscW(Mid(strBlock, intChar)))
				Next
			End If
		Next
	End If
	ts.Close
End Sub

Function FileNameLikeMine(strFileExtension) 'As String
'Returns a file name the same as the script name except
'for the file extension. 
Dim fs 'As Object
Dim strExtension 'As String
	Set fs = Wscript.CreateObject("Scripting.FileSystemObject")
	strExtension = strFileExtension
	If Len(strExtension) < 1 Then strExtension = "txt"
	If strExtension = "." Then strExtension = "txt"
	If Left(strExtension,1) = "." Then strExtension = Mid(strExtension, 2)
	FileNameLikeMine = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & strExtension
	''''''''''Clean up
	Set fs = Nothing
End Function

Sub Status (strMessage)
	If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then 
		Wscript.Echo strMessage
	End If
End Sub

Function BrowseForFolder(strPrompt)
'Uses the "Shell.Application" (only present in Win98 and newer)
'to bring up a file/folder selection window. Falls back to an
'ugly input box under Win95.
'Shell32.ShellSpecialFolderConstants
Const ssfPERSONAL = 5 'My Documents
Const ssfDRIVES = 17 'My Computer
Const SFVVO_SHOWALLOBJECTS = 1
Const SFVVO_SHOWEXTENSIONS = 2 
	Dim sh, fol, fs, lngView, strPath
	Set sh = CreateObject("Shell.Application")
	If Instr(TypeName(sh), "Shell") = 0 Then
		BrowseForFolder = InputBox(strPrompt, "Select Folder", CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName))
		Exit Function
	End If
	Set fs = CreateObject("Scripting.FileSystemObject")
	lngView = SFVVO_SHOWALLOBJECTS Or SFVVO_SHOWEXTENSIONS
	strPath = ""
	Set fol = sh.BrowseForFolder(&0, strPrompt, lngView, ssfDRIVES)
	Err.Clear
	On Error Resume Next
	strPath = fol.ParentFolder.ParseName(fol.Title).Path
	'An error occurs if the user selects a drive instead of a folder
	If Err.Number <> 0 Then
		BrowseForFolder = Left(Right(fol.Title, 3), 2) & "\"
	Else
		BrowseForFolder = strPath
	End If
End Function

Function RelativePath(strFrom, strTo)
'Returns a string containing a URL-relative path
'between the two folders or files. For example, if 
'strFrom was "C:\a\b\c\d\e" and strTo was "C:\a\b\x\y",
'then the result would be "../../../x/y/"
Dim intEnd, intCount, strRelativePath, strFromPath, strToPath
Dim fs
	Set fs = CreateObject("Scripting.FileSystemObject")
	'Preserve input variables
	strFromPath = strFrom
	strToPath = strTo
	'Append a slash to folders (assuming we are doing local stuff)
	If Right(strFromPath, 1) <> "\" Then
		If fs.FolderExists(strFromPath) Then strFromPath = strFromPath & "\"
	End If
	If Right(strToPath, 1) <> "\" Then
		If fs.FolderExists(strToPath) Then strToPath = strToPath & "\"
	End If
	'To see how much the paths have in common, we see which is shortest
	If Len(strFromPath) > Len(strToPath) Then
		intEnd = Len(strToPath)
	Else
		intEnd = Len(strFromPath)
	End If
	'Find the common path
	For intCount = 1 To intEnd
		If Mid(strFromPath, intCount, 1) <> Mid(strToPath, intCount, 1) Then Exit For
	Next
	If intCount = 1 Then
		'The first character is different: They are on different drives? Give up!
		RelativePath = ""
		Exit Function
	End If
	'Replace the slashes
	strFromPath = Replace(strFromPath, "\", "/")
	strToPath = Replace(strToPath, "\", "/")
	'Back up the common counter to the nearest slash
	intCount = InStrRev(Left(strToPath, intCount), "/") + 1
	'Trim the paths
	strFromPath = Mid(strFromPath, intCount)
	strToPath = Mid(strToPath, intCount)
	'Start with the strToPath as the base for the relative path
	strRelativePath = Replace(strToPath, " ", "%20")
	'Walk up a level for every directory in strFromPath
	For intCount = 1 To Len(strFromPath)
		If Mid(strFromPath, intCount, 1) = "/" Then strRelativePath = "../" & strRelativePath
	Next
	RelativePath = strRelativePath
End Function

Function BlankFile()
Dim strBuffer
	strBuffer = "<html><head><title></title><body></body></html>"
	BlankFile = strBuffer
End Function

Function IndexFile(strTitle, strNavigateFile, strIntroFile, strBlankFile)
Dim strBuffer
	strBuffer = ""
	strBuffer = strBuffer & vbCrLf & "<html>"
	strBuffer = strBuffer & vbCrLf & "<head>"
	strBuffer = strBuffer & vbCrLf & "<title>" & strTitle & "</title>"
	strBuffer = strBuffer & vbCrLf & "<script>if (top.location!=self.location) {top.location.href=self.location}</script>"
	strBuffer = strBuffer & vbCrLf & "</head>"
	strBuffer = strBuffer & vbCrLf & "<frameset cols=""175,*"">"
	strBuffer = strBuffer & vbCrLf & "    <frameset rows=""*,100"">"
	strBuffer = strBuffer & vbCrLf & "        <frame name=""frmNavigate"" src=""" & strNavigateFile & """>"
	strBuffer = strBuffer & vbCrLf & "        <frame name=""frmSound"" src=""" & strBlankFile & """ scrolling=""no"">"
	strBuffer = strBuffer & vbCrLf & "    </frameset>"
	strBuffer = strBuffer & vbCrLf & "    <frame name=""frmPicture"" src=""" & strIntroFile & """>"
	strBuffer = strBuffer & vbCrLf & "</frameset>"
	strBuffer = strBuffer & vbCrLf & "</html>"
	IndexFile = strBuffer
End Function

Function IntroFile(strTitle)
Dim strBuffer
	strBuffer = "<html>"
	strBuffer = strBuffer & vbCrLf & "<head>"
	strBuffer = strBuffer & vbCrLf & "<title>" & strTitle & "</title>"
	strBuffer = strBuffer & vbCrLf & "<body>"
	strBuffer = strBuffer & vbCrLf & "<center><h1>" & strTitle & "</h1></center>"
	strBuffer = strBuffer & vbCrLf & "<p>Press the ""Start"" button to begin the presentation. "
	strBuffer = strBuffer & vbCrLf & "If you are using Internet Explorer, the presentation will "
	strBuffer = strBuffer & vbCrLf & "advance automatically. For all other browsers (or if you disable "
	strBuffer = strBuffer & vbCrLf & "the IE automatic advance), use the "">"" and ""<"" buttons "
	strBuffer = strBuffer & vbCrLf & "to control the presentation.</p>"
	strBuffer = strBuffer & vbCrLf & "<p>You may jump directly to a desired slide in the presentation by "
	strBuffer = strBuffer & vbCrLf & "clicking one of the numbered slide links."
	strBuffer = strBuffer & vbCrLf & "</body>"
	strBuffer = strBuffer & vbCrLf & "</html>"
	IntroFile = strBuffer
End Function

Function NavigateBegin()
Dim strBuffer
	strBuffer = ""
	strBuffer = strBuffer & "<html>"
	strBuffer = strBuffer & vbCrLf & "<head>"
	strBuffer = strBuffer & vbCrLf & "<script>"
	strBuffer = strBuffer & vbCrLf & "var slideArray = new Array();"
	strBuffer = strBuffer & vbCrLf & "var slideParameters = new Array();"
	strBuffer = strBuffer & vbCrLf & "var slideIndex = 1;"
	strBuffer = strBuffer & vbCrLf & "var hndAdvance;"
	strBuffer = strBuffer & vbCrLf & "var blnAdvance = true;"
	NavigateBegin = strBuffer
End Function

Function NavigateEntry(strPictureSoundEntry)
	NavigateEntry = vbCrLf & "slideArray[slideIndex++] = """ & strPictureSoundEntry & """;"
End Function

Function NavigateEnd()
Dim strBuffer
	strBuffer = ""	
	strBuffer = strBuffer & vbCrLf & ""
	strBuffer = strBuffer & vbCrLf & "function PlaySlide(slideNumber){"
	strBuffer = strBuffer & vbCrLf & "	slideIndex = slideNumber"
	strBuffer = strBuffer & vbCrLf & "	blnAdvance = true;"
	strBuffer = strBuffer & vbCrLf & "	if (slideIndex < 1 ){"
	strBuffer = strBuffer & vbCrLf & "		slideIndex = 1;"
	strBuffer = strBuffer & vbCrLf & "		blnAdvance = false;"
	strBuffer = strBuffer & vbCrLf & "	}"
	strBuffer = strBuffer & vbCrLf & "	if (slideIndex >= slideArray.length){"
	strBuffer = strBuffer & vbCrLf & "		slideIndex = slideArray.length - 1;"
	strBuffer = strBuffer & vbCrLf & "		blnAdvance = false;"
	strBuffer = strBuffer & vbCrLf & "	}"
	strBuffer = strBuffer & vbCrLf & "	if (blnAdvance == true) {"
	strBuffer = strBuffer & vbCrLf & "		// Pull picture and sound parameters out of the slide array for this slide"
	strBuffer = strBuffer & vbCrLf & "		slideParameters = slideArray[slideIndex].split("","");"
	strBuffer = strBuffer & vbCrLf & "		// Put a picture in the picture frame only if a picture exists and isn't blank"
	strBuffer = strBuffer & vbCrLf & "		if (slideParameters[0] && slideParameters[0] != """"){"
	strBuffer = strBuffer & vbCrLf & "		parent.frmPicture.document.location.href=slideParameters[0];"
	strBuffer = strBuffer & vbCrLf & "		}"
	strBuffer = strBuffer & vbCrLf & "		// Set the new sound only if a sound exists and isn't blank"
	strBuffer = strBuffer & vbCrLf & "		if (slideParameters[1] && slideParameters[1] != """"){"
	strBuffer = strBuffer & vbCrLf & "			if ((navigator.userAgent.indexOf(""IE"") > -1) && (navigator.platform == ""Win32"")) {"
	strBuffer = strBuffer & vbCrLf & "				document.MediaPlayer.Open(slideParameters[1]);"
	strBuffer = strBuffer & vbCrLf & "				parent.frmSound.document.open();"
	strBuffer = strBuffer & vbCrLf & "				parent.frmSound.document.write('<html><body><center><font size=""-1"">Page ');"
	strBuffer = strBuffer & vbCrLf & "				parent.frmSound.document.write(slideIndex + ' of ' + (slideArray.length - 1));"
	strBuffer = strBuffer & vbCrLf & "				parent.frmSound.document.write(' </font></center></body></html>');"
	strBuffer = strBuffer & vbCrLf & "				parent.frmSound.document.close();"
	strBuffer = strBuffer & vbCrLf & "	 		}"
	strBuffer = strBuffer & vbCrLf & "	 		else {"
	strBuffer = strBuffer & vbCrLf & "	 			parent.frmSound.document.open();"
	strBuffer = strBuffer & vbCrLf & "				parent.frmSound.document.write('<html><body><font size=""-1"">Page ');"
	strBuffer = strBuffer & vbCrLf & "				parent.frmSound.document.write(slideIndex + ' of ' + (slideArray.length - 1));"
	strBuffer = strBuffer & vbCrLf & "				parent.frmSound.document.write('<\/font><br>');"
	strBuffer = strBuffer & vbCrLf & "				parent.frmSound.document.write('<embed');"
	strBuffer = strBuffer & vbCrLf & "				if (navigator.platform.indexOf(""Win32"") > -1) {"
	strBuffer = strBuffer & vbCrLf & "					parent.frmSound.document.open();"
	strBuffer = strBuffer & vbCrLf & "					parent.frmSound.document.write(' type=""application/x-mplayer2""');"
	strBuffer = strBuffer & vbCrLf & "					parent.frmSound.document.write(' src=""' + slideParameters[1] + '""');"
	strBuffer = strBuffer & vbCrLf & "					parent.frmSound.document.write(' pluginspage=""http://www.microsoft.com/windows/windowsmedia/en/download/default.asp""');"
	strBuffer = strBuffer & vbCrLf & "					parent.frmSound.document.write(' autostart=""true"" width=""144"" height=""45""');"
	strBuffer = strBuffer & vbCrLf & "				}"
	strBuffer = strBuffer & vbCrLf & "				else {"
	strBuffer = strBuffer & vbCrLf & "					parent.frmSound.document.open();"
	strBuffer = strBuffer & vbCrLf & "					parent.frmSound.document.write(' type=""audio/wav""');"
	strBuffer = strBuffer & vbCrLf & "					parent.frmSound.document.write(' src=""' + slideParameters[1] + '""');"
	strBuffer = strBuffer & vbCrLf & "					parent.frmSound.document.write(' autostart=""true"" width=""144"" height=""45""');"
	strBuffer = strBuffer & vbCrLf & "				}"
	strBuffer = strBuffer & vbCrLf & "				parent.frmSound.document.write('></embed>');"
	strBuffer = strBuffer & vbCrLf & "				parent.frmSound.document.write('</body></html>');"
	strBuffer = strBuffer & vbCrLf & "				parent.frmSound.document.close();"
	strBuffer = strBuffer & vbCrLf & "			}"
	strBuffer = strBuffer & vbCrLf & "		}"
	strBuffer = strBuffer & vbCrLf & "	}"
	strBuffer = strBuffer & vbCrLf & "}"
	strBuffer = strBuffer & vbCrLf & "</script>"
	strBuffer = strBuffer & vbCrLf & "<script LANGUAGE=""JavaScript"" FOR=""MediaPlayer"" EVENT=""PlayStateChange(OldPlayState, NewPlayState)"">"
	strBuffer = strBuffer & vbCrLf & "	if(OldPlayState == 2 && NewPlayState == 0 && blnAdvance){"
	strBuffer = strBuffer & vbCrLf & "		if (document.forms[0].autoAdvance.checked == true) {"
	strBuffer = strBuffer & vbCrLf & "			hndAdvance = window.setTimeout(""PlaySlide(++slideIndex)"", 50);"
	strBuffer = strBuffer & vbCrLf & "		}"
	strBuffer = strBuffer & vbCrLf & "	}"
	strBuffer = strBuffer & vbCrLf & "</script>"
	strBuffer = strBuffer & vbCrLf & ""
	strBuffer = strBuffer & vbCrLf & "</head>"
	strBuffer = strBuffer & vbCrLf & "<body>"
	strBuffer = strBuffer & vbCrLf & "<center>"
	strBuffer = strBuffer & vbCrLf & "<form>"
	strBuffer = strBuffer & vbCrLf & "	<input type=""button"" value=""Start!"" onClick=""PlaySlide(1);"">"
	strBuffer = strBuffer & vbCrLf & "	<p>"
	strBuffer = strBuffer & vbCrLf & "	<input type=""button"" value="" &lt;"" onClick=""blnAdvance = false;PlaySlide(--slideIndex);"">"
	strBuffer = strBuffer & vbCrLf & "	<!--[if gte IE 5]>"
	strBuffer = strBuffer & vbCrLf & "	<input type=""button"" value="" || "" onClick=""blnAdvance = false;"">"
	strBuffer = strBuffer & vbCrLf & "	<![endif]-->"
	strBuffer = strBuffer & vbCrLf & "	<input type=""button"" value=""&gt; "" onClick=""blnAdvance = false;PlaySlide(++slideIndex);"">"
	strBuffer = strBuffer & vbCrLf & "	<p>"
	strBuffer = strBuffer & vbCrLf & ""
	strBuffer = strBuffer & vbCrLf & "	<!--[if gte IE 5]>"
	strBuffer = strBuffer & vbCrLf & "	<p><input type=""checkbox"" name=""autoAdvance"" checked> Auto-advance"
	strBuffer = strBuffer & vbCrLf & "	<![endif]-->"
	strBuffer = strBuffer & vbCrLf & ""
	strBuffer = strBuffer & vbCrLf & "	<!-- OPTIONAL TEXT LINKS (if you don't like the buttons)"
	strBuffer = strBuffer & vbCrLf & "	<input type=""text"" size=""2"" name=""gotoSlide"">"
	strBuffer = strBuffer & vbCrLf & "	<input type=""button"" value=""Go to page"" onclick=""blnAdvance = false;PlaySlide(document.forms[0].gotoSlide.value);"">"
	strBuffer = strBuffer & vbCrLf & "	<p>"
	strBuffer = strBuffer & vbCrLf & "	<a href=""javascript:blnAdvance = false;PlaySlide(--slideIndex);"">Back</a>"
	strBuffer = strBuffer & vbCrLf & "	<a href=""javascript:blnAdvance = false;PlaySlide(slideIndex);"">Again</a>"
	strBuffer = strBuffer & vbCrLf & "	<a href=""javascript:blnAdvance = false;PlaySlide(++slideIndex);"">Next</a>"
	strBuffer = strBuffer & vbCrLf & "	-->"
	strBuffer = strBuffer & vbCrLf & ""
	strBuffer = strBuffer & vbCrLf & "</form>"
	strBuffer = strBuffer & vbCrLf & ""
	strBuffer = strBuffer & vbCrLf & "<noscript>"
	strBuffer = strBuffer & vbCrLf & "<p>This presentation relies on JavaScript, which you have disabled! Please enable JavaScript and reload this page."
	strBuffer = strBuffer & vbCrLf & "</noscript>"
	strBuffer = strBuffer & vbCrLf & ""
	strBuffer = strBuffer & vbCrLf & "<script>"
	strBuffer = strBuffer & vbCrLf & "// Add individual page links to the navigation frame"
	strBuffer = strBuffer & vbCrLf & "var slideNumber;"
	strBuffer = strBuffer & vbCrLf & "document.write('<p>\n');"
	strBuffer = strBuffer & vbCrLf & "for (slideNumber = 1; slideNumber < slideArray.length; slideNumber++){"
	strBuffer = strBuffer & vbCrLf & "	document.write(' <a href=""javascript:blnAdvance = false;PlaySlide(' + slideNumber + ');"">' + slideNumber + '</a>&nbsp;\n');"
	strBuffer = strBuffer & vbCrLf & "}"
	strBuffer = strBuffer & vbCrLf & "document.write('<p>\n');"
	strBuffer = strBuffer & vbCrLf & "</script>"
	strBuffer = strBuffer & vbCrLf & "<!--[if gte IE 5]>"
	strBuffer = strBuffer & vbCrLf & "<OBJECT ID=""MediaPlayer"" width=""70"" height=""45"""
	strBuffer = strBuffer & vbCrLf & "	classid=""CLSID:22D6F312-B0F6-11D0-94AB-0080C74C7E95"""
	strBuffer = strBuffer & vbCrLf & "	CODEBASE=""http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=6,4,5,715"""
	strBuffer = strBuffer & vbCrLf & "	standby=""Loading Microsoft® Windows® Media Player components..."""
	strBuffer = strBuffer & vbCrLf & "	type=""application/x-oleobject"">"
	strBuffer = strBuffer & vbCrLf & "	<PARAM NAME=""ShowStatusBar"" VALUE=""False"">"
	strBuffer = strBuffer & vbCrLf & "	<PARAM NAME=""ShowControls"" VALUE=""True"">"
	strBuffer = strBuffer & vbCrLf & "	<PARAM NAME=""AnimationatStart"" VALUE=""False"">"
	strBuffer = strBuffer & vbCrLf & "</OBJECT>"
	strBuffer = strBuffer & vbCrLf & "<![endif]-->"
	strBuffer = strBuffer & vbCrLf & "</center>"
	strBuffer = strBuffer & vbCrLf & "</body>"
	strBuffer = strBuffer & vbCrLf & "</html>"
	NavigateEnd = strBuffer
End Function