求助VBS播放器：全曲循环播放不能显示界面的问题

yiyue7 · 发表于 2025-3-6 13:36:35

下面是一个VBS做的播放器，点了取消进入播放模式选择后，选是进入全曲循环就会在后台播放，不能显示循环播放模式的界面了，有大佬能给改一下吗？谢谢了

Set fso = CreateObject("Scripting.FileSystemObject")
Set player = CreateObject("WMPlayer.OCX")
Set shell = CreateObject("WScript.Shell")
Dim configRegPath
configRegPath = "HKEY_CURRENT_USER\Software\YsVbsMusicPlayer\Config"
Dim musicFolderPath, currentSongIndex, totalSongCount
On Error Resume Next
musicFolderPath = shell.RegRead(configRegPath & "MusicFolderPath")
If Err.Number <> 0 Then
musicFolderPath = ""
Err.Clear
End If
currentSongIndex = shell.RegRead(configRegPath & "CurrentSongIndex")
If Err.Number <> 0 Then
currentSongIndex = 0
Err.Clear
End If
totalSongCount = shell.RegRead(configRegPath & "TotalSongCount")
If Err.Number <> 0 Then
totalSongCount = 0
Err.Clear
End If
On Error Goto 0
Do
musicFolderPath = InputBox(" 请看下面输入框中的音乐文件夹路径"& vbCrLf &""& vbCrLf &" 是否正确？如需更换，请输入新路径"& vbCrLf &""& vbCrLf &" 如果没问题，直接点确定开始播放。", "音乐路径输入", musicFolderPath)
If musicFolderPath = "" Then
WScript.Quit
Else
Exit Do
End If
Loop
If Not fso.FolderExists(musicFolderPath) Then
Do
WScript.Echo "音乐文件夹路径不存在，请输入正确的音乐文件夹路径。"
Do
musicFolderPath = InputBox("请输入有效的MP3音乐文件夹路径", "音乐路径输入")
If musicFolderPath = "" Then
WScript.Quit
Else
Exit Do
End If
Loop
Loop Until fso.FolderExists(musicFolderPath)
End If
Dim hasMP3Files
hasMP3Files = False
If fso.FolderExists(musicFolderPath) Then
Dim newTotalSongCount
newTotalSongCount = 0
For Each file In fso.GetFolder(musicFolderPath).Files
If LCase(fso.GetExtensionName(file.Name)) = "mp3" Then
hasMP3Files = True
newTotalSongCount = newTotalSongCount + 1
End If
Next
If newTotalSongCount <> totalSongCount Then
currentSongIndex = 0
totalSongCount = newTotalSongCount
End If
End If
If Not hasMP3Files Then
Do
WScript.Echo "指定路径下没有MP3文件，请重新输入。"
Do
musicFolderPath = InputBox("请输入包含MP3文件的音乐文件夹路径", "音乐路径输入")
If musicFolderPath = "" Then
WScript.Quit
Else
Exit Do
End If
Loop
hasMP3Files = False
If fso.FolderExists(musicFolderPath) Then
Dim newTotalSongCount2
newTotalSongCount2 = 0
For Each file In fso.GetFolder(musicFolderPath).Files
If LCase(fso.GetExtensionName(file.Name)) = "mp3" Then
hasMP3Files = True
newTotalSongCount2 = newTotalSongCount2 + 1
End If
Next
If newTotalSongCount2 <> totalSongCount Then
currentSongIndex = 0
totalSongCount = newTotalSongCount2
End If
End If
Loop Until hasMP3Files
End If
shell.RegWrite configRegPath & "MusicFolderPath", musicFolderPath, "REG_SZ"
shell.RegWrite configRegPath & "TotalSongCount", totalSongCount, "REG_DWORD"
shell.RegWrite configRegPath & "CurrentSongIndex", currentSongIndex, "REG_DWORD"
Set musicFolder = fso.GetFolder(musicFolderPath)
Dim songs()
ReDim songs(-1)
For Each file In musicFolder.Files
If LCase(fso.GetExtensionName(file.Name)) = "mp3" Then
ReDim Preserve songs(UBound(songs) + 1)
songs(UBound(songs)) = fso.GetBaseName(file.Name)
End If
Next
If UBound(songs) < 0 Then
WScript.Echo "没有找到MP3文件，请检查路径。"
WScript.Quit
End If
On Error Resume Next
Do While True
player.URL = musicFolderPath & "" & songs(currentSongIndex) & ".mp3"
player.settings.setMode "loop", True
Do While player.playState <> 3 And player.playState <> 1
WScript.Sleep 100
Loop
If Err.Number <> 0 Then
WScript.Echo "播放出错：" & Err.Description
Err.Clear
End If
Do While player.playState = 3
Dim userChoice
userChoice = MsgBox("正在播放：" & (currentSongIndex + 1) & "." & songs(currentSongIndex) & vbCrLf & _
"点【是】-> 播放【上一曲】" & vbCrLf & _
"点【否】-> 播放【下一曲】" & vbCrLf & _
"点【取消】-> 选择播放模式", _
vbYesNoCancel + vbQuestion, (currentSongIndex + 1) & "." & songs(currentSongIndex) & " - " & "VBS音乐播放器V3")
If userChoice = vbYes Then
If currentSongIndex > 0 Then
currentSongIndex = currentSongIndex - 1
Else
WScript.Echo "亲，这是已经是第一首咯。"
End If
player.controls.stop
Exit Do
ElseIf userChoice = vbNo Then
currentSongIndex = currentSongIndex + 1
If currentSongIndex > UBound(songs) Then
currentSongIndex = 0
WScript.Echo "亲，这是最后一首咯，现在从头开始播放。"
End If
player.controls.stop
Exit Do
ElseIf userChoice = vbCancel Then
Dim loopChoice
loopChoice = MsgBox("正在播放：" & (currentSongIndex + 1) & "." & songs(currentSongIndex) & vbCrLf & _
"点【是】-> 全曲循环播放" & vbCrLf & _
"点【否】-> 返回主界面" & vbCrLf & _
"点【取消】-> 退出播放器", _
vbYesNoCancel + vbQuestion, "音乐循环模式")
If loopChoice = vbYes Then
player.settings.setMode "loop", False
Do While True
player.URL = musicFolderPath & "" & songs(currentSongIndex) & ".mp3"
Do While player.playState <> 3 And player.playState <> 1
WScript.Sleep 100
Loop
If Err.Number <> 0 Then
WScript.Echo "播放出错：" & Err.Description
Err.Clear
End If
Do While player.playState = 3
WScript.Sleep 100
Loop
currentSongIndex = currentSongIndex + 1
If currentSongIndex > UBound(songs) Then
currentSongIndex = 0
End If
shell.RegWrite configRegPath & "CurrentSongIndex", currentSongIndex, "REG_DWORD"
Loop
ElseIf loopChoice = vbNo Then
player.settings.setMode "loop", True
Exit Do
ElseIf loopChoice = vbCancel Then
WScript.Quit
End If
End If
Do While player.playState = 3
WScript.Sleep 100
Loop
Loop
If player.playState <> 1 Then
player.controls.stop
End If
Loop
On Error Goto 0
player.close
Set player = Nothing
Set fso = Nothing
Set shell = Nothing

复制代码

以上就是完整代码了，急用拜托。

yiyue7 · 发表于 2025-3-6 13:39:38

能给优化一下就更好了，比我我想的是，循环播放完一首后，自动关闭，弹出界面播放第二首，这样界面就能同步显示歌曲名称了，如果不能实现，就在循环播放时弹出显示操作界面吧，现在必须得到进程去关闭才行，有点麻烦啊

jyswjjgdwtdtj · 发表于 2025-3-6 23:20:09

本帖最后由 jyswjjgdwtdtj 于 2025-3-6 23:24 编辑

vbs是单线程的或许可以试试htmlfile的settimeout函数用回调来弹出一个对话框不过最方便的还是用cscript打开想结束进程直接把控制台窗口关了就行使控制台窗口显示或者不显示可以用wshshell的exec方法运行powershell.exe -windowstyle hidden或者normal来调整当然以上都不美观想要自用到是够了
同时你的代码似乎有点臃肿诶

Do
musicFolderPath = InputBox("请输入包含MP3文件的音乐文件夹路径", "音乐路径输入")
If musicFolderPath = "" Then
WScript.Quit
Else
Exit Do
End If
Loop

复制代码

套个循环是何意？

yiyue7 · 发表于 2025-3-7 01:17:51

回复 3# jyswjjgdwtdtj

你好，如果方便的话，您能帮我改一下吗？deepseek写的还是欠佳啊，do循环那个还有循环播放不显示，我也不知道怎么改了，您能给个完整的可以运行的吗，谢谢了

jyswjjgdwtdtj · 发表于 2025-3-7 23:16:59

回复 4# yiyue7

用vbs实现交互实在不是一个容易的事考虑用hta做个小应用？

yiyue7 · 发表于 2025-3-8 09:14:12

回复 5# jyswjjgdwtdtj

算了，不整了，就这么用吧，hta界面和控制显示有的会有问题，兼容性问题，如果彻底还不如py呢

aloha20200628 · 发表于 2025-3-8 11:13:33

本帖最后由 aloha20200628 于 2025-3-8 11:29 编辑

回复 6# yiyue7

一楼代码用vbs播放mp3，是在调用系统内置的wmplayer插件，为何楼主不直接用系统内置的wmplayer播放指定的mp3播放列表文件呢？例如以下代码（存为 test.bat 运行），代码中的d3变量（即mp3文件所在目录）以及wmplayer.exe的路径均由楼主自定义...

@echo off &set "d3=d:\mp3"
dir /b/s/a-d "%d3%\*.mp3">"mp3播放列表.m3u"
start "" "C:\Program Files\Windows Media Player\wmplayer.exe" "%cd%\mp3播放列表.m3u"
exit/b

复制代码

yiyue7 · 发表于 2025-3-10 08:50:56

回复 7# aloha20200628

你好，只是单纯的听歌玩而已，我做的这种脚本肯定没有播放器软件功能齐全的，纯属娱乐，感谢你的回复。

jyswjjgdwtdtj · 发表于 2025-3-10 22:47:27

回复 8# yiyue7

自制播放器可以考虑html5 像chrome可以吧网页打包为本地应用 h5的视频框架也挺多的方便教程也多

yiyue7 · 发表于 2025-4-7 10:24:59

回复 9# jyswjjgdwtdtj

可以考虑试试，感谢回复。

aloha20200628 · 发表于 2025-4-8 22:37:06

回复 10# yiyue7

分享链接仅供参考 http://www.bathome.net/viewthrea ... mp;extra=#pid288446

yiyue7 · 发表于 2025-7-15 18:35:43

来看一下我的再次打开这个VBS直接结束上次的进程方案：

On Error Resume Next
Dim WshShell, batchFile
Set WshShell = CreateObject("WScript.Shell")
If WScript.Arguments.Count = 0 Then
batchFile = WshShell.SpecialFolders("Temp") & "\tmpxvbs.cmd"
With CreateObject("Scripting.FileSystemObject").CreateTextFile(batchFile, True)
.WriteLine "@echo off"
.WriteLine "taskkill /F /IM wscript.exe >nul 2>&1"
.WriteLine "taskkill /F /IM cscript.exe >nul 2>&1"
.WriteLine "wmic process where ""name='wscript.exe' and CommandLine like '%" & WScript.ScriptName & "%'"" delete >nul 2>&1"
.WriteLine "start """" """ & CreateObject("Scripting.FileSystemObject").GetFile(WScript.ScriptFullName).ShortPath & """ /restarted"
.WriteLine "timeout /t 1 /nobreak >nul"
.WriteLine "del /f /q """ & batchFile & """"
.Close
End With
WshShell.Run """" & batchFile & """", 0, False
WScript.Quit
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set player = CreateObject("WMPlayer.OCX")
Set shell = CreateObject("WScript.Shell")
Dim configRegPath
configRegPath = "HKEY_CURRENT_USER\Software\YsVbsMusicPlayer\Config"
Dim musicFolderPath, currentSongIndex, totalSongCount
On Error Resume Next
musicFolderPath = shell.RegRead(configRegPath & "MusicFolderPath")
If Err.Number <> 0 Then
musicFolderPath = ""
Err.Clear
End If
currentSongIndex = shell.RegRead(configRegPath & "CurrentSongIndex")
If Err.Number <> 0 Then
currentSongIndex = 0
Err.Clear
End If
totalSongCount = shell.RegRead(configRegPath & "TotalSongCount")
If Err.Number <> 0 Then
totalSongCount = 0
Err.Clear
End If
On Error Goto 0
Do
musicFolderPath = InputBox(" 请看下面输入框中的音乐文件夹路径"& vbCrLf &""& vbCrLf &" 是否正确？例如：D:\我的音乐"& vbCrLf &""& vbCrLf &" 如果没问题，直接点确定开始播放。", "音乐路径输入 - 轶软VBS音乐播放器V3", musicFolderPath)
If musicFolderPath = "" Then
WScript.Quit
Else
Exit Do
End If
Loop
If Not fso.FolderExists(musicFolderPath) Then
Do
WScript.Echo "音乐文件夹路径不存在，请输入正确的音乐文件夹路径。"
Do
musicFolderPath = InputBox(" 您输入的音乐文件夹路径不对哦"& vbCrLf &""& vbCrLf &" 请重新检查，例如：D:\我的音乐"& vbCrLf &""& vbCrLf &" 输入好后，直接点确定开始播放。", "音乐路径输入 - 轶软VBS音乐播放器V3")
If musicFolderPath = "" Then
WScript.Quit
Else
Exit Do
End If
Loop
Loop Until fso.FolderExists(musicFolderPath)
End If
Dim hasMP3Files
hasMP3Files = False
If fso.FolderExists(musicFolderPath) Then
Dim newTotalSongCount
newTotalSongCount = 0
For Each file In fso.GetFolder(musicFolderPath).Files
If LCase(fso.GetExtensionName(file.Name)) = "mp3" Then
hasMP3Files = True
newTotalSongCount = newTotalSongCount + 1
End If
Next
If newTotalSongCount <> totalSongCount Then
currentSongIndex = 0
totalSongCount = newTotalSongCount
End If
End If
If Not hasMP3Files Then
Do
WScript.Echo "指定路径下没有MP3文件，请重新输入。"
Do
musicFolderPath = InputBox("请输入包含MP3文件的音乐文件夹路径", "音乐路径输入")
If musicFolderPath = "" Then
WScript.Quit
Else
Exit Do
End If
Loop
hasMP3Files = False
If fso.FolderExists(musicFolderPath) Then
Dim newTotalSongCount2
newTotalSongCount2 = 0
For Each file In fso.GetFolder(musicFolderPath).Files
If LCase(fso.GetExtensionName(file.Name)) = "mp3" Then
hasMP3Files = True
newTotalSongCount2 = newTotalSongCount2 + 1
End If
Next
If newTotalSongCount2 <> totalSongCount Then
currentSongIndex = 0
totalSongCount = newTotalSongCount2
End If
End If
Loop Until hasMP3Files
End If
shell.RegWrite configRegPath & "MusicFolderPath", musicFolderPath, "REG_SZ"
shell.RegWrite configRegPath & "TotalSongCount", totalSongCount, "REG_DWORD"
shell.RegWrite configRegPath & "CurrentSongIndex", currentSongIndex, "REG_DWORD"
Set musicFolder = fso.GetFolder(musicFolderPath)
Dim songs()
ReDim songs(-1)
For Each file In musicFolder.Files
If LCase(fso.GetExtensionName(file.Name)) = "mp3" Then
ReDim Preserve songs(UBound(songs) + 1)
songs(UBound(songs)) = fso.GetBaseName(file.Name)
End If
Next
If UBound(songs) < 0 Then
WScript.Echo "没有找到MP3文件，请检查路径。"
WScript.Quit
End If
On Error Resume Next
Do While True
player.URL = musicFolderPath & "" & songs(currentSongIndex) & ".mp3"
player.settings.setMode "loop", True
Do While player.playState <> 3 And player.playState <> 1
WScript.Sleep 100
Loop
If Err.Number <> 0 Then
WScript.Echo "播放出错：" & Err.Description
Err.Clear
End If
Do While player.playState = 3
Dim userChoice
userChoice = MsgBox("正在播放：" & (currentSongIndex + 1) & "." & songs(currentSongIndex) & vbCrLf & _
"点【是】-> 播放【上一曲】" & vbCrLf & _
"点【否】-> 播放【下一曲】" & vbCrLf & _
"点【取消】-> 选择播放模式", _
vbYesNoCancel + vbQuestion, (currentSongIndex + 1) & "." & songs(currentSongIndex) & " - " & "轶软VBS音乐播放器V3")
If userChoice = vbYes Then
If currentSongIndex > 0 Then
currentSongIndex = currentSongIndex - 1
shell.RegWrite configRegPath & "CurrentSongIndex", currentSongIndex, "REG_DWORD"
Else
WScript.Echo "亲，这是已经是第一首咯。"
End If
shell.RegWrite configRegPath & "CurrentSongIndex", currentSongIndex, "REG_DWORD"
player.controls.stop
Exit Do
ElseIf userChoice = vbNo Then
currentSongIndex = currentSongIndex + 1
If currentSongIndex > UBound(songs) Then
currentSongIndex = 0
WScript.Echo "亲，这是最后一首咯，现在从头开始播放。"
End If
shell.RegWrite configRegPath & "CurrentSongIndex", currentSongIndex, "REG_DWORD"
player.controls.stop
Exit Do
ElseIf userChoice = vbCancel Then
Dim loopChoice
loopChoice = MsgBox("正在播放：" & (currentSongIndex + 1) & "." & songs(currentSongIndex) & vbCrLf & _
"点【是】-> 全曲循环播放" & vbCrLf & _
"点【否】-> 返回主界面" & vbCrLf & _
"点【取消】-> 退出播放器", _
vbYesNoCancel + vbQuestion, (currentSongIndex + 1) & "." & songs(currentSongIndex) & " - " & "音乐循环模式 - 轶软VBS音乐播放器V3")
If loopChoice = vbYes Then
player.settings.setMode "loop", False
Do While True
player.URL = musicFolderPath & "" & songs(currentSongIndex) & ".mp3"
Do While player.playState <> 3 And player.playState <> 1
WScript.Sleep 100
Loop
If Err.Number <> 0 Then
WScript.Echo "播放出错：" & Err.Description
Err.Clear
End If
Do While player.playState = 3
WScript.Sleep 100
Loop
currentSongIndex = currentSongIndex + 1
If currentSongIndex > UBound(songs) Then
currentSongIndex = 0
End If
shell.RegWrite configRegPath & "CurrentSongIndex", currentSongIndex, "REG_DWORD"
Loop
ElseIf loopChoice = vbNo Then
player.settings.setMode "loop", True
Exit Do
ElseIf loopChoice = vbCancel Then
WScript.Quit
End If
End If
Do While player.playState = 3
WScript.Sleep 100
Loop
Loop
If player.playState <> 1 Then
player.controls.stop
End If
Loop
On Error Goto 0
player.close
Set player = Nothing
Set fso = Nothing
Set shell = Nothing

复制代码

		自动登录	找回密码
密码			注册

[新手上路]批处理新手入门导读	[视频教程]批处理基础视频教程	[视频教程]VBS基础视频教程	[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动	[批处理精品]CMD命令50条不能说的秘密	[在线下载]第三方命令行工具	[在线帮助]VBScript / JScript 在线参考

[问题求助] 求助VBS播放器：全曲循环播放不能显示界面的问题

浏览过的版块