Batch file 批处理文件以从目录中进行随机选择？_Batch File_Vbscript

Batch file 批处理文件以从目录中进行随机选择？

batch-file vbscript

Batch file 批处理文件以从目录中进行随机选择？,batch-file,vbscript,Batch File,Vbscript,我在电脑上使用人工智能，我有一个简单的命令，我说“给我放首快乐的歌”。我想做的是触发一个批处理文件，该文件将转到一个文件中，我有各种各样的快乐歌曲我对批处理没有太多的了解，尤其是在随机操作方面。我只是想要它，所以它会随机选择从文件中的歌曲。作为.vbs，这会更好吗？除了如何制作文件，我对这些一无所知。如果这是一批，你能帮助我，如果你能解释一点给我，我将不胜感激，希望我能自己做更多保存MP3的文件是C:\Users\ptldk\Documents\Batch\Batch Support\Ran

我在电脑上使用人工智能，我有一个简单的命令，我说“给我放首快乐的歌”。我想做的是触发一个批处理文件，该文件将转到一个文件中，我有各种各样的快乐歌曲

我对批处理没有太多的了解，尤其是在随机操作方面。我只是想要它，所以它会随机选择从文件中的歌曲。作为.vbs，这会更好吗？除了如何制作文件，我对这些一无所知。如果这是一批，你能帮助我，如果你能解释一点给我，我将不胜感激，希望我能自己做更多

保存MP3的文件是C:\Users\ptldk\Documents\Batch\Batch Support\Random Happy Music Playlist

谢谢

< p>如果你想通过文件夹和文件，考虑使用<>代码> Road和<代码> FixFixs/Cuff>命令。您需要做的是：

1）在

音乐路径中循环

并仅搜索扩展名为

.mp3

的文件。

2）创建一个数组（即使批处理没有这个功能，但我们可以手动创建），并用文件名分配它

%%~nxa

删除引号并在文件名末尾添加扩展名。

3）由于

%random%%

返回的值介于0-32767之间，我们不需要这么大的值，

%random%%%value（例如：10）

将返回介于0-9之间的值。这很好，因为我们正在使用数组，值0将是数组的第一个元素（这是第一个mp3文件），0是随机范围的一部分

4）

启动带有默认程序（VLC、WMPlayer等）的mp3文件，Windows将在必要时请求默认程序。

@echo off
Setlocal EnableDelayedExpansion

set "Music_PATH=C:\Users\ptldk\Documents\Batch\Batch Support\Random Happy Music Playlist"
set counter=0

for /f "tokens=*" %%a in ('forfiles /p "%Music_PATH%" /m *mp3') do (
    set Rand_PATH[!counter!]=%%~nxa
    set /a counter+=1
)

set /a Random_Music=%random% %% %counter%
set "Full_PATH=%Music_PATH%\!Rand_PATH[%Random_Music%]!"

echo Random Music & echo. & echo !Rand_PATH[%Random_Music%]!
start "" "%Full_PATH%"

pause >nul

您可以尝试使用此vbscript
'***********************************Description*************************************
'This Vbscript scan into a folder and its subfolders for songs like .mp3 .mp4 .wav .....
'And create a playlist in a text file in order to play it in the background.
'© Hackoo © 2015
'***********************************************************************************
Option Explicit
If AppPrevInstance() Then 
    MsgBox "There is an existing proceeding !" & VbCrLF &_
    CommandLineLike(WScript.ScriptName),VbExclamation,"There is an existing proceeding !"    
    WScript.Quit   
Else 
    Dim Folder,File,fso,MyPlayList,Temp,oExec,ws,Title,WaitingMsg
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ws = CreateObject("WScript.Shell")
    Temp = ws.ExpandEnvironmentStrings("%Temp%")
    Folder = Browse4Folder()
    MyPlayList = Folder & "\MyPlayList.txt"
    If fso.FileExists(MyPlayList) Then
        fso.DeleteFile(MyPlayList)
    End If
    Title = "Looking for songs in "& DblQuote(Folder) & " using Vbscript © Hackoo 2015"
    WaitingMsg = "Please wait... Searching for songs into : <font color=Yellow>"& DblQuote(Folder) & "</font> is in progress..."
    Call CreateProgressBar(Title,WaitingMsg)'Creation of Waiting Bar
    Call LancerProgressBar() 'Launch of the Waiting Bar
    Call Pause(10)
    Call Scan4Songs(Folder)
    Call FermerProgressBar()
    Call Play(MyPlayList)
End If
'*********************************************************
Sub Play(File)
    On Error Resume Next
    Dim Sound,Xwmp
    Dim fso,F,ReadME,PlayList,i,Ws,Copyright,Name,Duration
    Copyright = " © Hackoo © 2015"
    Set Ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set F = fso.OpenTextFile(File,1)
    If Err <> 0 Then
        Ws.popup Err.Description & VbCrlF &_
        "No media file found !","3",Err.Description & Copyright,VbCritical
        wscript.quit()
    End If
    ReadMe = F.ReadAll
    PlayList = split(ReadMe,vbcrlf)
    Set Sound = CreateObject("WMPlayer.OCX")
    Sound.settings.volume = 100
    Sound.currentPlaylist.Clear
    For i = Lbound(PlayList) to Ubound(PlayList)
        Set Xwmp = Sound.newMedia(PlayList(i))
        Sound.currentPlaylist.insertItem(i),Xwmp
        Sound.Controls.Play()   
        Do while Sound.currentmedia.duration = 0
            wscript.sleep 100
        Loop
        wscript.sleep(int(Sound.currentmedia.duration)+1)*1000
    Next    
End Sub
'*********************************************************************************************
Function AppPrevInstance()   
    With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")   
        With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
            " AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")   
            AppPrevInstance = (.Count > 1)   
        End With   
    End With   
End Function    
'*********************************************************************************************
Function CommandLineLike(ProcessPath)   
    ProcessPath = Replace(ProcessPath, "\", "\\")   
    CommandLineLike = "'%" & ProcessPath & "%'"   
End Function
'*********************************************************************************************
Function Browse4Folder()
    Dim objShell,objFolder,Message
    Message = "Please select a folder in order to scan into it and its subfolders for songs"
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0,Message,1,"c:\Programs")
    If objFolder Is Nothing Then
        Wscript.Quit
    End If
    Browse4Folder = objFolder.self.path
end Function
'*********************************************************************************************
Function Scan4Songs(Folder)
    Dim File,Ext,i,SubFolder
    Set Folder = fso.GetFolder(Folder)
    For each File in Folder.Files
        Ext = Array("mp4","mp3","wav","ogg","asf","aa3","m3v","midi")
        For i = LBound(Ext) To UBound(Ext)
            If LCase(fso.GetExtensionName(File.name)) = LCase(Ext(i)) Then 
                Call MakePlayListFile(MyPlayList,File.Path)
            end if
        Next
    Next
    For each SubFolder in Folder.SubFolders
        Call Scan4Songs(SubFolder.Path)
    Next
End Function
'*********************************************************************************************
Sub MakePlayListFile(MyPlayList,strContents)
    Dim fso,ts
    Const ForAppending= 8
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpenTextFile(MyPlayList,ForAppending,True)
    ts.WriteLine strContents
    ts.Close
End Sub
'**********************************************************************************************
Sub CreateProgressBar(Title,WaitingMsg)
    Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
    Set ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Temp = WS.ExpandEnvironmentStrings("%Temp%")
    PathOutPutHTML = Temp & "\Barre.hta"
    Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
    fhta.WriteLine "<HTML>"
    fhta.WriteLine "<HEAD>"
    fhta.WriteLine "<Title>  " & Title & "</Title>"
    fhta.WriteLine "<HTA:APPLICATION"
    fhta.WriteLine "ICON = ""magnify.exe"" "
    fhta.WriteLine "BORDER=""THIN"" "
    fhta.WriteLine "INNERBORDER=""NO"" "
    fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
    fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
    fhta.WriteLine "SCROLL=""NO"" "
    fhta.WriteLine "SYSMENU=""NO"" "
    fhta.WriteLine "SELECTION=""NO"" "
    fhta.WriteLine "SINGLEINSTANCE=""YES"">"
    fhta.WriteLine "</HEAD>"
    fhta.WriteLine "<BODY text=""white""><CENTER>"
    fhta.WriteLine "<marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & WaitingMsg &"</font></marquee>"
    fhta.WriteLine "<img src=""data:image/gif;base64,R0lGODlhgAAPAPIAAP////INPvvI0/q1xPVLb/INPgAAAAAAACH/C05FVFNDQVBFMi4wAwEAAAAh/hpDcmVhdGVkIHdpdGggYWpheGxvYWQuaW5mbwAh+QQJCgAAACwAAAAAgAAPAAAD5wiyC/6sPRfFpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwDkJEDE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/4ixgeloM5erDHonOWBFFlJoxiiTFtqWwa/Jhx/86nKdc7vuJ6mxaABbUaUTvljBo++pxO5nFQFxMY1aW12pV+q9yYGk6NlW5bAPQuh7yl6Hg/TLeu2fssf7/19Zn9meYFpd3J1bnCMiY0RhYCSgoaIdoqDhxoFnJ0FFAOhogOgo6GlpqijqqKspw+mrw6xpLCxrrWzsZ6duL62qcCrwq3EsgC0v7rBy8PNorycysi3xrnUzNjO2sXPx8nW07TRn+Hm3tfg6OLV6+fc37vR7Nnq8Ont9/Tb9v3yvPu66Xvnr16+gvwO3gKIIdszDw65Qdz2sCFFiRYFVmQFIAEBACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9J2qd1AoM9MYeF4KaWJKWmaJXxEyulI3zWa/39Xh6/vkT3q/DC/JiBFjMSCM2hUybUwrdFa3Pqw+pdEVxU3AViKVqwz30cKzmQpZl8ZlNn9uzeLPH7eCrv2l1eXKDgXd6Gn5+goiEjYaFa4eOFopwZJh/cZCPkpGAnhoFo6QFE6WkEwOrrAOqrauvsLKttKy2sQ+wuQ67rrq7uAOoo6fEwsjAs8q1zLfOvAC+yb3B0MPHD8Sm19TS1tXL4c3jz+XR093X28ao3unnv/Hv4N/i9uT45vqr7NrZ89QFHMhPXkF69+AV9OeA4UGBDwkqnFiPYsJg7jBktMXhD165jvk+YvCoD+Q+kRwTAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJdCLnC/S+nsCFo1dq5zeRoFlJ1Du91hOq3b3qNo/5OdZPGDT1QrSZDLIcGp2o47MYheJuImmVer0lmRVlWNslYndm4Jmctba5gm9sPI+gp2v3fZuH78t4Xk0Kg3J+bH9vfYtqjWlIhZF0h3qIlpWYlJpYhp2DjI+BoXyOoqYaBamqBROrqq2urA8DtLUDE7a1uLm3s7y7ucC2wrq+wca2sbIOyrCuxLTQvQ680wDV0tnIxdS/27TND+HMsdrdx+fD39bY6+bX3um14wD09O3y0e77+ezx8OgAqutnr5w4g/3e4RPIjaG+hPwc+stV8NlBixAzSlT4bxqhx46/MF5MxUGkPA4BT15IyRDlwG0uG55MAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPECwbnu3gUKH1h2ZziNKVlJWDW9FvSuI/nkusPjrF0OaBIGfTna7GaTNTPGIvK4GUZRV1WV+ssKlE/G0hmDTqVbdPeMZWvX6XacAy6LwzAF092b9+GAVnxEcjx1emSIZop3g16Eb4J+kH+ShnuMeYeHgVyWn56hakmYm6WYnaOihaCqrh0FsbIFE7Oytba0D7m6DgO/wAMTwcDDxMIPx8i+x8bEzsHQwLy4ttWz17fJzdvP3dHfxeG/0uTjywDK1Lu52bHuvenczN704Pbi+Ob66MrlA+scBAQwcKC/c/8SIlzI71/BduysRcTGUF49i/cw5tO4jytjv3keH0oUCJHkSI8KG1Y8qLIlypMm312ASZCiNA0X8eHMqPNCTo07iyUAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8hffaB3ZiWJKfmaJgJWHV5FqQK9uPuDr6yPeTniAIzBV/utktVmPCOE8GUTc9Ia0AYXWXPXaTuOhr4yRDzVIjVY3VsrnuK7ynbJ7rYlp+6/u2vXF+c2tyHnhoY4eKYYJ9gY+AkYSNAotllneMkJObf5ySIphpe3ajiHqUfENvjqCDniIFsrMFE7Sztre1D7q7Dr0TA8LDA8HEwsbHycTLw83ID8fCwLy6ubfXtNm40dLPxd3K4czjzuXQDtID1L/W1djv2vHc6d7n4PXi+eT75v3oANSxAzCwoLt28P7hC2hP4beH974ZTEjwYEWKA9VBdBixLSNHhRPlIRR5kWTGhgz1peS30l9LgBojUhzpa56GmSVr9tOgcueFni15styZAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKsWIPiFwhia4kWWKrl5UGXFMFa/nJ0Da+r0rF9vAiQOH0DZTMeYKJ0y6O2JPApXRmxVe3VtSVSmRLzENWm7MM+65ra93dNXHgep71H0mSzdFec+b3SCgX91AnhTeXx6Y2aOhoRBkllwlICIi49liWmaapGhbKJuSZ+niqmeN6SWrYOvIAWztAUTtbS3uLYPu7wOvrq4EwPFxgPEx8XJyszHzsbQxcG9u8K117nVw9vYD8rL3+DSyOLN5s/oxtTA1t3a7dzx3vPwAODlDvjk/Orh+uDYARBI0F29WdkQ+st3b9zCfgDPRTxWUN5AgxctVqTXUDNix3QToz0cGXIaxo32UCo8+OujyJIM95F0+Y8mMov1NODMuPKdTo4hNXgMemGoS6HPEgAAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9pcgitpIhmaZouMGYq/LwbPMTJVE34/Z9j7BJCgE+obBnAWSwzWZMaUz+nQQkUfjyhrEmqTQGnins5XH5iU3u94Crtpfe4SuV9NT8R0Nn5/8RYBedHuFVId6iDyCcX9vXY2Bjz52imeGiZmLk259nHKfjkSVmpeWanhhm56skIyABbGyBROzsrW2tA+5ug68uLbAsxMDxcYDxMfFycrMx87Gv7u5wrfTwdfD2da+1A/Ky9/g0OEO4MjiytLd2Oza7twA6/Le8LHk6Obj6c/8xvjzAtaj147gO4Px5p3Dx9BfOQDnBBaUeJBiwoELHeaDuE8uXzONFu9tE2mvF0KSJ00q7Mjxo8d+L/9pRKihILyaB29esEnzgkt/Gn7GDPosAQAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTcJJKmV5oUKJ7qBGPyKMzNVUkzjFoSPK9YjKHQQgSve7eeTKZs7ps4GpRqDSNcQu01Kazlwbxp+ksfipezY1V5X2ZI5XS1/5/j7l/12A/h/QXlOeoSGUYdWgXBtJXEpfXKFiJSKg5V2a1yRkIt+RJeWk6KJmZhogKmbniUFrq8FE7CvsrOxD7a3Drm1s72wv7QPA8TFAxPGxcjJx8PMvLi2wa7TugDQu9LRvtvAzsnL4N/G4cbY19rZ3Ore7MLu1N3v6OsAzM0O9+XK48Xn/+notRM4D2C9c/r6Edu3UOEAgwMhFgwoMR48awnzMWOIzyfeM4ogD4aMOHJivYwexWlUmZJcPXcaXhKMORDmBZkyWa5suE8DuAQAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9h03gZNgmtqJXqqwka8YM2NlQXYN2ze254/WyiF0BYU8nSyJ+zmXQB8UViwJrS2mlNacerlbSbg3E5fJ1WMLq9KeleB3N+6uR+XEq1rFPtmfdHd/X2aDcWl5a3t+go2AhY6EZIZmiACWRZSTkYGPm55wlXqJfIsmBaipBROqqaytqw+wsQ6zr623qrmusrATA8DBA7/CwMTFtr24yrrMvLW+zqi709K0AMkOxcYP28Pd29nY0dDL5c3nz+Pm6+jt6uLex8LzweL35O/V6fv61/js4m2rx01buHwA3SWEh7BhwHzywBUjOGBhP4v/HCrUyJAbXUSDEyXSY5dOA8l3Jt2VvHCypUoAIetpmJgAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8q/YdN4Gj+AgoqqVqJWHkFrsW5Jbzbee8yaaTH4qGMxF3Rh0s2WMUnUioQygICo9LqYzJ1WK3XiX4Na5Nhdbfdy1mN8nuLlxMTbPi4be5/Jzr+3tfdSdXbYZ/UX5ygYeLdkCEao15jomMiFmKlFqDZz8FoKEFE6KhpKWjD6ipDqunpa+isaaqqLOgEwO6uwO5vLqutbDCssS0rbbGuMqsAMHIw9DFDr+6vr/PzsnSx9rR3tPg3dnk2+LL1NXXvOXf7eHv4+bx6OfN1b0P+PTN/Lf98wK6ExgO37pd/pj9W6iwIbd6CdP9OmjtGzcNFsVhDHfxDELGjxw1Xpg4kheABAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTeBowiZjqCqG9malYS5sXXScYnvcP6swJqux2MMjTeiEjlbyl5MAHAlTEarzasv+8RCu9uvjTuWTgXedFhdBLfLbGf5jF7b30e3PA+/739ncVp4VnqDf2R8ioBTgoaPfYSJhZGIYhN0BZqbBROcm56fnQ+iow6loZ+pnKugpKKtmrGmAAO2twOor6q7rL2up7C/ssO0usG8yL7KwLW4tscA0dPCzMTWxtXS2tTJ297P0Nzj3t3L3+fmzerX6M3hueTp8uv07ezZ5fa08Piz/8UAYhPo7t6+CfDcafDGbOG5hhcYKoz4cGIrh80cPAOQAAAh+QQJCgAAACwAAAAAgAAPAAAD5wi0C/6sPRfJpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwFkJEFE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAA7AAAAAAAAAAAA"" />"
    fhta.WriteLine "</CENTER></BODY></HTML>"
    fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
    fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
    fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
    fhta.WriteLine "Sub window_onload()"
    fhta.WriteLine "    CenterWindow 500,100"
    fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
    fhta.WriteLine " End Sub"
    fhta.WriteLine " Sub CenterWindow(x,y)"
    fhta.WriteLine "    Dim iLeft,itop"
    fhta.WriteLine "    window.resizeTo x,y"
    fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
    fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
    fhta.WriteLine "    window.moveTo ileft,itop"
    fhta.WriteLine "End Sub"
    fhta.WriteLine "</script>"
    fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
    Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
    oExec.Terminate
End Sub
'**********************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub Pause(Secs)    
    Wscript.Sleep(Secs * 1000)    
End Sub   
'**********************************************************************************************

”*********************************************说明*************************************
'此Vbscript扫描到一个文件夹及其子文件夹中，以查找歌曲，如.mp3.mp4.wav。。。。。
'并在文本文件中创建播放列表，以便在后台播放。
©Hackoo©2015
'***********************************************************************************
选项显式
如果是AppPrevInstance（），则
MsgBox“存在现有进程！”&VbCrLF&_
CommandLineLike（WScript.ScriptName），VBEquipment，“存在一个现有进程！”
WScript.Quit
其他的
Dim文件夹、文件、fso、MyPlayList、Temp、oExec、ws、标题、WaitingMsg
设置fso=CreateObject（“Scripting.FileSystemObject”）
设置ws=CreateObject（“WScript.Shell”）
Temp=ws.ExpandEnvironmentStrings（“%Temp%”）
Folder=Browse4Folder（）
MyPlayList=文件夹&“\MyPlayList.txt”
如果存在fso.files（MyPlayList），则
删除文件（MyPlayList）
如果结束
Title=“在”&DblQuote（文件夹）和“使用Vbscript©Hackoo 2015”中查找歌曲”
WaitingMsg=“请稍候…正在搜索歌曲到：”&DblQuote（文件夹）&“正在进行…”
调用CreateProgressBar（标题，WaitingMsg）创建等待栏
调用LancerProgressBar（）'启动等待栏
呼叫暂停（10）
调用Scan4Songs（文件夹）
调用FermerProgressBar（）
呼叫播放（我的播放列表）
如果结束
'*********************************************************
子播放（文件）
出错时继续下一步
微弱的声音，Xwmp
Dim fso、F、自述、播放列表、i、Ws、版权、名称、持续时间
版权所有=“©Hackoo©2015”
设置Ws=CreateObject（“wscript.Shell”）
设置fso=CreateObject（“Scripting.FileSystemObject”）
Set F=fso.OpenTextFile（文件，1）
如果错误为0，则
Ws.popup错误描述和VbCrlF&_
“找不到媒体文件！”，“3”，错误描述和版权，VbCritical
wscript.quit（）
如果结束
自述文件=F.ReadAll
播放列表=拆分（自述，vbcrlf）
设置声音=CreateObject（“WMPlayer.OCX”）
Sound.settings.volume=100
Sound.currentPlaylist.Clear
对于i=Lbound（播放列表）到Ubound（播放列表）
设置Xwmp=Sound.newMedia（播放列表（i））
Sound.currentPlaylist.insertItem（i），Xwmp
Sound.Controls.Play（）
当Sound.currentmedia.duration=0时执行此操作
wscript.sleep 100
环
wscript.sleep（int（Sound.currentmedia.duration）+1）*1000
下一个
端接头
'*********************************************************************************************
函数AppPrevInstance（）
使用GetObject（“winmgmts:&”{impersonationLevel=impersonate}！\\.\root\cimv2”）
使用.ExecQuery（“从Win32_进程中选择*，其中类似命令行”&类似命令行（WScript.ScriptFullName）&_
“和类似于“%WScript%”的命令行或类似于“%cscript%”的命令行”
AppPrevInstance=（.Count>1）
以
以
端函数
'*********************************************************************************************
函数CommandLineLike（ProcessPath）
ProcessPath=Replace（ProcessPath，“\”，“\\”）
CommandLineLike=“%”进程路径（&ProcessPath&“%”
端函数
'*********************************************************************************************
函数Browse4Folder（）
Dim objShell、objFolder、消息
Message=“请选择一个文件夹，以便在其中及其子文件夹中扫描歌曲”
设置objShell=CreateObject（“Shell.Application”）
设置objFolder=objShell.BrowseForFolder（0，消息，1，“c:\Programs”）
如果objFolder为空，则
Wscript.Quit
如果结束
Browse4Folder=objFolder.self.path
端函数
'*********************************************************************************************
函数Scan4Songs（文件夹）
Dim文件、Ext、i、子文件夹
Set Folder=fso.GetFolder（文件夹）
对于文件夹.Files中的每个文件
Ext=阵列（“mp4”、“mp3”、“wav”、“ogg”、“asf”、“aa3”、“m3v”、“midi”）
对于i=LBound（Ext）到UBound（Ext）
如果LCase（fso.GetExtensionName（File.name））=LCase（Ext（i）），那么
'***********************************Description*************************************
'This Vbscript scan into a folder and its subfolders for songs like .mp3 .mp4 .wav .....
'And create a playlist in a text file in order to play it in the background.
'© Hackoo © 2015
' updated fx 2016
'***********************************************************************************
Option Explicit
If AppPrevInstance() Then 
    MsgBox "There is an existing proceeding !" & VbCrLF &_
    CommandLineLike(WScript.ScriptName),VbExclamation,"There is an existing proceeding !"    
    WScript.Quit   
Else 
Dim Folder,File,fso,MyPlayList,Temp,oExec,ws,Title,WaitingMsg
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
Folder = Browse4Folder()
MyPlayList = Folder & "\_MyPlayList.txt"
If fso.FileExists(MyPlayList) Then
    fso.DeleteFile(MyPlayList)
End If
Title = "Looking for songs in "& DblQuote(Folder) & " using Vbscript © Hackoo 2015"
WaitingMsg = "Please wait... Searching for songs into : <font color=Yellow>"& DblQuote(Folder) & "</font> is in progress..."
Call CreateProgressBar(Title,WaitingMsg)'Creation of Waiting Bar
Call LancerProgressBar() 'Launch of the Waiting Bar
Call Pause(10)
Call Scan4Songs(Folder)
Call FermerProgressBar()
Call Play(MyPlayList)
End If
'*********************************************************
Sub Play(File)
On Error Resume Next
Dim Sound,Xwmp
Dim fso,F,ReadME,PlayList,i,Ws,Copyright,Name,Duration
Copyright = " © Hackoo © 2015"
Set Ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set F = fso.OpenTextFile(File,1)
If Err <> 0 Then
    Ws.popup Err.Description & VbCrlF &_
    "No media file found !","3",Err.Description & Copyright,VbCritical
    wscript.quit()
End If
ReadMe = F.ReadAll
PlayList = split(ReadMe,vbcrlf)
Set Sound = CreateObject("WMPlayer.OCX")
Sound.settings.volume = 100
Sound.currentPlaylist.Clear
For i = Lbound(PlayList) to Ubound(PlayList)
    Set Xwmp = Sound.newMedia(PlayList(i))
    Sound.currentPlaylist.insertItem(i),Xwmp
    Sound.Controls.Play()   
    Do while Sound.currentmedia.duration = 0
        wscript.sleep 100
    Loop
    wscript.sleep(int(Sound.currentmedia.duration)+1)*1000
Next    
End Sub
'*********************************************************************************************
Function AppPrevInstance()   
With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")   
    With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
        " AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")   
        AppPrevInstance = (.Count > 1)   
    End With   
End With   
End Function    
'*********************************************************************************************
Function CommandLineLike(ProcessPath)   
ProcessPath = Replace(ProcessPath, "\", "\\")   
CommandLineLike = "'%" & ProcessPath & "%'"   
End Function
'*********************************************************************************************
Function Browse4Folder()
Dim objShell,objFolder,Message
Message = "Please select a folder in order to scan into it and its subfolders for songs"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0,Message,1,"c:\Programs")
If objFolder Is Nothing Then
    Wscript.Quit
End If
Browse4Folder = objFolder.self.path
end Function
'*********************************************************************************************
Function Scan4Songs(Folder)
Dim File,Ext,i,SubFolder
Dim listArr(),RandArr()
Dim j,n,boo

j=0
Set Folder = fso.GetFolder(Folder)
For each File in Folder.Files
    Ext = Array("mp4","mp3","wav","ogg","asf","aa3","m3v","midi")
    For i = LBound(Ext) To UBound(Ext)
        If LCase(fso.GetExtensionName(File.name)) = LCase(Ext(i)) Then 
            ''Call MakePlayListFile(MyPlayList,File.Path)
            ''Call MakePlayListFile(MyPlayList,File.Name) 
            if j=0 then 
               redim listArr(1)
            else
               redim PRESERVE listArr(j+1)
            end if  
            ListArr(j)=File.Path
            j=j+1 
        end if
    Next
Next
if j > 0 then 
   Redim RandArr(ubound(listArr)) 
   for i=lbound(listArr) to ubound(listArr)
       Randomize
       n = int(Rnd * ubound(listArr))
       boo =false
       while not boo
          if IsEmpty(RandArr(n)) then 
             RandArr(n)=ListArr(i)
             boo=true  
          else
             n=n+1
             if n=ubound(listArr)+1 then 
                n=0
             end if 
          end if
       wend
   next
   for i=lbound(RandArr) to ubound(RandArr)
       if not IsEmpty(RandArr(i)) then 
          Call MakePlayListFile(MyPlayList,RandArr(i)) 
       end if
   next
end if 

For each SubFolder in Folder.SubFolders
    Call Scan4Songs(SubFolder.Path)
Next
End Function
    '*********************************************************************************************
Sub MakePlayListFile(MyPlayList,strContents)
Dim fso,ts
Const ForAppending= 8
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(MyPlayList,ForAppending,True)
ts.WriteLine strContents
ts.Close
End Sub
'**********************************************************************************************
Sub CreateProgressBar(Title,WaitingMsg)
Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Temp = WS.ExpandEnvironmentStrings("%Temp%")
PathOutPutHTML = Temp & "\Barre.hta"
Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
fhta.WriteLine "<HTML>"
fhta.WriteLine "<HEAD>"
fhta.WriteLine "<Title>  " & Title & "</Title>"
fhta.WriteLine "<HTA:APPLICATION"
fhta.WriteLine "ICON = ""magnify.exe"" "
fhta.WriteLine "BORDER=""THIN"" "
fhta.WriteLine "INNERBORDER=""NO"" "
fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
fhta.WriteLine "SCROLL=""NO"" "
fhta.WriteLine "SYSMENU=""NO"" "
fhta.WriteLine "SELECTION=""NO"" "
fhta.WriteLine "SINGLEINSTANCE=""YES"">"
fhta.WriteLine "</HEAD>"
fhta.WriteLine "<BODY text=""white""><CENTER>"
fhta.WriteLine "<marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & WaitingMsg &"</font></marquee>"
fhta.WriteLine "<img src=""data:image/gif;base64,R0lGODlhgAAPAPIAAP////INPvvI0/q1xPVLb/INPgAAAAAAACH/C05FVFNDQVBFMi4wAwEAAAAh/hpDcmVhdGVkIHdpdGggYWpheGxvYWQuaW5mbwAh+QQJCgAAACwAAAAAgAAPAAAD5wiyC/6sPRfFpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwDkJEDE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/4ixgeloM5erDHonOWBFFlJoxiiTFtqWwa/Jhx/86nKdc7vuJ6mxaABbUaUTvljBo++pxO5nFQFxMY1aW12pV+q9yYGk6NlW5bAPQuh7yl6Hg/TLeu2fssf7/19Zn9meYFpd3J1bnCMiY0RhYCSgoaIdoqDhxoFnJ0FFAOhogOgo6GlpqijqqKspw+mrw6xpLCxrrWzsZ6duL62qcCrwq3EsgC0v7rBy8PNorycysi3xrnUzNjO2sXPx8nW07TRn+Hm3tfg6OLV6+fc37vR7Nnq8Ont9/Tb9v3yvPu66Xvnr16+gvwO3gKIIdszDw65Qdz2sCFFiRYFVmQFIAEBACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9J2qd1AoM9MYeF4KaWJKWmaJXxEyulI3zWa/39Xh6/vkT3q/DC/JiBFjMSCM2hUybUwrdFa3Pqw+pdEVxU3AViKVqwz30cKzmQpZl8ZlNn9uzeLPH7eCrv2l1eXKDgXd6Gn5+goiEjYaFa4eOFopwZJh/cZCPkpGAnhoFo6QFE6WkEwOrrAOqrauvsLKttKy2sQ+wuQ67rrq7uAOoo6fEwsjAs8q1zLfOvAC+yb3B0MPHD8Sm19TS1tXL4c3jz+XR093X28ao3unnv/Hv4N/i9uT45vqr7NrZ89QFHMhPXkF69+AV9OeA4UGBDwkqnFiPYsJg7jBktMXhD165jvk+YvCoD+Q+kRwTAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJdCLnC/S+nsCFo1dq5zeRoFlJ1Du91hOq3b3qNo/5OdZPGDT1QrSZDLIcGp2o47MYheJuImmVer0lmRVlWNslYndm4Jmctba5gm9sPI+gp2v3fZuH78t4Xk0Kg3J+bH9vfYtqjWlIhZF0h3qIlpWYlJpYhp2DjI+BoXyOoqYaBamqBROrqq2urA8DtLUDE7a1uLm3s7y7ucC2wrq+wca2sbIOyrCuxLTQvQ680wDV0tnIxdS/27TND+HMsdrdx+fD39bY6+bX3um14wD09O3y0e77+ezx8OgAqutnr5w4g/3e4RPIjaG+hPwc+stV8NlBixAzSlT4bxqhx46/MF5MxUGkPA4BT15IyRDlwG0uG55MAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPECwbnu3gUKH1h2ZziNKVlJWDW9FvSuI/nkusPjrF0OaBIGfTna7GaTNTPGIvK4GUZRV1WV+ssKlE/G0hmDTqVbdPeMZWvX6XacAy6LwzAF092b9+GAVnxEcjx1emSIZop3g16Eb4J+kH+ShnuMeYeHgVyWn56hakmYm6WYnaOihaCqrh0FsbIFE7Oytba0D7m6DgO/wAMTwcDDxMIPx8i+x8bEzsHQwLy4ttWz17fJzdvP3dHfxeG/0uTjywDK1Lu52bHuvenczN704Pbi+Ob66MrlA+scBAQwcKC/c/8SIlzI71/BduysRcTGUF49i/cw5tO4jytjv3keH0oUCJHkSI8KG1Y8qLIlypMm312ASZCiNA0X8eHMqPNCTo07iyUAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8hffaB3ZiWJKfmaJgJWHV5FqQK9uPuDr6yPeTniAIzBV/utktVmPCOE8GUTc9Ia0AYXWXPXaTuOhr4yRDzVIjVY3VsrnuK7ynbJ7rYlp+6/u2vXF+c2tyHnhoY4eKYYJ9gY+AkYSNAotllneMkJObf5ySIphpe3ajiHqUfENvjqCDniIFsrMFE7Sztre1D7q7Dr0TA8LDA8HEwsbHycTLw83ID8fCwLy6ubfXtNm40dLPxd3K4czjzuXQDtID1L/W1djv2vHc6d7n4PXi+eT75v3oANSxAzCwoLt28P7hC2hP4beH974ZTEjwYEWKA9VBdBixLSNHhRPlIRR5kWTGhgz1peS30l9LgBojUhzpa56GmSVr9tOgcueFni15styZAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKsWIPiFwhia4kWWKrl5UGXFMFa/nJ0Da+r0rF9vAiQOH0DZTMeYKJ0y6O2JPApXRmxVe3VtSVSmRLzENWm7MM+65ra93dNXHgep71H0mSzdFec+b3SCgX91AnhTeXx6Y2aOhoRBkllwlICIi49liWmaapGhbKJuSZ+niqmeN6SWrYOvIAWztAUTtbS3uLYPu7wOvrq4EwPFxgPEx8XJyszHzsbQxcG9u8K117nVw9vYD8rL3+DSyOLN5s/oxtTA1t3a7dzx3vPwAODlDvjk/Orh+uDYARBI0F29WdkQ+st3b9zCfgDPRTxWUN5AgxctVqTXUDNix3QToz0cGXIaxo32UCo8+OujyJIM95F0+Y8mMov1NODMuPKdTo4hNXgMemGoS6HPEgAAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9pcgitpIhmaZouMGYq/LwbPMTJVE34/Z9j7BJCgE+obBnAWSwzWZMaUz+nQQkUfjyhrEmqTQGnins5XH5iU3u94Crtpfe4SuV9NT8R0Nn5/8RYBedHuFVId6iDyCcX9vXY2Bjz52imeGiZmLk259nHKfjkSVmpeWanhhm56skIyABbGyBROzsrW2tA+5ug68uLbAsxMDxcYDxMfFycrMx87Gv7u5wrfTwdfD2da+1A/Ky9/g0OEO4MjiytLd2Oza7twA6/Le8LHk6Obj6c/8xvjzAtaj147gO4Px5p3Dx9BfOQDnBBaUeJBiwoELHeaDuE8uXzONFu9tE2mvF0KSJ00q7Mjxo8d+L/9pRKihILyaB29esEnzgkt/Gn7GDPosAQAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTcJJKmV5oUKJ7qBGPyKMzNVUkzjFoSPK9YjKHQQgSve7eeTKZs7ps4GpRqDSNcQu01Kazlwbxp+ksfipezY1V5X2ZI5XS1/5/j7l/12A/h/QXlOeoSGUYdWgXBtJXEpfXKFiJSKg5V2a1yRkIt+RJeWk6KJmZhogKmbniUFrq8FE7CvsrOxD7a3Drm1s72wv7QPA8TFAxPGxcjJx8PMvLi2wa7TugDQu9LRvtvAzsnL4N/G4cbY19rZ3Ore7MLu1N3v6OsAzM0O9+XK48Xn/+notRM4D2C9c/r6Edu3UOEAgwMhFgwoMR48awnzMWOIzyfeM4ogD4aMOHJivYwexWlUmZJcPXcaXhKMORDmBZkyWa5suE8DuAQAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9h03gZNgmtqJXqqwka8YM2NlQXYN2ze254/WyiF0BYU8nSyJ+zmXQB8UViwJrS2mlNacerlbSbg3E5fJ1WMLq9KeleB3N+6uR+XEq1rFPtmfdHd/X2aDcWl5a3t+go2AhY6EZIZmiACWRZSTkYGPm55wlXqJfIsmBaipBROqqaytqw+wsQ6zr623qrmusrATA8DBA7/CwMTFtr24yrrMvLW+zqi709K0AMkOxcYP28Pd29nY0dDL5c3nz+Pm6+jt6uLex8LzweL35O/V6fv61/js4m2rx01buHwA3SWEh7BhwHzywBUjOGBhP4v/HCrUyJAbXUSDEyXSY5dOA8l3Jt2VvHCypUoAIetpmJgAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8q/YdN4Gj+AgoqqVqJWHkFrsW5Jbzbee8yaaTH4qGMxF3Rh0s2WMUnUioQygICo9LqYzJ1WK3XiX4Na5Nhdbfdy1mN8nuLlxMTbPi4be5/Jzr+3tfdSdXbYZ/UX5ygYeLdkCEao15jomMiFmKlFqDZz8FoKEFE6KhpKWjD6ipDqunpa+isaaqqLOgEwO6uwO5vLqutbDCssS0rbbGuMqsAMHIw9DFDr+6vr/PzsnSx9rR3tPg3dnk2+LL1NXXvOXf7eHv4+bx6OfN1b0P+PTN/Lf98wK6ExgO37pd/pj9W6iwIbd6CdP9OmjtGzcNFsVhDHfxDELGjxw1Xpg4kheABAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTeBowiZjqCqG9malYS5sXXScYnvcP6swJqux2MMjTeiEjlbyl5MAHAlTEarzasv+8RCu9uvjTuWTgXedFhdBLfLbGf5jF7b30e3PA+/739ncVp4VnqDf2R8ioBTgoaPfYSJhZGIYhN0BZqbBROcm56fnQ+iow6loZ+pnKugpKKtmrGmAAO2twOor6q7rL2up7C/ssO0usG8yL7KwLW4tscA0dPCzMTWxtXS2tTJ297P0Nzj3t3L3+fmzerX6M3hueTp8uv07ezZ5fa08Piz/8UAYhPo7t6+CfDcafDGbOG5hhcYKoz4cGIrh80cPAOQAAAh+QQJCgAAACwAAAAAgAAPAAAD5wi0C/6sPRfJpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwFkJEFE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAA7AAAAAAAAAAAA"" />"
fhta.WriteLine "</CENTER></BODY></HTML>"
fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
fhta.WriteLine "Sub window_onload()"
fhta.WriteLine "    CenterWindow 500,100"
fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
fhta.WriteLine " End Sub"
fhta.WriteLine " Sub CenterWindow(x,y)"
fhta.WriteLine "    Dim iLeft,itop"
fhta.WriteLine "    window.resizeTo x,y"
fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
fhta.WriteLine "    window.moveTo ileft,itop"
fhta.WriteLine "End Sub"
fhta.WriteLine "</script>"
fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
oExec.Terminate
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub Pause(Secs)    
Wscript.Sleep(Secs * 1000)    
End Sub   
'******************************************************************************************