|
slore
铂金会员
积分 5212
发帖 2478
注册 2007-2-8
状态 离线
|
『第
16 楼』:
dir /s/b d:\mp3\*.mp3 >d:\mp3.m3u没编号。。（不过P加一个也是可以）
|
|
 2007-2-17 06:44 |
|
|
ebfok
初级用户
积分 87
发帖 33
注册 2006-6-20
来自 cs
状态 离线
|
『第
17 楼』:
我来转一个老外写的
'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
'*********************************************************************************
|
|
|
2007-5-17 10:00 |
|
|
ebfok
初级用户
积分 87
发帖 33
注册 2006-6-20
来自 cs
状态 离线
|
『第
18 楼』:
再转一个：
'Mp3Playlister - singleList
'create ONE single m3u playlist for ALL mp3 files
'The generated playlist is saved in the scanned folder and uses absolute paths
'File Name : Mp3Playlister_singleList.vbs
'Requirement : mp3 files
'Author : la boost
'Submitted : 22/04/2002
'*********************************************************************************
'script : Mp3Playlister_singleList.vbs
'description: recursive m3u playlist generator :
' create ONE single playlist for ALL mp3 files
' found in the selected path, the generated playlist
' is saved in the scanned folder and uses absolute paths
'usage : create a shortcut to this file in the "SendTo" folder or drag-drop folder on it
'date : 13.04.2002
'version : 1.1
'author : la_boost@yahoo.com
'*********************************************************************************
'***********************************
'BEGIN
'***********************************
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"
'-- lowercase file extension to search for
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
'-- start scanning
Call startScanning()
'-- clean
Set fso = nothing
Set WshShell = nothing
'***********************************
'END
'***********************************
'***********************************
'FUNCTIONS:
'***********************************
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"
'-- recurse folder
Call DoIt(fold)
Else
WshShell.Popup "Folder """& pathToScan &""" does not exist. ", 5, sAppName, 48
Wscript.quit
End If
'-- save playlist if more than 0 entry in it
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)
'-- process all mp3 files in the fold folder
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 '-- global counter for processed files
End If
Next
End Sub
'*********************************************************************************
Sub createAndSavePlaylist(arrFiles, playlistPath)
Dim txt, txtFile
'-- create m3u file (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)
'-- 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
'*********************************************************************************
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
'*********************************************************************************
|
|
|
2007-5-17 10:01 |
|
|
