'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

destfile = "LinkDump_"+getfilename()+".html"
sourcefolder="."

'Body formatting
bodystyle="margin:0px;"
bodyheader="<div style='background-color:#383838;color:yellow;font-family:arial;font-size:small;font-weight:bold;'>"
bodyfooter="</div>"

'Title formatting
titlepretext="<b>"
titleposttext="</b>"

'link style  formatting
linkstyle="color:#888888;text-decoration:none;"
hoverstyle="color:#e8e8e8;"
itempretext=""
itemposttext=""

sectionbreak="<br>"
spacer="&nbsp;&nbsp;&nbsp;"
linebreak="<br>"

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'MAIN
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Set fso = CreateObject("Scripting.FileSystemObject")

html = "<style type='text/css'>Body{"+ bodystyle + "}A{" + linkstyle + "}A:hover{" + hoverstyle + "}</style>"
 
html = html + GetFolderLinks(sourcefolder)
Set fd = fso.CreateTextFile(destfile,true)
fd.WriteLine(bodyheader + html + bodyfooter)
fd.Close()
Set fd = Nothing
Set fso = Nothing

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

function GetFolderLinks(sourcefolder)
	result=""
	result = result + GetFiles(sourcefolder)
	for each folder in fso.GetFolder(sourcefolder).SubFolders
		result = result + GetFolderLinks(folder)
	next
	GetFolderLinks=result
end function

function GetFiles(sourcefolder)
	result=""
	firstrun=true
	hasfiles=false
	set folder = fso.GetFolder(sourcefolder)
	for each file in folder.files
		if right(file.Name,3)="url" then
			if firstrun=true then
				result = result + titlepretext + folder.Path + titleposttext + linebreak
			end if
			firstrun=false
			name = left(file.Name,instrrev(file.Name,".url")-1)
			url = geturl(file.Path)
			result = result + spacer + makelink(name,url) + linebreak
			resultarray = split(result,linebreak)
			SingleSorter(resultarray)
			result = join(resultarray,linebreak)
			hasfiles=true
		end if
	next
	if hasfiles = true then
		result = result + sectionbreak
	end if
		GetFiles=result
end function

function makelink(name, url)
	makelink = itempretext+"<a target=_blank href="+chr(34)+url+chr(34)+">"+name+"</a>"	+itemposttext
end function

function geturl(filename)
	Set	f = fso.OpenTextFile(filename)
	result = ""
	do while not f.AtEndOfStream
		if f.ReadLine = "[InternetShortcut]" then
			result = f.ReadLine
			result = right(result,len(result)-instr(result,"URL=")-3)
		end if
	loop
	f.Close()
	Set f = Nothing
	geturl=result
end function

function getfilename()
	'DAY
	result=cstr(year(now()))
	if month(now())<10 then
		result = result + "0"
	end if
	result = result + cstr(month(now()))
	if day(now())<10 then
		result = result + "0"
	end if
	result = result + cstr(day(now()))
	
	'MINUTE
	result=result+"_"
	if hour(now())<10 then
		result = result + "0"
	end if
	result = result + cstr(hour(now()))
	if minute(now())<10 then
		result = result + "0"
	end if
	result = result + cstr(minute(now()))	
	getfilename = result	
end function

Sub SingleSorter( byRef arrArray )
    Dim row, j
    Dim StartingKeyValue, NewKeyValue, swap_pos
    For row = 0 To UBound( arrArray ) - 1
        StartingKeyValue = arrArray ( row )
        NewKeyValue = arrArray ( row )
        swap_pos = row	    	
        For j = row + 1 to UBound( arrArray )
            If arrArray ( j ) < NewKeyValue Then
                swap_pos = j
                NewKeyValue = arrArray ( j )
            End If
        Next	    
        If swap_pos <> row Then
            arrArray ( swap_pos ) = StartingKeyValue
            arrArray ( row ) = NewKeyValue
        End If	
    Next
End Sub