'Reads image, audio, and text files and creates an HTM slideshow.
'Released to Public Domain by Eric Phelps 2005
'http://www.ericphelps.com 

Option Explicit

Main

Sub Main()
Dim strTextExtension, strTextPath, strTextFile
Dim strPictureExtensions, strPictureExtension
Dim strPicturePath, strBigPicturePath, strBigPictureFile, strBigPictureUrl
Dim strPictureUrlPath, strBigPictureUrlPath, strPictureUrl, strPictureFile
Dim strSoundExtensions, strSoundExtension, strSoundPath, strSoundUrlPath, strSoundUrl, strSoundFile
Dim strHtmSuffix, strHtmPath, strHtmFile, strHtmName
Dim strTitle, strContent, strBaseName
Dim strFirst, strLast, strHome, strPrevious, strNext
Dim strDefault, strPrompt
Dim blnZero, 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 extension
	strDefault = ".htm"
	If blnAcceptDefaults Then
		strHtmSuffix = strDefault
	Else
		strPrompt = "HTM web pages will be created for each slide. Enter the HTM web page suffix here:"
		strHtmSuffix = InputBox(strPrompt, "HTM Page Suffix", strDefault)
		strHtmSuffix = Trim(strHtmSuffix)
		If strHtmSuffix = "" Then strHtmSuffix = strDefault
	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
	strDefault = strHtmPath
	If blnAcceptDefaults Then
		strHtmPath = strDefault
	Else
		strPrompt = "Create content HTM web pages where: Cancel =" & vbCrLf & """" & strDefault & """"
		strHtmPath = BrowseForFolder(strPrompt)
		If strHtmPath = "" Then strHtmPath = strDefault
	End If
	
	'Text source
	strDefault = strHtmPath
	If blnAcceptDefaults Then
		strTextPath = strDefault
	Else
		strPrompt = "Existing text files (if any) location: Cancel =" & vbCrLf & """" & strDefault & """"
		strTextPath = BrowseForFolder(strPrompt)
		If strTextPath = "" Then strTextPath = strDefault
	End If
	'Text extensions
	strDefault = ".txt"
	If blnAcceptDefaults Then
		strTextExtension = strDefault
	Else
		strPrompt = "Existing text file extension:"
		strTextExtension = InputBox(strPrompt, "Text File Extension", strDefault)
		If Trim(strTextExtension) = "" Then strTextExtension = strDefault
	End If
	
	'Picture extensions
	strDefault = ".png, .jpg, .jpeg, .gif, .bmp"
	If blnAcceptDefaults Then
		strPictureExtensions = strDefault
	Else
		strPrompt = "Existing picture file extensions (comma delimited string):"
		strPictureExtensions = InputBox(strPrompt, "Picture File Types", strDefault)
		If Trim(strPictureExtensions = "") Then strPictureExtensions = strDefault
	End If
	'Picture source
	strDefault = strTextPath
	If blnAcceptDefaults Then
		strPicturePath = strDefault
	Else
		strPrompt = "Existing WEB-SIZE picture files (if any) location: Cancel =" & vbCrLf & """" & strDefault & """"
		strPicturePath = BrowseForFolder(strPrompt)
		If strPicturePath = "" Then strPicturePath = strDefault
	End If	
	'Picture URL
	strDefault = RelativePath(strHtmPath, strPicturePath)
	If strDefault = "" Then strDefault = "./"
	If blnAcceptDefaults Then
		strPictureUrlPath = strDefault
	Else
		strPrompt = "What (if any) directory information should preceed each WEB picture file so that it can be located from the HTM file?"
		strPictureUrlPath = InputBox(strPrompt, "Picture URL Path", strDefault)
	End If
	If strPictureUrlPath <> "" Then
		If Right(strPictureUrlPath, 1) <> "/" Then strPictureUrlPath = strPictureUrlPath & "/"
	End If
	
	'Big picture source
	strDefault = strPicturePath 'Left(strTextPath, InStrRev(strTextPath, "\") - 1)
	If blnAcceptDefaults Then
		strBigPicturePath = strDefault
	Else
		strPrompt = "Existing FULL-SIZE picture files (if any) location: Cancel =" & vbCrLf & """" & strDefault & """"
		strBigPicturePath = BrowseForFolder(strPrompt)
		If strBigPicturePath = "" Then strBigPicturePath = strDefault
	End If
	'Big Picture URL
	strDefault = RelativePath(strHtmPath, strBigPicturePath)
	If strDefault = "" Then strDefault = "./"
	If blnAcceptDefaults Then
		strBigPictureUrlPath = strDefault
	Else
		strPrompt = "What (if any) directory information should preceed each FULL SIZE picture file so that it can be located from the HTM file?"
		strBigPictureUrlPath = InputBox(strPrompt, "Picture URL Path", strDefault)
	End If
	If strBigPictureUrlPath <> "" Then
		If Right(strBigPictureUrlPath, 1) <> "/" Then strBigPictureUrlPath = strBigPictureUrlPath & "/"
	End If

	
	'Sound source
	strDefault = strTextPath
	If blnAcceptDefaults Then
		strSoundPath = strDefault
	Else
		strPrompt = "Existing sound files (if any) location: Cancel =" & vbCrLf & """" & strDefault & """"
		strSoundPath = BrowseForFolder(strPrompt)
		If strSoundPath = "" Then strSoundPath = strDefault
	End If
	'Sound extensions
	strDefault = ".wma, .asf, .wav, .mp3, .mid, .au"
	If blnAcceptDefaults Then
		strSoundExtensions = strDefault
	Else
		strPrompt = "Existing sound file extensions (comma delimited string):"
		strSoundExtensions = InputBox(strPrompt, "Sound File Types", strDefault)
		If Trim(strSoundExtensions = "") Then strSoundExtensions = strDefault
	End If
	'Sound URL
	strDefault = RelativePath(strHtmPath, strSoundPath)
	If strDefault = "" Then strDefault = "./"
	If blnAcceptDefaults Then
		strSoundUrlPath = strDefault
	Else
		strPrompt = "What (if any) directory information should preceed each sound file so that it can be located from the HTM file?"
		strSoundUrlPath = InputBox(strPrompt, "Sound URL Path", strDefault)
	End If
	If strSoundUrlPath <> "" Then
		If Right(strSoundUrlPath, 1) <> "/" Then strSoundUrlPath = strSoundUrlPath & "/"
	End If

	'Get the title
	If ((Len(fs.GetBaseName(strHtmPath)) > 2) And (Instr(fs.GetBaseName(strHtmPath), " ") = 0)) Then
		strDefault = Left(fs.GetBaseName(strHtmPath), 1)
		For intCount = 2 To Len(fs.GetBaseName(strHtmPath))
			If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Mid(fs.GetBaseName(strHtmPath), intCount, 1)) <> 0 Then
				strDefault = strDefault & " " & Mid(fs.GetBaseName(strHtmPath), intCount, 1)
			Else
				strDefault = strDefault & Mid(fs.GetBaseName(strHtmPath), intCount, 1)
			End If
		Next
	Else
		strDefault = fs.GetBaseName(strHtmPath)
	End If
	If blnAcceptDefaults Then
		strTitle = strDefault
	Else
		strPrompt = "Enter the ""title"" of this presentation"
		strTitle = InputBox(strPrompt, "Title", strDefault)
		If Trim(strTitle) = "" Then strTitle = strDefault
	End If

	'Create a "master" list of the defining file: picture, text, or audio (in that order)
	'Check all files in the picture directory
	Set fol = fs.GetFolder(strPicturePath)
	Set fils = fol.Files
	ReDim list(0)
	blnZero = True
	Status "Reading picture file names..."
	For Each fil In fils
		For Each strPictureExtension In Split(strPictureExtensions, ",")
			strPictureExtension = Trim(strPictureExtension)
			If Left(strPictureExtension, 1) <> "." Then strPictureExtension = "." & strPictureExtension
			If Lcase(Right(fil.Name, Len(Trim(strPictureExtension))))  = Lcase(Trim(strPictureExtension)) Then
				'It's a picture. Add it to our list
				Status vbTab & fil.Name
				If Not blnZero Then ReDim Preserve list(UBound(list) + 1)
				blnZero = False
				list(UBound(list)) = fil.name
				Exit For
			End If
		Next
	Next
	'Check text directory
	Set fol = fs.GetFolder(strTextPath)
	Set fils = fol.Files
	If Left(strTextExtension, 1) <> "." Then strTextExtension = "." & strTextExtension
	Status "Reading text file names..."
	For Each fil In fils
		If Lcase(Right(fil.Name, Len(Trim(strTextExtension)))) = Lcase(Trim(strTextExtension)) Then
			'It's text.
			Status vbTab & fil.Name
			If Not BaseNameInArray(list, fil.Name) Then
				'There's no picture by that name; add the text file to the list
				If Not blnZero Then ReDim Preserve list(UBound(list) + 1)
				blnZero = False
				list(UBound(list)) = fil.name
			End If
		End If
	Next
	'Check sound directory
	Set fol = fs.GetFolder(strSoundPath)
	Set fils = fol.Files
	Status "Reading sound file names..."
	For Each fil In fils
		For Each strSoundExtension In Split(strSoundExtensions, ",")
			strSoundExtension = Trim(strSoundExtension)
			If Left(strSoundExtension, 1) <> "." Then strSoundExtension = "." & strSoundExtension
			If Lcase(Right(fil.Name, Len(Trim(strSoundExtension)))) = Lcase(Trim(strSoundExtension)) Then
				'It's sound.
				Status vbTab & fil.Name
				If Not BaseNameInArray(list, fil.Name) Then
					'There's no picture or text by that name; add the sound file to the list
					If Not blnZero Then ReDim Preserve list(UBound(list) + 1)
					blnZero = False
					list(UBound(list)) = fil.name
					Exit For
				End If
			End If
		Next
	Next
	'Sort the list
	Status "Sorting names..."
	SortAscending list, "*", 0
	
	'Get the wrap and home choices
	If blnAcceptDefaults Then
		strHome = "../"
		strFirst = strHome
		strLast = strHome
	Else
		Status "Getting HOME preference..."
		strPrompt = "During the presentation, if the user presses the ""Home"" button, what should happen?"
		strPrompt = strPrompt & vbCrLf & "1 - Go up one folder"
		strPrompt = strPrompt & vbCrLf & "2 - Go to the first slide"
		strPrompt = strPrompt & vbCrLf & "(Enter a number or a URL)"
		strDefault = "1"
		strHome = InputBox(strPrompt, "Home", strDefault)
		strHome = Trim(strHome)
		If strHome = "" Then strHome = strDefault
		Select Case Left(strHome, 1)
			Case "1"
				strHome = "../"
			Case "2"
				strHome = fs.GetBaseName(list(LBound(list))) & strHtmSuffix
			Case Else
				'Do Nothing. Accept whatever the end-user entered.
		End Select
		Status "Getting FIRST preference..."
		strDefault = "1"
		strPrompt = "If the user is on the FIRST slide and presses the ""Back"" button, what should happen?"
		strPrompt = strPrompt & vbCrLf & "1 - Same thing as pressing ""Home"""
		strPrompt = strPrompt & vbCrLf & "2 - Stay at the first slide"
		strPrompt = strPrompt & vbCrLf & "3 - Wrap to the last slide"
		strFirst = InputBox(strPrompt, "Back", strDefault)
		strFirst = Trim(strFirst)
		If strFirst = "" Then strFirst = strDefault
		Select Case Left(strFirst, 1)
			Case "1"
				strFirst = strHome
			Case "2"
				strFirst = fs.GetBaseName(list(LBound(list))) & strHtmSuffix
			Case "3"
				strFirst = fs.GetBaseName(list(UBound(list))) & strHtmSuffix
			Case Else
				strFirst = strHome
		End Select
		Status "Getting LAST preference..."
		strDefault = "1"
		strPrompt = "If the user is on the LAST slide and presses the ""Next"" button, what should happen?"
		strPrompt = strPrompt & vbCrLf & "1 - Same thing as pressing ""Home"""
		strPrompt = strPrompt & vbCrLf & "2 - Stay at the last slide"
		strPrompt = strPrompt & vbCrLf & "3 - Wrap to the first slide"
		strLast = InputBox(strPrompt, "Next", strDefault)
		strLast = Trim(strLast)
		If strLast = "" Then strLast = strDefault
		Select Case Left(strLast, 1)
			Case "1"
				strLast = strHome
			Case "2"
				strLast = fs.GetBaseName(list(UBound(list))) & strHtmSuffix
			Case "3"
				strLast = fs.GetBaseName(list(LBound(list))) & strHtmSuffix
			Case Else
				strLast = strHome
		End Select
	End If
	
	'Confirm
	If Not blnAcceptDefaults Then
		Status "Confirming permission to create files..."
		If MsgBox("Last question! Build the HTM files for a presentation?", vbOkCancel, "Proceed?") = vbCancel Then 
			Exit Sub
		End If
	End If
	Status "Creating files..."
	
	'Create the content
	For intCount = LBound(list) To UBound(list)
		strBaseName = fs.GetBaseName(list(intCount))
		'Get the file name of the text file
		strTextFile = FileNameIfExists(strBaseName, strTextExtension, strTextPath)
		If strTextFile <> "" Then
			strTextFile = fs.BuildPath(strTextPath, strTextFile)
		End If
		'Get the URL for the picture
		strPictureFile = FileNameIfExists(strBaseName, strPictureExtensions, strPicturePath)
		If strPictureFile = "" Then
			strPictureUrl = ""
		Else
			strPictureUrl = strPictureUrlPath & strPictureFile
		End If
		'Get the URL for the BIG picture
		strBigPictureFile = FileNameIfExists(strBaseName, strPictureExtensions, strBigPicturePath)
		If strBigPictureFile = "" Then
			strBigPictureUrl = ""
		Else
			strBigPictureUrl = strBigPictureUrlPath & strPictureFile
		End If
		'Get the URL for the sound
		strSoundFile = FileNameIfExists(strBaseName, strSoundExtensions, strSoundPath)
		If strSoundFile = "" Then
			strSoundUrl = ""
		Else
			strSoundUrl = strSoundUrlPath & strSoundFile
		End If
		'Get the name of the HTM file we'll be constructing
		strHtmName = fs.BuildPath(strHtmPath, strBaseName & strHtmSuffix)
		'Get the Previous URL for navigation purposes
		If intCount = LBound(list) Then
			strPrevious = strFirst
		Else
			strPrevious = fs.GetBaseName(list(intCount - 1)) & strHtmSuffix
		End If
		'Get the Next URL for navigation purposes
		If intCount = UBound(list) Then
			strNext = strLast
		Else
			strNext = fs.GetBaseName(list(intCount + 1)) & strHtmSuffix
		End If
		strContent = "<html>"
		strContent = strContent & vbCrLf & "<head><title>" & strTitle & "</title></head>"
		strContent = strContent & vbCrLf & "<body>"
		strContent = strContent & vbCrLf & "<table border='0' width='100%'>"
		strContent = strContent & vbCrLf & "<tr>"
		strContent = strContent & vbCrLf & "<td valign='top' align='left'>" & NavCode(strPrevious, strHome, strNext) & "</td>"
		strContent = strContent & vbCrLf & "<td valign='top' align='right'>" & PlayerCode(strSoundUrl) & "</td>"
		strContent = strContent & vbCrLf & "</tr>"
		strContent = strContent & vbCrLf & "</table>"
		strContent = strContent & vbCrLf & ContentCode(strTextFile, strPictureUrl, strBigPictureUrl)
		strContent = strContent & vbCrLf & "</body>"
		strContent = strContent & vbCrLf & "</html>"
		String2File strContent, strHtmName
	Next
	MsgBox "Files have been created. Your first page should be """ & fs.GetBaseName(list(LBound(list))) & strHtmSuffix & """."
End Sub

Function MatchesExtension(strFileName, strExtensions)
Dim strExtension, blnMatchesExtension
	blnMatchesExtension = False
	For Each strExtension In Split(strExtensions, ",")
		If Left(strExtension, 1) <> "." Then strExtension = "." & strExtension
		If Lcase(Right(strFileName, Len(Trim(strExtension)))) = Lcase(Trim(strExtension)) Then
			blnMatchesExtension = True
			Exit For
		End If
	Next
	MatchesExtension = blnMatchesExtension
End Function

Function FileNameIfExists(strBaseName, strExtensions, strPath)
Dim fs, fol, fils, fil, strExtension, intCount
	Set fs = CreateObject("Scripting.FileSystemObject")
	For Each strExtension In Split(strExtensions, ",")
		strExtension = Trim(strExtension)
		If Left(strExtension, 1) <> "." Then strExtension = "." & strExtension
		If fs.FileExists(fs.BuildPath(strPath, strBaseName & strExtension)) Then
			FileNameIfExists = fs.GetFile(fs.BuildPath(strPath, strBaseName & strExtension)).Name
			Exit Function
		End If
	Next
	FileNameIfExists = ""
End Function

Function BaseNameInArray(varArray, strFileName)
Dim fs, strElement, strBase, blnInArray
	Set fs = CreateObject("Scripting.FileSystemObject")
	blnInArray = False
	strBase = Lcase(fs.GetBaseName(strFileName))
	For Each strElement In varArray
		If Lcase(fs.GetBaseName(strElement)) = strBase Then
			blnInArray = True
			Exit For
		End If
	Next
	BaseNameInArray = blnInArray
End Function
	
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 File2String(strFile) 'As String
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Const ForReading = 1
	Set fs = CreateObject("Scripting.FileSystemObject")
	If fs.FileExists(strFile) Then
		Set ts = fs.OpenTextFile(strFile, ForReading, True)
		If ts.AtEndOfStream Then
			File2String =""
		Else
			File2String = ts.ReadAll
		End If
		ts.Close
	Else
		File2String = ""
	End If
End Function

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 = 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
End Function

Function Text2Html(strRawData) 'As String
'Makes raw text safe to display on a web page
Dim strText2Html 'As String
	strText2Html = strRawData
	strText2Html = Replace(strText2Html, "<", "&lt;")
	strText2Html = Replace(strText2Html, ">", "&gt;")
	strText2Html = Replace(strText2Html, "&", "&amp;")
	strText2Html = Replace(strText2Html, vbCrLf & vbCrLf, vbCrLf & "<p>" & vbCrLf)
	strText2Html = Replace(strText2Html, vbCr & vbCr, vbCrLf & "<p>" & vbCrLf)
	strText2Html = Replace(strText2Html, vbLf & vbLf, vbCrLf & "<p>" & vbCrLf)
	strText2Html = Replace(strText2Html, vbTab, "&nbsp;&nbsp;&nbsp;&nbsp;")
	strText2Html = Replace(strText2Html, "  ", "&nbsp;&nbsp;")
	Text2Html = strText2Html
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 PlayerCode(strAudioUrl)
Dim strBuffer
	If strAudioUrl = "" Then
		strBuffer = "&nbsp;"
	Else
		strBuffer = ""
		strBuffer = strBuffer & vbCrLf & "<OBJECT ID=""MediaPlayer"" width=""144"" 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=""FileName"" VALUE=""" & strAudioUrl & """>"
		strBuffer = strBuffer & vbCrLf & "	<PARAM NAME=""ShowControls"" VALUE=""True"">"
		strBuffer = strBuffer & vbCrLf & "	<EMBED type=""application/x-mplayer2"""
		strBuffer = strBuffer & vbCrLf & "		pluginspage=""http://www.microsoft.com/windows/windowsmedia/download/plugin.aspx"""
		strBuffer = strBuffer & vbCrLf & "		height=""45"" width=""144"""
		strBuffer = strBuffer & vbCrLf & "		src=""" & strAudioUrl & """"
		strBuffer = strBuffer & vbCrLf & "		autostart=""True"" autoplay=""True"""
		strBuffer = strBuffer & vbCrLf & "		showcontrols=""1"""
		strBuffer = strBuffer & vbCrLf & "		visible=""True"" hidden=""False"">"
		strBuffer = strBuffer & vbCrLf & "	</EMBED>"
		strBuffer = strBuffer & vbCrLf & "</OBJECT>"
	End If
	PlayerCode = strBuffer
End Function

Function NavCode(strPrevious, strHome, strNext)
Dim strBuffer
	strBuffer = ""
	strBuffer = strBuffer & vbCrLf & "<font size=+2><a style='text-decoration:none' href='"
	strBuffer = strBuffer & strPrevious & "' title='Previous'>&#9668;</a></font>&nbsp;"
	strBuffer = strBuffer & vbCrLf & "<font size=+2><a style='text-decoration:none' href='"
	strBuffer = strBuffer & strHome & "' title='Home'>&#9788;</a></font>&nbsp;"
	strBuffer = strBuffer & vbCrLf & "<font size=+2><a style='text-decoration:none' href='"
	strBuffer = strBuffer & strNext & "' title='Next' id='Next' name='Next'>&#9658;</a></font>&nbsp;"
	strBuffer = strBuffer & "<script>setTimeout('document.getElementById(""Next"").focus()', 1000)</script>"
	NavCode = strBuffer
End Function

Function ContentCode(strTextFilePath, strPictureUrl, strBigPictureUrl)
Dim strBuffer
	strBuffer = ""
	If strPictureUrl <> "" Then
		strBuffer = strBuffer & vbCrLf
		If strBigPictureUrl <> "" Then
			strBuffer = strBuffer & "<a href=""" & strBigPictureUrl & """>"
		End If
		strBuffer = strBuffer & "<img src=""" & strPictureUrl & """ align=""right"" "
		If strBigPictureUrl <> "" Then
			strBuffer = strBuffer & "border=""0""></a>"
		Else 
			strBuffer = strBuffer & ">"
		End If
	End If
	If ((strPictureUrl <> "") And (strTextFilePath <> "")) Then
		strBuffer = strBuffer & vbCrLf & "<img height=1 width=100><br> "
		'strBuffer = strBuffer & vbCrLf & "<![if lt IE 5]><img height=1 width=200><br> <![endif]>"
		'strBuffer = strBuffer & vbCrLf & "<!--[if gte IE 5]><br clear=all><![endif]-->"
	End If
	If strTextFilePath <> "" Then
		strBuffer = strBuffer & vbCrLf & Text2Html(File2String(strTextFilePath))
	End If
	ContentCode = strBuffer
End Function