Question

vbscript在.vbs文件中正常工作。当然，当我在.vbs文件中运行vbscript代码时，我取消注释'msgbox行。

当我加载以下文件时，我在第42行收到错误消息，没有其他说明。

我们非常感谢任何建议。

如果我解决了这个问题，我将创建一个调用PDF文件，.mp3音频文件和.mp4视频文件的菜单

这是我到目前为止创建的代码：

<html>
<head>
<title>My HTML application</title>
<HTA:APPLICATION
  APPLICATIONNAME="My HTML application"
  ID="MyHTMLapplication"
  VERSION="1.0"/>
</head>

<script language="VBScript">

Sub Window_OnLoad
  'This method will be called when the application loads
  'Add your code here
   ' copyright JSWARE
 'FileExt.vbs.
 '-- File extension default program Class.
 '-- send a file extension to Function and Get path of default program.

 Dim CE, txtExt, htmlExt, zipExt, pdfExt, mp4Ext
 Set CE = New ClsExt

  txtExt = CE.GetDefaultProgram("txt")
   'MsgBox "TXT" & vbcrlf & txtExt

  htmlExt = CE.GetDefaultProgram("html")
   'MsgBox "HTML" & vbcrlf & htmlExt

 htmlExt = CE.GetDefaultProgram("zip")
   'MsgBox "ZIP" & vbcrlf & htmlExt

 pdfExt = CE.GetDefaultProgram("pdf")
   'MsgBox "XYZ" & vbcrlf & pdfExt

 mp4Ext = CE.GetDefaultProgram("mp4")
   'MsgBox "mp4" & vbcrlf & mp4Ext

Set CE = Nothing

'_______________ START ClsExt Class ____________________________

Class ClsExt
Private SH, CK1, CK, s1, s2, sType

   Private Sub Class_Initialize()
      CK = "\Shell\Open\Command\"
      CK1 = "\Shell\Opennew\Command\"
      Set SH = CreateObject("WScript.Shell")
   End Sub

  Private Sub Class_Terminate()
     Set SH = Nothing
  End Sub

  Public Function GetDefaultProgram(sExt)
     If left(sExt, 1) <> "." Then
         sExt = "." & sExt
     End If
  On Error Resume Next
    Err.clear
         sType = SH.RegRead("HKCR\" & sExt & "\")     '--look up ext in HKCR to Get file type (ex.: "txtfile")
            If (Err.number <> 0) or (len(sType) = 0) Then
               GetDefaultProgram = ""
               Exit Function
            End If

        s1 = SH.RegRead("HKCR\" & sType & CK)   '--Shell\open\command or.....
           If (Err.number = 0) and (len(s1) <> 0) Then
                s2 = Stripit(s1)
                GetDefaultProgram = s2
                Exit Function
           End If
              Err.clear
             s1 = SH.RegRead("HKCR\" & sType & CK1)    '--shell\opennew\command.
                If (Err.number = 0) and (len(s1) <> 0) Then
                    s2 = Stripit(s1)
                   GetDefaultProgram = s2
                   Exit Function
               End If
         Err.clear
        s1 = SH.RegRead("HKCR\" & sExt & CK) 
            If (Err.number = 0) and (len(s1) <> 0)  Then
               s2 = Stripit(s1)
              GetDefaultProgram = s2
               Exit Function
           End If

      GetDefaultProgram = ""     '--If none of these checks have found anything return "".
 End Function     

Private Function Stripit(sp)    '--clean up default program string. 
   Dim ept, sf
     On Error Resume Next
  ept = instr(1, sp, "exe", 1)  '--find End of exe path.
     If ept <> 0 Then
         sf = left(sp, ept + 2)
     Else
       ept = instr(1, sp, "com", 1)
        If ept <> 0 Then
          sf = left(sp, ept + 2)
        End If
   End If
    If left(sf, 1) = chr(34) Then  '--take off any quotes or spaces.
       sf = right(sf, (len(sf) - 1))
    End If
   sf = trim(sf)  
   Stripit = sf
 End Function

End Class






    'Set wmp = CreateObject("WMPlayer.OCX")
    'wmp.openPlayer("E:\svr1\K\data\Steinberg Nisan\AV\2013-04-15_\VID_20130415_171550_FIXED_.mp4")
    'wmp.openPlayer(".\VID_20130415_191439_FIXED_.mp4")

End Sub

</script>

<body bgcolor="white">

<!--Add your controls here-->
<br /><br />
<font size="7">
<b><u>Table of Contents:  Index to Folder </b></u></font>
<br /><br />



<!--{{InsertControlsHere}}-Do not remove this line-->
</body>
</html>

Answer 1

你不能在sub中声明一个类，并且Class ClsExt内有Sub Window_OnLoad

.hta语法错误，创建类

1 个答案: