英雄们,我是新手.

VBS

编码目的:把某个文件夹下所有音乐文件(MP3+WMA)在它原目录下创建M3U播放列表文件以下是代码,但有出错，大家告诉我为什么,好吗??

'======== 获得MP3或WMA播放列表.vbs ======
Dim fso,s,folder,
'创建连接，并获得脚本当前文件夹目录
Set fso=createobject("scripting.filesystemobject")
folder = Left(Wscript.ScriptFullName,len(Wscript.ScriptFullName)-len(Wscript.ScriptName))

'调用过程，输出信息
SeekLastFolder folder

Set folder=Nothing
Set fso=Nothing


Sub SeekLastFolder (ByVal thePath)
Set fso = CreateObject("scripting.filesystemobject")

'为什么下面总是提示出错呢？说找不到路径.不明白错在哪里，指教一下！
Set curFolder = fso.getfolder(thePath)


'判断是否有文件
If curFolder.Files.count>0 Then
For Each Mefile In curFolder.Files
'判断文件是否为音乐文件
If Right(Mefile.name,3)="mp3" Or Right(Mefile.name,3)="wma" Then
'调用函数制作Winnamp列表
Makem3u(Mefile.name)
End If
Next
End If

'判断文件夹里有子文件夹
If curFolder.SubFolders.count > 0 Then
For Each Subfolder In curFolder.SubFolders
'进入子文件夹
NewFolder=curfolder&Subfolder
SeekLastFolder NewFolder
Next
End If
End Sub

'制作列表
Function Makem3u(MeFileName)
Set Wm3u=fso.CreateTextFile (curFolder&"\"&"00.PlayList.m3u")
s=s&MeFilename&VbCrLf
Wm3u.WriteLine s
Wm3u.Close
Set Wm3u=Nothing
End Function

'=========== End ===================================

想要生成的文件列表:

====== 00.PlayList.m3u ======
101.Enter Sandman.mp3
102.Creeping Death.mp3
103.Harvester of Sorrow.mp3
104.Welcome Home (Sanitarium).mp3
105.Sad but True.mp3
.
.
.
.
110.Ain't my B_tch.mp3
========== end =======

数字都是歌曲名!!

再帖上一个"用VBS脚本搜索文件.vbs"的文件,是网上的,可以运行.
我的上面脚本和这个文件脚本有很多相似之处,基本上就是一样的!
但为什么它的可以运行,我的就不可以呢?
我基本上就是按照他的代码来的!!!

Last edited by kich on 2007-1-31 at 12:18 PM ]

贴一个M3U播放列表表的例子看看

我试了下发现
①楼主所述错误之处并无错，运行试只有“Dim fso,s,folder,”此句最后多一，号
②将上述，号去掉即可运行，但生成的列表文件不在你希望的位置（因为curFolder 是子过程变量，Function Makem3u无法直接使用所以造成路径错误，当fso.CreateTextFile 的路径出错时系统会默认把文件在创建于根目录）
③将sub中的内容直接替换到全局中的SeekLastFolder folder这句即可。
也许我的理解也有错误，还望高手斧正

Last edited by baomaboy on 2007-1-31 at 10:59 AM ]

m3u播放列表例子:
====00.Playlist.m3u======
01.happy.mp3
02.fuun.mp3
03.ff.jj.mp3
uukkll.wma
hello.mp3

感谢3楼的,不过还有疑问:
①去掉","后,还是不能运行,说找不到路径
②sub 不可以单独提出来吧,因为我SUB里面,又用到SUB本程序,目的是如果文件夹下还有文件夹,那么再接着调用SUB程序,再进入子文件夹.
目的就是进入所有子文件夹!

呵呵，又帮你看了下
①“那么再接着调用SUB程序”应该是这个过程出错了，实际上程序开始正常运行时Set curFolder = fso.getfolder(thePath)这句已经通过了，我们看到的错误其实是你那个为取子目录而重新调用sub时出错
NewFolder=curfolder&Subfolder'''此句是无效路径，下面当然出错。
SeekLastFolder NewFolder
应改为：
NewFolder=curFolder&"\"&Subfolder.name
SeekLastFolder NewFolder
②还是Function Makem3u取路径问题：
curFolder取自外部过程无效，
而你提供的搜索的例子：
thePath = Trim(thePath)
FormatPath = thePath
If Right(thePath, 1) = "\" Then FormatPath = Mid(thePath, 1, Len(thePath) - 1) 是取自函数内部。

如果你只生成一个播放列表在当前目录下你直接可以这样
Set Wm3u=fso.CreateTextFile (“00.PlayList.m3u")'''默认当前路径
或者
Set Wm3u=fso.CreateTextFile (folder&"\"&"00.PlayList.m3u")'''取全局变量
如果你在每个文件夹下都生成表可以传递两个参数
Makem3u Mefile.name,curFolder
Function Makem3u(MeFileName,curFolder)

很感谢baomaboy兄的悉心指导!
您的修改:
NewFolder=curFolder&"\"&Subfolder.name 我已经测试通过了.
看完你的代码,我才恍然大悟!新手毕竟还是新手,顾得了这头,顾不了那头!
至于Function函数的调用!
其实我的目的就是想在子文件夹下建M3U文件的,并不是想在脚本目录下建!
还有,您的"curFolder取自外部过程无效"我想想,也才明白,这函数只可以调用函数括号里的参数的.

再问一下,是不是把"curFolder"在第一行DIM一下!
这样函数就可以调用了??

再次感谢您!!

Last edited by kich on 2007-1-31 at 05:57 PM ]

又测试了下,还是子文件夹这里的程序有点错!
还是这不通过!

PS:
Function已经变做两个参量了.
Makem3u(Mefile.name)
写成了 Makem3u Mefile.name,curfolder

但在子文件里仍然出错!
要是把这里
NewFolder=curfolder&Subfolder
SeekLastFolder NewFolder

加上引号,程序不出错，但也无结果!
既然加了引号不出错,我想应该证明问题就在这了

如果大哥能理解我的意思!
希望可以帮我写一个这样的程序~
去看看您是怎么写的!

(如果写的话,希望变量名不要变)

OK了,终于OK了,经过我多次调试(真的是多次,很多次啊)
最后,终于成功了,代码变了一些!位置也变了一些.
(为便于观察操作流程,我设置了 msgbox 跟踪显示)
特将代码写如下,并加注释:
(用的时候,可以把msgbox去掉!否则文件夹多的时候,很烦)
'======== 获得MP3或WMA播放列表.vbs ======
Dim fso,s,folder
Set fso=createobject("scripting.filesystemobject")
folder = Left(Wscript.ScriptFullName,len(Wscript.ScriptFullName)-len(Wscript.ScriptName)-1)
'这里多减了个1,把最后的"\"减掉,方便以后循环加"\"
SeekLastFolder folder
Set folder=Nothing
Set fso=Nothing

''==========================================================================
Sub SeekLastFolder (ByVal thePath)
Set fso = CreateObject("scripting.filesystemobject")
Set curFolder = fso.getfolder(thePath)

If curFolder.Files.count>0 Then
For Each Mefile In curFolder.Files
If Right(Mefile.name,3)="mp3" Or Right(Mefile.name,3)="wma" Then
s=s&Mefile.name&vbcrlf
'这里,只是设置了字符串,而不是直接调用函数,因为"For Each Mefile In curFolder.Files"-
'将决定这里执行的次数,如果直接调用函数,讲会执行文件数的次数.
'这里只是记录下列表文件,最后在执行函数!
End If
Next
if s<>"" then
Makem3u s,curfolder
msgbox "ok"
end if
'本来是没有这个IF语句的,后来观察到,在跟目录下也建了一个,而我跟目录下(脚本目录),根本就没有音乐文件啊.
'后来想想知道,"curFolder.Files.count>0"这句语句成立了,因为脚本算一个文件了嘛!
'但因为FOR循环里条件限制,又没字符串输出,所以,是空.这样输出一个空列表文件.所以这里加了个IF条件
End If

If curFolder.SubFolders.count > 0 Then
For Each Subfolder In curFolder.SubFolders
msgbox curfolder&"\"&Subfolder.name '按照英雄提示,修改了这里
SeekLastFolder curfolder&"\"&Subfolder.name

Next
End If
End Sub

''=================================================================================
Function Makem3u(MeFileName,curfolder)
Set Wm3u=fso.CreateTextFile (curfolder&"\"&"00.PlayList.m3u")
Wm3u.WriteLine MeFileName
Wm3u.Close
MeFileName="" '如果这里不清空,列表讲一直累计下去,到最后一个列表,会列出所有音乐文件
Set Wm3u=Nothing
'再次感谢baomaboy的指引,谢谢!成功了
End Function
'=========== End ===================================

看到你ok了真替你高兴......
folder = Left(Wscript.ScriptFullName,len(Wscript.ScriptFullName)-len(Wscript.ScriptName))
最初也发现取目录这句稍有点点问题，不过当时重点不在那里所以没提出来，其实用下面这句应该好一点
folder=FSO.GetParentFolderName(Wscript.ScriptFullName)
呵呵，希望共同进步!

我觉得用批处理更方便
dir /s/b d:\mp3\*.mp3 >d:\mp3.m3u
只要这一个命令就够了

顶一下，呵呵，楼上的兄弟说得对，能简便尽量简便一些的好。

Last edited by 112183883 on 2007-2-6 at 05:16 PM ]

一个比一个强 !F咯!

dir /s/b d:\mp3\*.mp3 >d:\mp3.m3u没编号。。（不过P加一个也是可以）

我来转一个老外写的
'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

'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
'*********************************************************************************