Question

我有一个目录，每晚都会添加一个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>

Answer 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>

这就是HTA允许您使用VLC.exe播放视频（在运行此应用程序之前必须安装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>

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

1 个答案: