'**************************************************************
' MP3 lister
'
' Written by Linus Walleij with portions from the following
' scripts:
'
' "BrowseForFolder" by Seán Hennessy
' "Return Proper Case" by Chris Lawson
' "Directory Listing Script" by Richard Harrison
' "Recursively Rename Files" by Linus Walleij
'**************************************************************

Option Explicit

' Switches plain output file on/off
Const blnPlain = True
' Switches index file on/off
Const blnIndex = True

'*************************************************************************
' Browse for a folder to process
'*************************************************************************

Function BrowseForFolder(strPrompt)
	On Error Resume Next
	Dim objShell, objFolder, intColonPos, objWshShell
	Set objShell = WScript.CreateObject("Shell.Application")
	Set objWshShell = CreateObject("WScript.Shell")
	Set objFolder = objShell.BrowseForFolder(&H0&, strPrompt, &h1&)
	BrowseForFolder = objFolder.ParentFolder.ParseName(objFolder.Title).Path
	If Err.Number <> 0 Then
		BrowseForFolder = Null 'will be null of no special case applies
		If objFolder.Title = "Desktop" Then
			BrowseForFolder = objWshShell.SpecialFolders("Desktop")
		End If
		'If selected folder is a drive, it will have a colon e.g. C:\
		intColonPos = InStr(objFolder.Title, ":")
		If intColonPos > 0 Then
			BrowseForFolder = Mid(objFolder.Title, intColonPos - 1, 2) & "\"
		End If
	End If
End Function

'*************************************************************************
' String dialog box...
'*************************************************************************

Function GetString(strPrompt, strTitle, strDefault)
	Dim strTemp

	strTemp = InputBox(strPrompt,strTitle,strDefault)
	If strTemp = "" Then
		WScript.Quit
	End If
	GetString = strTemp
End Function

'*************************************************************************
' Capitalize it nicely
'*************************************************************************

Function Proper(txtName)
    Dim txtRest, txtTmp, intSpcPos, strChar, strLast

	' Convert string to lowercase
    txtRest = LCase(txtName)

	' All characters following a space should be capitalized
    intSpcPos = InStr(1, txtRest, " ")
    Do While intSpcPos <> 0
        txtTmp = txtTmp & UCase(Left(txtRest, 1)) & Mid(txtRest, 2,(intSpcPos - 1))
        txtRest = Mid(txtRest, intSpcPos + 1, Len(txtRest))
        intSpcPos = InStr(1, txtRest, " ")
    Loop
    txtRest = txtTmp & UCase(Left(txtRest, 1)) & Mid(txtRest, 2,Len(txtRest))

	'Add capitalization after certain letters...
	txtTmp=""
	strLast=" "
	For intSpcPos=1 To Len(txtRest)
		strChar = Mid(txtRest,intSpcPos,1)
		Select Case strLast
		Case "["
			txtTmp = txtTmp & Ucase(strChar)
		Case "("
			txtTmp = txtTmp & Ucase(strChar)
		Case "."
			txtTmp = txtTmp & Ucase(strChar)
		Case Else
			txtTmp = txtTmp & strChar
		End Select
		strLast = strChar
	Next

	Proper = txtTmp

End Function

'*************************************************************************
' Count the number of dashes in a name
'*************************************************************************

Function NoOfDashes(strIn)
	Dim intPos, intNoDash
	
	intNoDash = 0
	For intPos=1 To Len(strIn)
		If Mid(strIn,intPos,1)="-" Then intNoDash=intNoDash+1
	Next
	NoOfDashes = intNoDash
End Function

'*************************************************************************
' Remove leading figures at the beginning of a string
'*************************************************************************

Function strCutFigures(strIn)
	Dim intCnt1, intCnt2, blnCut, intCutNo
	Dim strTmp, intTmp
	' List of characters that will be removed if they appear in
	' the first positions of a title.
	Const strBannedFirst = "0123456789./-() "

	On Error Resume Next
	intTmp = 0
	intTmp = Cint(strIn)
	If (Not Err.Number) And intTmp > 99 Then
		strCutFigures = strIn
		Exit Function
	End If
	Err.Clear

	' Cut off all figures and other things in the beginning of the string, but do not do this
	' if the figures are immedeately followed by "th", "st", ":e"
	strTmp = strIn
	If Len(strIn) > 5 Then
		intCutNo = 0
		blnCut = True
		While (blnCut And (intCutNo < 5))
			blnCut = False
			For intCnt1 = 1 To Len(strBannedFirst)
				If (Mid(strIn,intCutNo+1,1) = Mid(strBannedFirst,intCnt1,1)) Then blnCut = True
			Next
			If blnCut Then intCutNo = intCutNo+1
		Wend
		If (IntCutNo > 0) Then strTmp = Right(strIn, Len(strIn)-intCutNo)
	End If
	' Always some stupid fuck put dots in there
	strTmp = Replace(strTmp, ".", " ")
	strTmp = Trim(strTmp)
	If Len(strTmp) > 0 Then
		strTmp = Ucase(Left(strTmp,1)) & Right(strTmp,Len(strTmp)-1)
	End If
	strCutFigures = strTmp
End Function

'*************************************************************************
' ZeroTrim trims off spaces, zerobytes in end and illegal characters
'*************************************************************************
Function ZeroTrim(strIn)
	Dim strTmp, intByte

	strTmp = strIn
	intByte = Cbyte(AscB(Mid(strTmp,Len(strTmp)-1,1)))
	If IntByte = 0 Then strTmp = Left(strTmp, Len(strTmp)-2)
	While (Cbyte(AscB(Right(strTmp,1)))=0) And (Len(strTmp)>0)
		strTmp = Left(strTmp, Len(strTmp)-1)
	Wend
	ZeroTrim = Trim(strTmp)
End Function

'*************************************************************************
' Trim32 returns a string exactly 32 bytes wide
'*************************************************************************
Function Trim32(strIn)
	If Len(strIn) < 32 Then
		Trim32 = strIn
		While Len(Trim32) < 32
			Trim32 = Trim32 & " "
		Wend
	Else
		Trim32 = Left(strIn, 32)
	End If
End Function

'*******************************************************
' Get the header of the MP3 File
'*******************************************************
Sub GetHeader(strCheckFileName, blnValid, bytHdr1, bytHdr2, bytHdr3, bytHdr4)
	Dim MpFile, strHdr, blnHdrFound, intCounter, strHeader

	blnValid = True
	intCounter = 0
	On Error Resume Next
	Set MpFile = oFileSys.OpenTextFile(strCheckFileName, 1, False, 0)
	If Not Err.Number Then
		bytHdr2 = Asc(MpFile.Read(1))
		If Err.Number Then
			Err.Clear
			blnValid = False
			Exit Sub
		End If
		blnHdrFound = False
		While (Not blnHdrFound) And (intCounter < 1024) And (Not MpFile.AtEndOfStream)
			intCounter = intCounter + 1
			bytHdr1 = bytHdr2
			bytHdr2 = Asc(MpFile.Read(1))
			strHeader = Hex(bytHdr1) & Hex(bytHdr2 And 224)
			If strHeader="FFE0" And (Not MpFile.AtEndOfStream) Then
				bytHdr3 = Asc(MpFile.Read(1))
				bytHdr4 = Asc(MpFile.Read(1)) 
				strHeader = Hex(bytHdr1) & Hex(bytHdr2) & Hex(bytHdr3) & Hex(bytHdr4)
				' Do ignore "headers" that look like this
				If Not strHeader = "FFFFFFFF" Then blnHdrFound=True
			End If
		Wend
		If Not blnHdrFound Then
			blnValid = False
		End If
		MpFile.Close
	Else
		' Default on error opening file
		blnValid = False
		Err.Clear
	End If
	Set MpFile = Nothing
End Sub

'*******************************************************
' Function for checking if a file is an MP3 file, this
' incredibly cool function checks the MPEG file header
' to see if it is a layer 2 or layer 3 mpeg file.
' Strings ".mp2" or ".mp3" are returned. This can be
' used to check ANY file but is not 100% failsafe...
'*******************************************************

Function intLayerCheck(strCheckFileName)
	Dim blnValid, intLayer
	Dim bytHdr1, bytHdr2, bytHdr3, bytHdr4

	GetHeader strCheckFileName, blnValid, bytHdr1, bytHdr2, bytHdr3, bytHdr4
	' Then proceed to check what layer the file is encoded with
	If blnValid Then
		intLayer = ((bytHdr2 And 6) / 2)
		Select Case intLayer
			Case 0 intLayerCheck = 0
			Case 1 intLayerCheck = 3
			Case 2 intLayerCheck = 2
			Case 3 intLayerCheck = 1
		End Select
	Else
		intLayerCheck = 0
	End If
End Function

'*******************************************************
' Function for getting the mode of an MP3 file
'*******************************************************

Function strModeCheck(strCheckFileName)
	'Default to True
	Dim blnValid
	Dim bytHdr1, bytHdr2, bytHdr3, bytHdr4
	Dim intMode

	GetHeader strCheckFileName, blnValid, bytHdr1, bytHdr2, bytHdr3, bytHdr4
	If blnValid Then
		intMode = (bytHdr4 And 192)
		Select Case intMode
			Case 0 strModeCheck = "Stereo"
			Case 64 strModeCheck = "Joint Stereo"
			Case 128 strModeCheck = "Dual Channel"
			Case Else strModeCheck = "Mono"
		End Select
	Else
		strModeCheck = "Unknown"
	End If
End Function

'*******************************************************
' Function for getting the bitrate of an MP3 file
' will return 0 if bitrate is invalid/unknown
'*******************************************************

Function intBitrateCheck(strCheckFileName)
	'Default to True
	Dim blnValid
	Dim bytHdr1, bytHdr2, bytHdr3, bytHdr4
	Dim intMpegVersion, intLayer, intBitrate, intSrate
	
	GetHeader strCheckFileName, blnValid, bytHdr1, bytHdr2, bytHdr3, bytHdr4
	' bytHdr1.8 = 11111111 8 bits sync
	' bytHdr2   = 111      3 bits sync --> 11 bits sync
	' bytHdr2   =    11    2 bits MPEG version
	' bytHdr2   =      11  2 bits layer info
	' bytHdr2   =        1 1 bit  unknown use
	' bytHdr3   = 1111     4 bits bitrate
	' bytHdr3   =     11   2 bits sample rate
	If blnValid Then
		intMpegVersion = ((bytHdr2 And 24) / 8)
		intSrate = ((bytHdr3 And 12) / 4)
		intLayer = ((bytHdr2 And 6) / 2)
		intBitrate = ((bytHdr3 And 240) / 16)
		Select Case intMpegVersion
			Case 0 ' Mpeg Version 2.5
				Select Case intLayer
					Case 1 ' Layer 3
						Select Case intBitrate
							Case 0 intBitrateCheck = 0
							Case 1 intBitrateCheck = 8
							Case 2 intBitrateCheck = 16
							Case 3 intBitrateCheck = 24
							Case 4 intBitrateCheck = 32
							Case 15 intBitrateCheck = 0
							Case Else intBitrateCheck = intBitrate
						End Select
					Case Else ' Layers 1 & 2?
						intBitrateCheck = 0
				End Select
			Case 1 intBitrateCheck = 0  ' Reserved state
			Case 2 ' Mpeg Version 2.0
				Select Case intLayer
					' Case 0 intBitrateCheck = 0 ' Layer 2 ?
					Case 1 ' Layer 3
						Select Case intBitrate
							Case 0 intBitrateCheck = 0
							Case 1 intBitrateCheck = 8
							Case 2 intBitrateCheck = 16
							Case 3 intBitrateCheck = 24
							Case 4 intBitrateCheck = 32
							Case 5 intBitrateCheck = 40
							Case 6 intBitrateCheck = 48
							Case 7 intBitrateCheck = 56
							Case 8 intBitrateCheck = 64
							Case 9 intBitrateCheck = 80
							Case 10 intBitrateCheck = 96
							Case 11 intBitrateCheck = 112
							Case 12 intBitrateCheck = 128
							Case 13 intBitrateCheck = 144
							Case 14 intBitrateCheck = 160
							Case 15 intBitrateCheck = 0
						End Select
					Case 0,2 ' Layer 2
						Select Case intBitrate
							Case 0 intBitrateCheck = 0
							Case 1 intBitrateCheck = 8
							Case 2 intBitrateCheck = 16
							Case 3 intBitrateCheck = 24
							Case 4 intBitrateCheck = 32
							Case 5 intBitrateCheck = 40
							Case 6 intBitrateCheck = 48
							Case 7 intBitrateCheck = 56
							Case 8 intBitrateCheck = 64
							Case 9 intBitrateCheck = 80
							Case 10 intBitrateCheck = 96
							Case 11 intBitrateCheck = 112
							Case 12 intBitrateCheck = 128
							Case 13 intBitrateCheck = 144
							Case 14 intBitrateCheck = 160
							Case 15 intBitrateCheck = 0
						End Select
					Case 3 ' Layer 1
						Select Case intBitrate
							Case 0 intBitrateCheck = 0
							Case 1 intBitrateCheck = 32
							Case 2 intBitrateCheck = 48
							Case 3 intBitrateCheck = 56
							Case 4 intBitrateCheck = 64
							Case 5 intBitrateCheck = 80
							Case 6 intBitrateCheck = 96
							Case 7 intBitrateCheck = 112
							Case 8 intBitrateCheck = 128
							Case 9 intBitrateCheck = 144
							Case 10 intBitrateCheck = 160
							Case 11 intBitrateCheck = 176
							Case 12 intBitrateCheck = 192
							Case 13 intBitrateCheck = 224
							Case 14 intBitrateCheck = 256
							Case 15 intBitrateCheck = 0
						End Select
				End Select
			Case 3 ' Mpeg Version 1.0
				Select Case intLayer
					'Case 0 intBitrateCheck = 0  ' Layer 2 ?
					Case 1 ' Layer 3
						Select Case intBitrate
							Case 0 intBitrateCheck = 0
							Case 1 intBitrateCheck = 32
							Case 2 intBitrateCheck = 40
							Case 3 intBitrateCheck = 48
							Case 4 intBitrateCheck = 56
							Case 5 intBitrateCheck = 64
							Case 6 intBitrateCheck = 80
							Case 7 intBitrateCheck = 96
							Case 8 intBitrateCheck = 112
							Case 9 intBitrateCheck = 128
							Case 10 intBitrateCheck = 160
							Case 11 intBitrateCheck = 192
							Case 12 intBitrateCheck = 224
							Case 13 intBitrateCheck = 256
							Case 14 intBitrateCheck = 320
							Case 15 intBitrateCheck = 0
						End Select
					Case 0,2 ' Layer 2
						Select Case intBitrate
							Case 0 intBitrateCheck = 0
							Case 1 intBitrateCheck = 32
							Case 2 intBitrateCheck = 48
							Case 3 intBitrateCheck = 56
							Case 4 intBitrateCheck = 64
							Case 5 intBitrateCheck = 80
							Case 6 intBitrateCheck = 96
							Case 7 intBitrateCheck = 112
							Case 8 intBitrateCheck = 128
							Case 9 intBitrateCheck = 160
							Case 10 intBitrateCheck = 192
							Case 11 intBitrateCheck = 224
							Case 12 intBitrateCheck = 256
							Case 13 intBitrateCheck = 320
							Case 14 intBitrateCheck = 384
							Case 15 intBitrateCheck = 0
						End Select
					Case 3 ' Layer 1
						Select Case intBitrate
							Case 0 intBitrateCheck = 0
							Case 1 intBitrateCheck = 32
							Case 2 intBitrateCheck = 64
							Case 3 intBitrateCheck = 96
							Case 4 intBitrateCheck = 128
							Case 5 intBitrateCheck = 160
							Case 6 intBitrateCheck = 192
							Case 7 intBitrateCheck = 224
							Case 8 intBitrateCheck = 256
							Case 9 intBitrateCheck = 288
							Case 10 intBitrateCheck = 320
							Case 11 intBitrateCheck = 352
							Case 12 intBitrateCheck = 384
							Case 13 intBitrateCheck = 416
							Case 14 intBitrateCheck = 448
							Case 15 intBitrateCheck = 0
						End Select
				End Select
		End Select
	Else
		intBitrateCheck = 0
	End If
End Function

'*******************************************************
' Function for getting the bitrate of an MP3 file
'*******************************************************

Function dblVersionCheck(strCheckFileName)
	'Default to True
	Dim blnValid
	Dim bytHdr1, bytHdr2, bytHdr3, bytHdr4
	Dim intMpegVersion
	
	GetHeader strCheckFileName, blnValid, bytHdr1, bytHdr2, bytHdr3, bytHdr4
	If blnValid Then
		intMpegVersion = ((bytHdr2 And 24) / 8)
		Select Case intMpegVersion
			Case 0 dblVersionCheck = 2.5 ' MPEG 2.5
			Case 1 dblVersionCheck = 0  ' Reserved state
			Case 2 dblVersionCheck = 2  ' MPEG 2.0
			Case 3 dblVersionCheck = 1  ' MPEG 1.0
		End Select
	Else
		dblVersionCheck = 0
	End If
End Function

'*******************************************************
' Function for getting the bitrate of an MP3 file
'*******************************************************

Function intSampleRateCheck(strCheckFileName)
	'Default to True
	Dim blnValid
	Dim bytHdr1, bytHdr2, bytHdr3, bytHdr4
	Dim intMpegVersion, intSrate, intBitrate

	GetHeader strCheckFileName, blnValid, bytHdr1, bytHdr2, bytHdr3, bytHdr4
	If blnValid Then
		intMpegVersion = ((bytHdr2 And 24) / 8)
		intSrate = ((bytHdr3 And 12) / 4)
		intBitrate = ((bytHdr3 And 240) / 16)
		Select Case intMpegVersion
			Case 0 ' Mpeg Version 2.5
				Select Case intSrate
					Case 0 intSampleRateCheck = 11025
					Case 1 intSampleRateCheck = 12000
					Case 2 intSampleRateCheck = 8000
					Case 3 intSampleRateCheck = 0
				End Select
			Case 1 intSampleRateCheck = 0  ' Reserved state
			Case 2 ' Mpeg Version 2.0
				Select Case intSrate
					Case 0 intSampleRateCheck = 22050
					Case 1 intSampleRateCheck = 24000
					Case 2 intSampleRateCheck = 16000
					Case 3 intSampleRateCheck = 0
				End Select
			Case 3 ' Mpeg Version 1.0
				Select Case intSrate
					Case 0 intSampleRateCheck = 44100
					Case 1 intSampleRateCheck = 48000
					Case 2 intSampleRateCheck = 32000
					Case 3 intSampleRateCheck = 0
				End Select
		End Select
	Else
		intSampleRateCheck = 0
	End If
End Function

'*************************************************************************
' Kill those stoopid URLencodingz
' OK I could've used the Server object method "URLdecode" but I cannot be
' sure that it is available...
'*************************************************************************
Function strURLDecode(strIn)
	Dim i, bytChar, strTmp
	i=1
	strTmp=""
	While (i <= Len(strIn))
		If Mid(strIn,i,1)="%" Then
			' This actually works! I'm surprised...
			bytChar = CByte("&H" & Mid(strIn,i+1,2))
			strTmp = strTmp & Chr(bytChar)
			i=i+2
		Else
			strTmp = strTmp & Mid(strIn,i,1)
		End If
		i=i+1
	Wend
	strURLDecode = strTmp
End Function

'*************************************************************************
' Fixes [Artist Name] Song Title => Artist Name - Song Title
'*************************************************************************
Function BracesFix(strIn)
	Dim strTmp, i, blnFound

	If Left(strIn,1)="[" Then
		blnFound = False
		strTmp = ""
		For i = 1 To Len(strIn)
			If Mid(strIn,i,1)="]" Then
				' This replaces the trailing ] (first occurence) with -
				If Not blnFound Then
					strTmp = strTmp & "-"
				Else
					strTmp = strTmp & "]"
				End If
				blnFound = True
			Else
				strTmp = strTmp & Mid(strIn,i,1)
			End If
		Next
		If blnFound Then
			BracesFix = strTmp
			' Finally remove the leading [
			BracesFix = Right(BracesFix, Len(BracesFix)-1)
		Else
			' Dont touch it
			BracesFix = strIn
		End If
	Else
		BracesFix = strIn
	End If
End Function

'*************************************************************************
' Convert file name using a set of simple rules. OK this is crude but it
' really works. It's my own little EXPERT SYSTEM!
'*************************************************************************
Function ConvertName(strOldName)
	Dim strTmp, intTmp

	strTmp = strOldName

	strTmp = LTrim(strTmp)
	strTmp = BracesFix(strTmp)

	'*************************************************************************
	' Insert a check for filename of type "Abba-WhenIKissedTheTeacher" to be
	' detected and splitted into Abba - When I Kissed The Teacher"
	'*************************************************************************

	' Obvious misuse of dashes instead of spaces
	If (NoOfDashes(strTmp) > 3) Then
		strTmp = Replace(strTmp,"-"," ")
	End If
	' Call the function above to remove %20 and similar crap
	strTmp = strURLDecode(strTmp)
	' Swedish ASCII correction
	strTmp = Replace(strTmp,"†","å") ' *a
	strTmp = Replace(strTmp,"„","ä") ' "a
	strTmp = Replace(strTmp,"”","ö") ' "o
	strTmp = Replace(strTmp,"�","Å") ' *A
	strTmp = Replace(strTmp,"Ž","Ä") ' "A
	strTmp = Replace(strTmp,"™","Ö") ' "O

	' Kill that stoopid Unix name formatting
	strTmp = Replace(strTmp,"_"," ")
	' Kill that stoopid paranthesis indenting
	strTmp = Replace(strTmp,"( ","(")
	strTmp = Replace(strTmp," )",")")
	strTmp = Replace(strTmp,"[ ","[")
	strTmp = Replace(strTmp," ]","]")
	' Lighten crunched parantheses
	strTmp = Replace(strTmp,")[",") [")
	strTmp = Replace(strTmp,"](","] (")
	' Fix up spacing (OK this is crude too)
	strTmp = Replace(strTmp,"("," (")
	strTmp = Replace(strTmp,")",") ")
	strTmp = Replace(strTmp,"["," [")
	strTmp = Replace(strTmp,"]","] ")
	' This is a case of insanely genious programming
	strTmp = Replace(strTmp,"--","-")
	strTmp = Replace(strTmp,"-"," - ")
	' So it corrects its own mistakes (even cruder)
	strTmp = Replace(strTmp,"  ("," (")
	strTmp = Replace(strTmp,")  ",") ")
	strTmp = Replace(strTmp,"  ["," [")
	strTmp = Replace(strTmp,"]  ","] ")
	strTmp = Replace(strTmp,"] .","].")
	strTmp = Replace(strTmp,") .",").")
	' Replace all kind of double spaces
	strTmp = Replace(strTmp,"  "," ")
	strTmp = Replace(strTmp,"  "," ")
	strTmp = Replace(strTmp,"  "," ")
	' Properize
	strTmp = Proper(strTmp)
	' Remove any mp3/mp2/mpg/mpa extension
	If Len(strTmp) > 4 Then
		If (Lcase(Mid(strTmp,Len(strTmp)-3,3))=".mp") Then strTmp = Left(strTmp,Len(strTmp)-4)
	End If
	' Some things get TOO proper (OK this is crude)
	strTmp = Replace(strTmp," A "," a ")
	strTmp = Replace(strTmp," An "," an ")
	strTmp = Replace(strTmp," The "," the ")
	strTmp = Replace(strTmp," To "," to ")
	strTmp = Replace(strTmp," Of "," of ")
	strTmp = Replace(strTmp," On "," on ")
	strTmp = Replace(strTmp," In "," in ")
	strTmp = Replace(strTmp," Is "," is ")
	strTmp = Replace(strTmp," For "," for ")
	strTmp = Replace(strTmp," - a"," - A")
	strTmp = Replace(strTmp," - an"," - An")
	strTmp = Replace(strTmp," - the"," - The")
	strTmp = Replace(strTmp," - to "," - To ")
	strTmp = Replace(strTmp," - of "," - Of ")
	strTmp = Replace(strTmp," - on "," - On ")
	strTmp = Replace(strTmp," - in "," - In ")
	strTmp = Replace(strTmp," - for "," - For ")
	' Some obvious mistakes I've found...
	' add all things you find erroneously named in here.
	strTmp = Replace(strTmp,"Dj ","DJ ")
	strTmp = Replace(strTmp,"Djs ","DJs ")
	strTmp = Replace(strTmp,"DJ - ","DJ ")
	strTmp = Replace(strTmp,"Ac - Dc ","AC-DC ")
	strTmp = Replace(strTmp,"Acdc ","AC-DC ")
	strTmp = Replace(strTmp,"Ebtg ","Everything But the Girl ")
	strTmp = Replace(strTmp,"Bjrk ","Björk ")
	strTmp = Replace(strTmp,"Bjrn ","Björn ")
	strTmp = Replace(strTmp,"Beastieboys ","Beastie Boys ")
	strTmp = Replace(strTmp,"C - Tec","C-Tec")
	strTmp = Replace(strTmp,"Ccr ","CCR ")
	strTmp = Replace(strTmp,"Atr ","ATR ")
	strTmp = Replace(strTmp,"Abba ","ABBA ")
	strTmp = Replace(strTmp,"Rmb ","RMB ")
	strTmp = Replace(strTmp,"Zz Top ","ZZ Top ")
	strTmp = Replace(strTmp,"A - Ha ","A-Ha ")
	strTmp = Replace(strTmp,"B - Charme ","B-Charme ")
	strTmp = Replace(strTmp,"C - Block ","C-Block ")
	strTmp = Replace(strTmp,"D - Tune ","D-Tune ")
	strTmp = Replace(strTmp,"E - Type ","E-Type ")
	strTmp = Replace(strTmp,"X - Perience ","X-Perience ")
	strTmp = Replace(strTmp,"Dee - Lite ","Dee-Lite ")
	strTmp = Replace(strTmp,"Run - Dmc ","Run-DMC ")
	strTmp = Replace(strTmp,"Run Dmc ","Run-DMC ")
	strTmp = Replace(strTmp,"Ann - Lie ","Ann-Lie ")
	strTmp = Replace(strTmp,"Cajsa - Stina ","Cajsa-Stina ")
	strTmp = Replace(strTmp," - Rmx"," RMX")
	strTmp = Replace(strTmp," Rmx"," RMX")
	strTmp = Replace(strTmp," - Remix"," RMX")
	strTmp = Replace(strTmp," Remix"," RMX")
	strTmp = Replace(strTmp," Ft. "," ft ")
	strTmp = Replace(strTmp," Feat "," ft ")
	strTmp = Replace(strTmp," Feat. "," ft ")
	If Right(strTmp,3)=" Ep" Then strTmp = Replace(strTmp," Ep"," EP")
	' What a decoder is it that puts !s at the end of every filename
	' and a N01Songtitle thing at the beginning of the file???
	If Right(strTmp,2)="!s" Then
		strTmp=Left(strTmp,Len(strTmp)-2)
		On Error Resume Next
		If Left(strTmp,1)="N" Then
			intTmp = 0
			intTmp = Cint(Mid(strTmp,2,2))
			If (Not Err.Number) And (intTmp > 0) And (intTmp < 100) Then
				strTmp = Right(strTmp,Len(strTmp)-3)
				strTmp = Ucase(Left(strTmp,1)) & Right(strTmp,Len(strTmp)-1)
			Else
				Err.Clear
			End If
		End If
	End If
	' Beatforge and friends - put your SIGs in the ID3 tag plz
	If Right(strTmp,3)=" Bf" Then strTmp=Left(strTmp,Len(strTmp)-3)
	If Right(strTmp,6)=" Bftop" Then strTmp=Left(strTmp,Len(strTmp)-6)
	If Right(strTmp,10)=" Xtd Bftop" Then strTmp=Left(strTmp,Len(strTmp)-10)
	If Right(strTmp,4)=" Nbd" Then strTmp=Left(strTmp,Len(strTmp)-4)
	If Left(strTmp,6)="12i - " Then strTmp=Right(strTmp,Len(strTmp)-6)
	If Right(strTmp,4)=" 12i" Then strTmp=Left(strTmp,Len(strTmp)-4)
	If Right(strTmp,7)=" 12inch" Then strTmp=Left(strTmp,Len(strTmp)-7)
	If Right(strTmp,3)=" Oz" Then strTmp=Left(strTmp,Len(strTmp)-3)
	If Right(strTmp,4)=" Wax" Then strTmp=Left(strTmp,Len(strTmp)-4)
	If Right(strTmp,4)=" Atm" Then strTmp=Left(strTmp,Len(strTmp)-4)
	If Right(strTmp,4)=" Swe" Then strTmp=Left(strTmp,Len(strTmp)-4)
	If Right(strTmp,3)=" Ii" Then strTmp=Left(strTmp,Len(strTmp)-3) & " 2"
	' From some stuid man that signifies "disks" with d1 for disc 1 etc
	If Right(strTmp,3)=" D1" Then strTmp=Left(strTmp,Len(strTmp)-3)
	If Right(strTmp,3)=" D2" Then strTmp=Left(strTmp,Len(strTmp)-3)
	If Right(strTmp,3)=" D3" Then strTmp=Left(strTmp,Len(strTmp)-3)
	If Right(strTmp,3)=" D4" Then strTmp=Left(strTmp,Len(strTmp)-3)
	If Right(strTmp,3)=" D5" Then strTmp=Left(strTmp,Len(strTmp)-3)
	' Remove trailing dash
	If Right(strTmp,1)="-" Then strTmp=Left(strTmp,Len(strTmp)-1)
	' If there is any space at the beginning or end then cut it!
	strTmp = Trim(strTmp)
	ConvertName = strTmp
End Function

'*************************************************************************
' This function reads info from the ID3 tag if present
'*************************************************************************

Function GetTag(strCheckFileName, strTitle, strArtist, strAlbumTitle, strYear, strComment, intGenre, blnHasTag)
	Dim oMpFile, oMpStream, intSize, strHdr
	Dim strTmpTitle, strTmpArtist, strTmpAlbumTitle, strTmpYear

	On Error Resume Next
	Set oMPFile = oFileSys.GetFile(strCheckFileName)
	If Err.Number Then
		strComment=""
		Exit Function
	Else
		intSize = oMpFile.Size
		Set oMpFile = Nothing
	End If

	Set oMpStream = oFileSys.OpenTextFile(strCheckFileName, 1, False, 0)
	If Not Err.Number Then
		On Error Resume Next
		oMpStream.Skip(intSize-128)
		strHdr = oMpStream.Read(3)
		If strHdr = "TAG" Then
			blnHasTag = True
			strTmpTitle = ZeroTrim(oMpStream.Read(30))
			' Ignore zero length titles.
			' If the previous title is longer than the TAG:ed title, and
			' the present first 20 char portion is equal, override the TAG with the filename
			If (Not Len(strTmpTitle) = 0) Then
				If (Len(strTitle) > Len(strTmpTitle)) And (Len(strTitle) > 20) Then
					If strComp( LCase(Left(strTitle, 20)), LCase(Left(strTmpTitle, 20)), 1) Then strTitle = strTmpTitle
				Else
					strTitle = strTmpTitle
				End If
			End If
			strTitle = ConvertName(strTitle)

			strTmpArtist = ZeroTrim(oMpStream.Read(30))
			' Ignore zero length artist names.
			' If the previous name is longer than the TAG:ed title, and
			' the present first 20 char portion is equal, override the TAG with the filename
			If (Not Len(strTmpArtist) = 0) Then
				If (Len(strArtist) >= Len(strTmpArtist)) And (Len(strArtist) > 20) Then
					If strComp( LCase(Left(strArtist, 20)), LCase(Left(strTmpArtist, 20)), 1) Then strArtist = strTmpArtist
				Else
					strArtist = strTmpArtist
				End If
			End If
			strArtist = ConvertName(strArtist)
			
			strTmpAlbumTitle = ZeroTrim(oMpStream.Read(30))
			' Ignore zero length album titles.
			' If the previous title is longer than the TAG:ed title, and
			' the present first 20 char portion is equal, override the TAG with the dirname
			If (Not Len(strTmpAlbumTitle) = 0) Then
				If (Len(strAlbumTitle) > Len(strTmpAlbumTitle)) And (Len(strAlbumTitle) > 20) Then
					If strComp( LCase(Left(strAlbumTitle, 20)), LCase(Left(strTmpAlbumTitle, 20)), 1) Then strAlbumTitle = strTmpAlbumTitle
				Else
					strAlbumTitle = strTmpAlbumTitle
				End If
			End If
			strAlbumTitle = ConvertName(strAlbumTitle)

			strTmpYear = ZeroTrim(oMpStream.Read(4))
			If Len(strTmpYear) > 1 Then
				' Compensate for two-digit years mind you... Not entirely perfect routine ;-)
				' Hm what if non-figures exists in the year TAG? Will it crash...?
				If Len(strTmpYear) = 2 Then
					If Cint(Left(strTmpYear,1)) > 5 Then
						strTmpYear = "19" & strTmpYear
					Else
						strTmpYear = "20" & strTmpYear
					End If
				End If
				If Not (strTmpYear="none" Or strTmpYear="????") Then strYear = strTmpYear
			End If

			strComment = ZeroTrim(oMpStream.Read(30))
			intGenre = Cbyte(AscB(oMpStream.Read(1)))
		Else
			strComment = ""
		End If
		oMpStream.Close
	Else
		strComment = "Unknown"
	End If
	Set oMpStream = Nothing
End Function


'*************************************************************************
' Make an educated guess of the artists' name from the filename and dir
'*************************************************************************

Function strGetArtistFromDir(strDir)
	Dim strTmp, strArray, blnInSubdirName

	' First check if there is a dash in the last part
	' of the directory name.
	blnInSubdirName = True
	strTmp = strDir
	strArray = Split(strTmp, "\")
	strTmp = ConvertName(strArray(Ubound(strArray)))
	strArray = Split(strTmp," - ")
	If Ubound(strArray) = 0 Then
		' It was not possible to locate the artist in the
		' first part of the subdirectory name
		blnInSubdirName = False
		strTmp = Replace(strDir,"\","-")
		strTmp = ConvertName(strTmp)
		strArray = Split(strTmp, " - ")
	End If
	If (Ubound(strArray) >= 0) Then
		If Ubound(strArray) = 0 Then
			strGetArtistFromDir = strArray(0)
		Else
			If (Len(strArray(Ubound(strArray)-1)) > 5) Or blnInSubdirName Then
				strGetArtistFromDir = strArray(Ubound(strArray)-1)
			Else
				strGetArtistFromDir = strArray(Ubound(strArray))
			End If
		End If
	Else
		strGetArtistFromDir = "Unknown"
	End If
End Function

' Main routine
Function strArtist(strName, strDir)
	Dim strArray, strTmp

	strArray = Split(strName, " - ")
	If Ubound(strArray)=0 Then
		strArtist = strGetArtistFromDir(strDir)
	Else
		On Error Resume Next
		If IsNumeric(strArray(0)) Then
			' Few artists I know of have numbers for name...
			If Ubound(strArray)>1 Then
				strArtist = strArray(1)
			Else
				strArtist = strGetArtistFromDir(strDir)
			End If
		Else
			Err.Clear
			strArtist = strArray(0)
		End If
	End If
	If Left(strArtist,1) = "(" And Right(strArtist,1) = ")" Then
		strArtist = Mid(strArtist,2,Len(strArtist)-2)
	End If
	strArtist = strCutFigures(strArtist)
End Function

'*************************************************************************
' Make an educated guess of the songs title from the filename
'*************************************************************************

Function strTitle(strName)
	Dim strArray

	strArray = Split(strName, " - ")
	strTitle = strArray(Ubound(strArray))
	' If that word is (paranthesed) then the previous word is probably part of
	' the title as well
	If (Left(strTitle,1)="(" And Right(strTitle,1)=")" And Ubound(strArray)>0) Then
		strTitle = strArray(Ubound(strArray)-1) & " " & strTitle
	End If
	strTitle = strCutFigures(strTitle)
End Function

'*************************************************************************
' Make an educated guess of the albums title from the directory name
'*************************************************************************

Function strAtitle(strDir, strArtistName)
	Dim strTmp, strArray

	strTmp = Replace(strDir,"\","-")
	strTmp = ConvertName(strTmp)
	strArray = Split(strTmp, " - ")
	If UBound(strArray) >= 0 Then
		If strArray(Ubound(strArray)) <> "" Then
			If (Ubound(strArray) > 0) And (strArray(Ubound(strArray)) = strArtistName) Then
				strAtitle = strArray(Ubound(strArray)-1)
			Else
				strAtitle = strArray(Ubound(strArray))
			End If
		Else
			strAtitle = "Unknown"
		End If
	Else
		strAtitle = "Unknown"
	End If
	strAtitle = strCutFigures(strAtitle)
End Function

'*************************************************************************
' This function calculates the running time of an MP3
'*************************************************************************
Function strGetTime(intBitrate, intFileSize, blnHasTag)
	Dim intSeconds, intMinutes
	Dim strSeconds, strMinutes

	If intBitrate = 0 Then
		intSeconds = 0
	Else
		If blnHasTag Then
			intSeconds = ((intFileSize-128) * 8) \ (intBitrate * 1000)
		Else
			intSeconds = (intFileSize * 8) \ (intBitrate * 1000)
		End If
	End If
	intMinutes = intSeconds \ 60
	intSeconds = intSeconds Mod 60
	If intMinutes < 10 Then
		strMinutes = "0" & intMinutes
	Else
		strMinutes = Cstr(intMinutes)
	End If
	If intSeconds < 10 Then
		strSeconds = "0" & intSeconds
	Else
		strSeconds = Cstr(intSeconds)
	End If
	
	strGetTime = strMinutes & ":" & strSeconds
End Function

'*************************************************************************
' Prepare string for CommaSeparatedValues format
'*************************************************************************
Function strCSVenc(strIn)
	' Hm how do you actually treat ;'s in a CSV? Fix it someday.
	strCSVenc = Replace(strIn,";","-")
End Function

'*************************************************************************
' Recursively get directories
'*************************************************************************

Sub GetDir(dir)
Dim fh2,fh3,oFolder,oFolders,oFiles,item,item2
Dim strOld, strNew, strTmp, strDir
Dim blnFirstFile

Dim intBitrate, intSamplerate, intLayer
Dim dblVersion
Dim blnHasTag

Dim strSongTitle, strArtistName, strAlbumTitle, intGenre, strTime
Dim strYear, strFilePath, intFileSize, strMode, strBitrate
Dim strSamplerate, strVersion, strLayer, strComment
Dim intDialogResult, blnReverse

Set oFolder=oFileSys.GetFolder(dir)
Set oFolders=oFolder.SubFolders
Set oFiles=oFolder.Files

' get all sub-folders in this folder
For each item in oFolders
	'go to each one
	GetDir(item)
Next
	item2=0

	strDir = dir
	If (Mid(strDir,2,2)=":\") Then strDir = Right(strDir,Len(strDir)-3)
	If strDir = "" Then strDir = "\"
	blnFirstFile = True
	For each item2 in oFiles
		If Right(dir,1) = "\" Then
			strOld = dir & item2.Name
		Else
			strOld = dir & "\" & item2.Name
		End If
		' If the filename is mpeg something go to action
		If Mid(strOld, Len(strOld)-3, 3) = ".mp" Then
			' Fix up the name using rulez
			strNew = ConvertName(item2.Name)
			' Write on the format
			' Song Title, Artist Name, Album Title, Genre, Time, Year,
			' File Path, File Size, Volume Name, Mode, Bitrate,
			' Samplerate, Version, Layer, Comment
			strSongTitle = strTitle(strNew)
			strArtistName = strArtist(strNew, strDir)
			strAlbumTitle = strAtitle(strDir, strArtistName)
			If blnFirstFile Then
				blnReverse = False
				intDialogResult = MsgBox("Processing -> " & dir & vbCRLF & vbCRLF & "Artist:    " & strArtistName & vbCRLF & "Title:     " & strSongTitle & vbCRLF & "Album:  " & strAlbumTitle & vbCRLF & vbCRLF & "Does this look allright?" & vbCRLF & "(No = Artist<->Title, Cancel = skip this directory)", 3, "Confirm naming conventions")
				If intDialogResult = 2 Then Exit Sub
				If intDialogResult = 7 Then blnReverse = True
			End If
			If blnReverse Then
				strTmp = strArtistName
				strArtistName = strSongTitle
				strSongTitle = strTmp
			End If
			intGenre = 80 ' Unknown
			strYear = DatePart("yyyy", item2.DateCreated)
			strFilePath = strOld
			intFileSize = item2.Size
			' strVolumeName already defined
			strMode = strModeCheck(strOld)
			intBitrate = intBitrateCheck(strOld)
			strBitrate = intBitrate & " Kbit/s"
			intSamplerate = intSampleRateCheck(strOld)
			strSamplerate = intSamplerate & " Hz"
			intLayer = intLayerCheck(strOld)
			strLayer = "Layer " & intLayer
			dblVersion = dblVersionCheck(strOld)
			strVersion = "MPEG " & intLayer
			' The tag overrides all defaults
			blnHasTag = False
			GetTag strOld, strSongTitle, strArtistName, strAlbumTitle, strYear, strComment, intGenre, blnHasTag
			strTime = strGetTime(intBitrate, intFileSize, blnHasTag)

			If blnPlain Then
				set fh3=oFileSys.openTextFile(strDestFolder & "\DirListPlain.csv",8)
				fh3.Write(strCSVenc(strSongTitle) & ";")
				fh3.Write(strCSVenc(strArtistName) & ";")
				fh3.Write(strCSVenc(strAlbumTitle) & ";")
				fh3.Write(intGenre & ";")
				fh3.Write(strTime & ";")
				fh3.Write(strYear & ";")
				fh3.Write(strCSVenc(strFilePath) & ";")
				fh3.Write(intFileSize & ";")
				fh3.Write(strCSVenc(strVolumeName) & ";")
				fh3.Write(strMode & ";")
				fh3.Write(strBitrate & ";")
				fh3.Write(strSamplerate & ";")
				fh3.Write(strVersion & ";")
				fh3.Write(strLayer & ";")
				fh3.WriteLine(strComment)
				fh3.close
			End If
			If blnIndex Then
				set fh3=oFileSys.openTextFile(strDestFolder & "\DirListIndex.txt",8)
				If blnFirstFile Then
					fh3.WriteLine(vbCRLF & "Contents of: " & strVolumeName & ", " & strDir)
					fh3.WriteLine("   Artist:                         Title:                           Year:")
				End If
				fh3.Write("   " & Trim32(strArtistName))
				fh3.Write(Trim32(strSongTitle))
				fh3.WriteLine(" " & strYear)
				fh3.close
			End If
			blnFirstFile = False
		End If
	Next
End Sub

' Delete: WS_FTP.LOG, 

'************************************************************************
' The MAIN loop as we say in C
'************************************************************************

' Create the FileSystem Object
dim WSHShell, oFileSys, oFolder, fh1, fh2, X
dim strDir, strVolumeName, strDestFolder
Const strTitleText = "VBS MP3 File Renamer"

strDir = BrowseForFolder("Choose a folder")
If IsNull(strDir) Then
	MsgBox "Invalid Folder Selection", vbOKOnly + vbInformation, strTitleText
Else
	' MsgBox "Press OK to process " & strDir, vbOKOnly + vbInformation, strTitleText
	' Create a filesystem object to be used throughout
	Set oFileSys = CreateObject("Scripting.FileSystemObject")
	' Get the path to the Desktop folder
	Set WSHShell = CreateObject("WScript.Shell")
	strDestFolder = WSHShell.SpecialFolders("Desktop")
	' Create output file
	If blnPlain Then
		' CSV is Comma Separated Values
		If oFileSys.FileExists(strDestFolder & "\DirListPlain.csv") Then
			Set fh1=oFileSys.openTextFile(strDestFolder & "\DirListPlain.csv")
		Else
			Set fh1=oFileSys.createTextFile(strDestFolder & "\DirListPlain.csv")
			fh1.WriteLine("SONGTITLE;ARTISTNAME;ALBUMTITLE;GENREINDEX;LENGTH;YEAR;PATH;SIZE;VOLUME;MODE;BITRATE;SAMPLERATE;MPEGVERSION;LAYER;COMMENT")
		End If
		fh1.close
		Set fh1=Nothing
	End If
	If blnIndex Then
		If oFileSys.FileExists(strDestFolder & "\DirListIndex.txt") Then
			Set fh1=oFileSys.openTextFile(strDestFolder & "\DirListIndex.txt")
		Else
			Set fh1=oFileSys.createTextFile(strDestFolder & "\DirListIndex.txt")
		End If
		fh1.close
		Set fh1=Nothing
	End If
	Set fh2=oFileSys.GetDrive(oFileSys.GetDriveName(strDir))
	strVolumeName = ConvertName(fh2.VolumeName)
	Set fh2=Nothing
	strVolumeName = GetString("Volume name:", "Confirm volume name", strVolumeName)
	'Run the conversion
	GetDir strDir
	MsgBox "Record indexing complete", vbOKOnly + vbInformation, strTitleText

End If

'************************************************************************
' End of program
'************************************************************************