'
' Change these to match your paths
'

CONST TITLE = "Favorites"
CONST PATH_MY_FAVORITES = "C:\Documents and Settings\Brandon\Favorites"
CONST PATH_OUTPUT = "C:\Program Files\Radio UserLand\www\stories\2003\04\10\favorites.txt"
CONST FOLDER_SKIP = "Links"

'
' Don't change after this point
'

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Sub CleanKill(strFile)

	On Error Resume Next

	Dim f

	Set f = g_objFSO.GetFile(strFile)

	f.Delete

	'
	' Do not error on deleting files
	'

	Err.Clear

End Sub

Sub ProcessDirectory(strPath)

	Dim fo
	Dim fi
	Dim strURL
	Dim strFileContents
	Dim strPatternStart

	Set fo = g_objFSO.GetFolder( strPath )
	strPatternStart = Chr(10) & "URL="

	For Each fi in fo.Files
		If Right( fi.Name, 4 ) = ".url" Then
			strFileContents = LoadFileIntoString( strPath & "\" & fi.Name )
			strURL = GetSubstring( strFileContents, strPatternStart, Chr(13) )
			If Len( strURL ) > 0 Then
				g_strFavorites = g_strFavorites + "     <DT><A HREF=""" + Right( strURL, Len( strURL ) - Len( strPatternStart ) ) + """>" + Left( fi.Name, Len( fi.Name ) - 4 ) + "</A>" & vbCrLf
			End If
		End If
	Next

	For Each fi in fo.SubFolders
		If fi.Name <> FOLDER_SKIP Then
			g_strFavorites = g_strFavorites + "<DT><H3>" + fi.Name + "</H3>" & vbCrLf & "   <DL>" & vbCrLf
			ProcessDirectory fi.Path
			g_strFavorites = g_strFavorites + "</DL>" & vbCrLf
		End If
	Next

End Sub

Function GetSubstring(strValue, strBegin, strEnd)

	Dim nPosBegin
	Dim nPosEnd

	GetSubstring = ""

	nPosBegin = InStr( strValue, strBegin )
	If nPosBegin > 0 Then
		nPosEnd = InStr( nPosBegin + 1, strValue, strEnd )
		If nPosEnd > 0 Then
			GetSubstring = Mid( strValue, nPosBegin, nPosEnd - nPosBegin )
		End If		

	End If

	If Len( GetSubstring ) = 0 Then
		GetSubstring = strValue
	End If

End Function

Function LoadFileIntoString(strFileName)

	On Error Resume Next

	Dim f
	Dim ts

	Set f = g_objFSO.GetFile( strFileName )
	If Err.Number <> ERROR_SUCCESS Then 
	End If

	Set ts = f.OpenAsTextStream( ForReading, TristateUseDefault )
	LoadFileIntoString = ts.ReadAll
	ts.Close

	Err.Clear

End Function

Sub WriteFile()

	If Not g_objFSO.FileExists( PATH_OUTPUT ) Then
	
		Set f = g_objFSO.CreateTextFile( PATH_OUTPUT, true )
		f.WriteLine g_strFavorites
		f.Close
	Else
	
		'
		' Print the line
		'

		Set f = g_objFSO.GetFile( PATH_OUTPUT )
		Set ts = f.OpenAsTextStream( ForAppending, TristateUseDefault )
		ts.Write g_strFavorites
	End If

End Sub

Dim g_strFavorites

Set g_objFSO = CreateObject("Scripting.FileSystemObject")

CleanKill PATH_OUTPUT

g_strFavorites = "#title """ & TITLE & """" & vbCrLf & vbCrLf & "<DL>" & vbCrLf

ProcessDirectory PATH_MY_FAVORITES

g_strFavorites = g_strFavorites & "</DL>" & vbCrLf

WriteFile