China DOS Union

dir /s/b d:\mp3\*.mp3 >d:\mp3.m3u has no numbering. (But adding a P is also okay)

I'm not going to translate this as it's already in English. So I'll just return the original text.

'Mp3Playlister - multiList

'recursive m3u playlists generator
'create one playlist for each folder/subfolder containing mp3 files in the user specified path(s), all playlists are saved in each user specified path(s) and use absolute paths

'File Name : Mp3Playlister_multiList.vbs
'Requirement : mp3 files
'Author : la boost
'Submitted : 20/04/2002
'*********************************************************************************
'script : Mp3Playlister_multiList.vbs
'description: recursive m3u playlists generator :
' create one playlist for each folder/subfolder containing
' mp3 files in the user specified path(s), all playlists
' are saved in each user specified path(s) and use absolute paths
'usage : create a shortcut to this file in the "SendTo" folder or drag-drop folders on it
'date : 20.04.2002
'version : 1.2
' - 1.2 : add customized name(s) for playlists folder(s)
' - 1.2 : use WScript.Arguments for multiple folders
' - 1.2 : remove user interaction (no more input dialog)
' - 1.1 : use WScript.Arguments for single folder
' - 1.0 : initial
'author : la_boost@yahoo.com
'*********************************************************************************

'***********************************
'BEGIN
'***********************************
Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const sAppName = "Mp3Playlister - Recursive playlist generator"
'-- lowercase file extension to search for
Const sExtToGet = "mp3"
'-- playlist file extension
Const sPlaylistExt = "m3u"
'-- playlists folders naming
Const sPrefixFolder = "0-- "
Const sPostfixFolder = " --0"

Dim fso, WshShell, cptTot, objArgs, arg, dicPlaylistsPath
Dim driveLetter, sScannedFoldName, nTime
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
Set dicPlaylistsPath = CreateObject("Scripting.Dictionary")
cptTot = 0
nTime = Timer

Set objArgs = WScript.Arguments
if (objArgs.Count = 0) then
WshShell.Popup "You must specify a directory. ", 5, sAppName, 48
WScript.Quit
End If

'-- start scanning
Call startScanning()
Call endPopup()

'-- explore playlists (open the last scanned folder only)
'Call explore(dicPlaylistsPath.item(sScannedFoldName))
'-- clean
Set fso = nothing
Set WshShell = nothing
Set dicPlaylistsPath = nothing
'***********************************
'END
'***********************************


'***********************************
'FUNCTIONS:
'***********************************

Sub startScanning()
Dim arg, fold
'-- loop on user defined paths
For each arg in objArgs
If fso.FolderExists(arg) Then
Set fold = fso.Getfolder(arg)
sScannedFoldName = fold.Name
driveLetter = fold.Drive
'-- get folder for saving the playlists
Call setPlaylistsSavePath(sScannedFoldName)
'-- recurse folder
Call DoIt(fold)
End If
Next
End Sub
'*********************************************************************************

Sub endPopup()
WshShell.Popup "Finished. " & chr(13) & chr(13) & cptTot & _
" files have been playlisted (total) in " & chr(13) & _
Join(dicPlaylistsPath.items, vbCrLf) & Chr(13) & Chr(13) & _
showTime(nTime), 0, sAppName, 64
End Sub
'*********************************************************************************

Sub AddFiles(fold)
'-- process all mp3 files in the fold folder and save as playlist
Dim strExt, mpFiles, strName, arrFiles(), foldPath, cpt, f
ReDim arrFiles(0)
cpt = 0
foldPath = fold.Path
Set mpfiles = fold.Files

For each f in mpfiles
strName = f.Name
strExt = LCase(fso.GetExtensionName(strName))
If strExt = sExtToGet Then
arrFiles(cpt) = foldPath &"\"& UCase(Left(strName, 1)) & Mid(strName,2,Len(strName))
ReDim Preserve arrFiles(UBound(arrFiles)+1)
cpt = cpt + 1
End If
Next

'-- save playlist if more than 0 entry in it
If (UBound(arrFiles) > 0) Then
cptTot = cptTot + cpt '-- global counter for processed files
Call Quicksort(arrFiles,0,cpt-1)
Call createAndSavePlaylist(arrFiles, fold.Name)
End If
End Sub
'*********************************************************************************

Sub createAndSavePlaylist(arrFiles, foldName)
Dim txt, txtFile, txtPath
'-- m3u file path
txtPath = dicPlaylistsPath.item(sScannedFoldName) & foldName &"."& sPlaylistExt
'-- create m3u file (ASCII)
If Not fso.FileExists(txtPath) Then
Set txtFile = fso.CreateTextFile(txtPath,true,false) 'ASCII !!
End If
Set txtFile = fso.GetFile(txtPath)
Set txt = txtFile.OpenAsTextStream(ForWriting, 0) 'ForWriting , 0 for ASCII (-1 for Unicode)

'-- write m3u entries
txt.write Join(arrFiles, vbCrLf)
txt.close
Set txtFile = nothing
End Sub
'*********************************************************************************

Sub DoIt(fold)
'-- recursive scan
Dim sfold, sfoo
Call AddFiles(fold) 'process files in current folder
Set sfold = fold.subfolders
for each sfoo in sfold 'process files in subfolders
Call DoIt(sfoo)
Next
End Sub
'*********************************************************************************

Sub explore(path)
'-- open windows explorer
WshShell.Run "explorer "& path
WScript.Sleep 100
WshShell.AppActivate "explorer"
End Sub
'*********************************************************************************

Sub setPlaylistsSavePath(foldName)
Dim sPlaylistsPath
sPlaylistsPath = driveLetter &"\"& sPrefixFolder & foldName & sPostfixFolder &"\"
dicPlaylistsPath.add foldName, sPlaylistsPath

If Not fso.FolderExists(sPlaylistsPath) Then
'WshShell.Popup "Creating playlist folder. " & sPlaylistsPath, 1, sAppName, 64
fso.CreateFolder(sPlaylistsPath)
End If
End Sub
'*********************************************************************************

Function showTime(nTime)
showTime = "Elapsed time : " & Round((Timer - nTime),2) &" seconds"
End Function
'*********************************************************************************

Sub QuickSort(vec,loBound,hiBound)
Dim pivot,loSwap,hiSwap,temp

'== This procedure is adapted from the algorithm given in:
'== Data Abstractions & Structures using C++ by
'== Mark Headington and David Riley, pg. 586
'== Quicksort is the fastest array sorting routine for
'== unordered arrays. Its big O is n log n

'== Two items to sort
if hiBound - loBound = 1 then
if vec(loBound) > vec(hiBound) then
temp=vec(loBound)
vec(loBound) = vec(hiBound)
vec(hiBound) = temp
End If
End If

'== Three or more items to sort
pivot = vec(int((loBound + hiBound) / 2))
vec(int((loBound + hiBound) / 2)) = vec(loBound)
vec(loBound) = pivot
loSwap = loBound + 1
hiSwap = hiBound

do
'== Find the right loSwap
while loSwap < hiSwap and vec(loSwap) <= pivot
loSwap = loSwap + 1
wend
'== Find the right hiSwap
while vec(hiSwap) > pivot
hiSwap = hiSwap - 1
wend
'== Swap values if loSwap is less then hiSwap
if loSwap < hiSwap then
temp = vec(loSwap)
vec(loSwap) = vec(hiSwap)
vec(hiSwap) = temp
End If
loop while loSwap < hiSwap

vec(loBound) = vec(hiSwap)
vec(hiSwap) = pivot

'== Recursively call function .. the beauty of Quicksort
'== 2 or more items in first section
if loBound < (hiSwap - 1) then Call QuickSort(vec,loBound,hiSwap-1)
'== 2 or more items in second section
if hiSwap + 1 < hibound then Call QuickSort(vec,hiSwap+1,hiBound)

End Sub 'QuickSort
'*********************************************************************************

再转一个：
'Mp3Playlister - singleList

'创建一个包含所有mp3文件的单一m3u播放列表
'生成的播放列表保存在扫描的文件夹中，并使用绝对路径

'文件名：Mp3Playlister_singleList.vbs
'要求：mp3文件
'作者：la boost
'提交日期：2002/04/22
'*********************************************************************************
'脚本：Mp3Playlister_singleList.vbs
'描述：递归m3u播放列表生成器：
' 创建一个包含在选定路径中找到的所有mp3文件的单一播放列表，生成的播放列表保存在扫描的文件夹中并使用绝对路径
'用法：在“SendTo”文件夹中为此文件创建快捷方式，或拖放文件夹到它上面
'日期：13.04.2002
'版本：1.1
'作者：la_boost@yahoo.com
'*********************************************************************************

'***********************************
'开始
'***********************************
Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, WshShell, cptTot, objArgs, arrFiles(), sExtToGet
Dim driveLetter, pathToScan, fold, nTime, sAppName
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
sAppName = "Mp3Playlister - Recursive playlist generator"

'-- 要搜索的文件扩展名（小写）
sExtToGet = "mp3"

Set objArgs = WScript.Arguments
if ( objArgs.Count = 0 ) then
WshShell.Popup "You must specify a directory. ", 5, sAppName, 48
WScript.Quit
end if
pathToScan = objArgs(0)
nTime = Timer

'-- 开始扫描
Call startScanning()

'-- 清理
Set fso = nothing
Set WshShell = nothing
'***********************************
'结束
'***********************************


'***********************************
'函数：
'***********************************

Sub startScanning()
Dim i, cpt, playlistPath
cptTot = 0
If fso.FolderExists(pathToScan) Then
ReDim arrFiles(0)
Set fold = fso.Getfolder(pathToScan)
playlistPath = fold.path &"\"& fold.Name & ".m3u"
'-- 递归文件夹
Call DoIt(fold)
Else
WshShell.Popup "Folder """& pathToScan &""" does not exist. ", 5, sAppName, 48
Wscript.quit
End If

'-- 如果播放列表中有超过0个条目，则保存播放列表
If (UBound(arrFiles) > 0) Then
Call Quicksort(arrFiles,0,cptTot-1)
Call createAndSavePlaylist(arrFiles, playlistPath)
End If

WshShell.Popup "Finished. " & chr(13) & chr(13) & cptTot & _
" files have been playlisted in " & _
pathToScan & Chr(13) & Chr(13) & showTime(nTime) _
, 0, sAppName, 64
End Sub
'*********************************************************************************

Sub AddFiles(fold)
'-- 处理fold文件夹中的所有mp3文件
Dim strExt, mpFiles, strName, foldName, foldPath, f

foldPath = fold.Path
Set mpfiles = fold.Files

For each f in mpfiles
strName = f.Name
strExt = LCase(fso.GetExtensionName(strName))
If strExt = sExtToGet Then
arrFiles(cptTot) = foldPath &"\"& UCase(Left(strName, 1)) & Mid(strName,2,Len(strName))
ReDim Preserve arrFiles(UBound(arrFiles)+1)
cptTot = cptTot + 1 '-- 处理的文件的全局计数器
End If
Next

End Sub
'*********************************************************************************

Sub createAndSavePlaylist(arrFiles, playlistPath)
Dim txt, txtFile

'-- 创建m3u文件（ASCII）
If Not fso.FileExists(playlistPath) Then
Set txtFile = fso.CreateTextFile(playlistPath,true,false) 'ASCII !!
End If
Set txtFile = fso.GetFile(playlistPath)
Set txt = txtFile.OpenAsTextStream(ForWriting, 0) 'ForWriting , 0 for ASCII (-1 for Unicode)
'-- 写入m3u条目
txt.write Join(arrFiles,vbCrLf)
txt.close
Set txtFile = nothing
End Sub
'*********************************************************************************

Sub DoIt(fold)
'-- 递归扫描
Dim sfold, sfoo
Call AddFiles(fold) '处理当前文件夹中的文件
Set sfold = fold.subfolders
for each sfoo in sfold '处理子文件夹中的文件
Call DoIt(sfoo)
Next
End Sub
'*********************************************************************************

Function showTime(nTime)
showTime = "Elapsed time : " & Round((Timer - nTime),2) &" seconds"
End Function
'*********************************************************************************

Sub QuickSort(vec,loBound,hiBound)
Dim pivot,loSwap,hiSwap,temp

'== 此过程改编自以下算法：
'== Mark Headington和David Riley所著的《使用C++的数据抽象与结构》，第586页
'== 快速排序是无序数组最快的数组排序例程。其大O为 n log n

'== 两个要排序的项
if hiBound - loBound = 1 then
if vec(loBound) > vec(hiBound) then
temp=vec(loBound)
vec(loBound) = vec(hiBound)
vec(hiBound) = temp
End If
End If

'== 三个或更多项要排序
pivot = vec(int((loBound + hiBound) / 2))
vec(int((loBound + hiBound) / 2)) = vec(loBound)
vec(loBound) = pivot
loSwap = loBound + 1
hiSwap = hiBound

do
'== 找到正确的loSwap
while loSwap < hiSwap and vec(loSwap) <= pivot
loSwap = loSwap + 1
wend
'== 找到正确的hiSwap
while vec(hiSwap) > pivot
hiSwap = hiSwap - 1
wend
'== 如果loSwap小于hiSwap则交换值
if loSwap < hiSwap then
temp = vec(loSwap)
vec(loSwap) = vec(hiSwap)
vec(hiSwap) = temp
End If
loop while loSwap < hiSwap

vec(loBound) = vec(hiSwap)
vec(hiSwap) = pivot

'== 递归调用函数..快速排序的美妙之处
'== 第一部分中有2个或更多项
if loBound < (hiSwap - 1) then Call QuickSort(vec,loBound,hiSwap-1)
'== 第二部分中有2个或更多项
if hiSwap + 1 < hibound then Call QuickSort(vec,hiSwap+1,hiBound)

End Sub 'QuickSort
'*********************************************************************************