如何从动态下拉列表创建超链接？答案

【问题标题】：How do I create hyperlinks from dynamic dropdown list?如何从动态下拉列表创建超链接？
【发布时间】：2016-05-03 21:28:46
【问题描述】：

我有一个目录，每晚都会添加一个 MP4 文件。我希望能够列出该目录的内容并允许用户选择任何文件名并播放该视频。我能够列出目录，但现在我无法弄清楚如何制作它，以便可以选择他们从下拉列表中选择的文件来播放。这就是我现在的位置......

<html>
<%@ Language=VBScript  ENABLESESSIONSTATE = False%>

<select id="selFiles" name="selFiles" class="Select" style="width: 200px" tabindex="130">

<% 
Dim fso, folder, files
Set fso = CreateObject("Scripting.FileSystemObject")  
Set folder = fso.GetFolder("E:\Video")  
Set files = folder.Files    
For each folderIdx In files 

Response.Write("<option>" + folderIdx.Name + "</option>")

Next
%>
</select>
<html>

【问题讨论】：

你想要一个播放按钮让用户点击播放歌曲吗？
最终是的。基本上下拉并选择他们想要播放的文件名并播放。这是我用来播放视频的... 您的浏览器不支持 video 标签。

标签： vbscript asp-classic directory dropdown

【解决方案1】：

在 hta 中尝试这个例子：

<html>
<head>
<SCRIPT Language="VBScript">
'*****************************************************
Sub Window_Onload()
    call loadfiles()
End Sub
'*****************************************************
sub loadfiles()
Dim fso, folder,file, files
Set fso = CreateObject("Scripting.FileSystemObject")  
Set folder = fso.GetFolder("E:\Video")  
Set files = folder.Files    
For each file In files 
If LCase(fso.GetExtensionName(file)) = "mp4" then
    call SetOption(file.name,file.path)
end if
Next
end sub
'*****************************************************
Sub SetOption(OptText,OptValue) 
    Set oNewOption = Document.CreateElement("OPTION")
    oNewOption.Text = OptText 
    oNewOption.Value = OptValue 
    selFiles.options.Add(oNewOption) 
End Sub
'*****************************************************
</SCRIPT>
</head>
<body>
<select id="selFiles" name="selFiles" class="Select" style="width: 200px" tabindex="130">
</select>
</body>
</html>

这就是让你用VLC.exe播放视频的HTA孔（必须在运行此应用程序之前安装vlc）

<html>
<title>play video</title>
<head>
<SCRIPT Language="VBScript">
'*****************************************************
Sub Window_Onload()
    call loadfiles()
End Sub
'*****************************************************
sub loadfiles()
Dim fso, folder,file, files
Set fso = CreateObject("Scripting.FileSystemObject")  
Set folder = fso.GetFolder("E:\video")  
Set files = folder.Files    
For each file In files 
If LCase(fso.GetExtensionName(file)) = "mp4" then
    call SetOption(file.name,file.path)
end if
Next
end sub
'*****************************************************
Sub SetOption(OptText,OptValue) 
    Set oNewOption = Document.CreateElement("OPTION")
    oNewOption.Text = OptText 
    oNewOption.Value = OptValue 
    selFiles.options.Add(oNewOption) 
End Sub
'****************************************************
Sub playme()
    Dim MyApplication,Param,MyVideo
    MyApplication = "%Programfiles%\VideoLAN\VLC\VLC.exe" 'Chemin du programme VLC
    Param = " --fullscreen --meta-title="" by © HACKOO 2016""" 'Paramètre plein écran
    MyVideo = selFiles.value
    Call StopStreaming()
    Call Jouer(MyApplication,Param,MyVideo)
End Sub
'****************************************************
Sub Jouer(MyApplication,Param,MyVideo)
    Dim MyFolder,FILE_EXE,MaCmd,i
    MyApplication = Split(MyApplication,"\")
    For i = 0 to UBound(MyApplication) - 1
        MyFolder = MyFolder & MyApplication(i) & "\"
    Next
    FILE_EXE = MyApplication(UBound(MyApplication))
    MyApplication = "CD /D "& DblQuote(MyFolder) & " & Start " & FILE_EXE & Param
    MyVideo = DblQuote(MyVideo)
    MaCmd = MyApplication &" "& MyVideo
    Call Executer(Macmd,0)'Démarrer la vidéo en plein écran sans afficher la console MS-DOS
End Sub
'***************************************************
Function Executer(StrCmd,Console)
    Dim ws,MyCmd,Resultat
    Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
    If Console = 0 Then
        MyCmd = "CMD /C " & StrCmd & ""
        Resultat = ws.run(MyCmd,Console,True)
        If Resultat = 0 Then
        Else
'MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
        End If
    End If
'La valeur 1 pour montrer la console MS-DOS
    If Console = 1 Then
        MyCmd = "CMD /K " & StrCmd & " "
        Resultat = ws.run(MyCmd,Console,False)
        If Resultat = 0 Then
        Else
'MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
        End If
    End If
    Executer = Resultat
End Function
'**************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**************************************************
Sub StopStreaming()
    Dim Command
    Command = "Taskkill /IM ""vlc*"" /F >nul 2>&1"
    Call Executer(Command,0)
End Sub
'**********************************************************************************************
Sub Window_OnUnload()
    Call StopStreaming()
End Sub
'**********************************************************************************************
</SCRIPT>
</head>
<body>
<select id="selFiles" name="selFiles" class="Select" style="width: 200px" tabindex="130">
<input type="button" onClick="Playme()" value="Play this video">
</select>
</body>
</html>

【讨论】：