.hta語法錯誤，創建類

vbscript在.vbs文件中正常工作。當然，當我在.vbs文件中運行vbscript代碼時，我取消了'msgbox行的註釋。.hta語法錯誤，創建類

當我加載下面的文件時，我收到第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>

來源

2014-02-15 user235218

你不能聲明一個子類內部，你必須Class ClsExt內Sub Window_OnLoad

來源

2014-02-15 07:56:20

.hta語法錯誤，創建類

回答

相關問題