1. 技术文章
  2. HTA VBScript and CSS3+HTML5. Code not running correctly when <meta> for css3 applied

HTA VBScript and CSS3+HTML5. Code not running correctly when <meta> for css3 applied

由 时间秒杀一切 提交于 2019-12-01 11:15:59

I can't say my answer could be considered well-documented. However, we do find a culprit in passing parameters by reference, undoubtedly. Times change, none the less (being nearly 50 years in programming) I dare say that all the implementation variety of the pass by reference concept seems to keep equivocalness eternally. Not only in different programming languages...

VBScript, for instance: the same script gives different results with Windows script host, or (to keep in topic) with HTA and different meta http-equiv tags, e.g.

<meta http-equiv="x-ua-compatible" content="IE=9">
<!-- or <meta http-equiv="x-ua-compatible" content="IE=edge">  -->
<!-- or <meta http-equiv="content-type" content="text/html">   -->
<!-- or ... -->

I can offer working version of your HTA

  • Main change: your arrays arrX (i.e. arr0(y), arr1(y), … arr7(y)) combined in one quasi-matrix die2d(X)(y) and accordant passing ByRef arrX replaced with ByVal X. More explanation in code comments.
  • Additional button Test Array with corresponding onClick procedure Sub TestArray to demonstrate ByRef passed parameters treatment and behaviour (array type). Click it more than once to see in-sub local changes versus script public changes. Cf. also comments in code.
  • Additional (alike) button Test Scalar, procedure Sub TestScalar to show ByRef passed parameters behaviour (not array type).
  • Absolutely unsuccessful attempt to trap and inhibit Esc, F5 and Alt+F4 keys. For instance, the refresh F5 key clears the form and data at all...
  • Crucial changes with comments in code.
  • Some minor cosmetic mutations.
  • Some minor debugging leavings, e.g. Option Explicit etc.
  • Untouched some inconsistency in logic, e.g. in DataAreaXb.InnerHTML displayed another value than computed (and saved) arrX(3) Points.

Here's the code:

<!-- <!DOCTYPE html> -->
<html>
<title>KPI reporting tool</title>

<HTA:APPLICATION 
     ID="KPI"
     APPLICATIONNAME="KPI reporting tool"
     CAPTION="yes"
     SYSMENU="no"
     SCROLL="auto"
     BORDER="thin"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="normal"
>

<head>
<meta http-equiv="x-ua-compatible" content="ie=9">

<style type="text/css">

    body {
        background-color:white;
        }
    table, th, td {
        border: 1px black;
        color: black;
        font-family:"Lucida Console";
        font-size:100%;
        }
    table {
        width:550px;
        }
    th {
        text-align:left;
        } 
    td {
        text-align:center;
        }

    #maintd {
        color:blue;
        text-align:left;
        }
/*
    #arrowtd {
        width:100px;}
*/
    #runbutton {
        border: 2px solid #a1a1a1;
        background: #dddddd;
        border-radius: 25px;
        }

</style>

<Script type="text/vbscript"> ' language="VBscript">
'=============================================================================
'KPI weights - EDIT HERE | KPI weights - EDIT HERE | KPI weights - EDIT HERE 
'KPI weights - EDIT HERE | KPI weights - EDIT HERE | KPI weights - EDIT HERE
'KPI weights - EDIT HERE | KPI weights - EDIT HERE | KPI weights - EDIT HERE
'=============================================================================

    Option Explicit
    Dim Sinc, Rtask, Reassignment, Update, Transfer, Assisted, PassingBack

    Sinc = 12
    Rtask = 7
    Reassignment = 2
    Update = 2
    Transfer = 5
    Assisted = 3
    PassingBack = 3

'=============================================================================
'SCRIPT - DO NOT EDIT !!!
'=============================================================================

'=============================================================================
'REPORTING ARRAY
'=============================================================================
    Dim die2d
    die2d = Array _
      ( Array("Action  _ _ _", "Weight",    "times#","Points") _
      , Array("Incidents _ _",  Sinc,        0,0) _
      , Array("Requests  _ _",  Rtask,       0,0) _
      , Array("Reassignments",  Reassignment,0,0) _
      , Array("Updates _ _ _",  Update,      0,0) _
      , Array("Transfers _ _",  Transfer,    0,0) _
      , Array("Assists _ _ _",  Assisted,    0,0) _
      , Array("Passing  back",  PassingBack, 0,0) _   
    )
    ' In fact, die2d is not a matrix, i.e. a two-dimensional array
    ' It's a one-dimensional array in which every element
    ' is a one-dimensional array as well. Therefore use
    ' die2d(row)(col) reference instead of 2D matrices' die2d(row,col)
    'msgbox Join(die2d(0),";") & vbNewLine & UBound(die2d) & vbTab & UBound(die2d(0))    'TEST MSGBOX

'=============================================================================
'ON LOAD SCRIPT TO SHOW KPI WEIGHTS
'=============================================================================
    Sub Window_OnLoad
        window.resizeTo 550,280
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' astonishing (note procedure name initial letter capitalization):
    '
    ' Window_OnLoad (uppercase) then   resizeTo succeeds 
    '                           but .InnerHTML= fails
    ' window_OnLoad (lowercase) then   resizeTo fails  
    '                           but .InnerHTML= succeeds
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    End Sub

    Sub ShowWeights
        UserValue1.InnerHTML = Sinc
        UserValue2.InnerHTML = Rtask
        UserValue3.InnerHTML = Reassignment
        UserValue4.InnerHTML = Update
        UserValue5.InnerHTML = Transfer
        UserValue6.InnerHTML = Assisted
        UserValue7.InnerHTML = PassingBack
    End Sub

'=============================================================================
'SUB FOR COUNTING DOWN WITH FAIL-SAFE FOR NUMBERS BELOW ZERO
'============================================================================= 
Sub RunScriptDown(DataAreaXa,DataAreaXb,byVal arrIDX)
    If die2d(arrIDX)(2)>0 And die2d(arrIDX)(3)>0 Then          'No. of times >0 AND Sum cannot be <0
        die2d(arrIDX)(2) = die2d(arrIDX)(2) - 1
        die2d(arrIDX)(3) = die2d(arrIDX)(3) - die2d(arrIDX)(1) 'Sum = Sum - Weight
    Else 'MsgBox "Value cannot be less than 0!",48,"ERROR"
    End If
    DataAreaXa.InnerHTML = die2d(arrIDX)(2)                    'No. of times
    DataAreaXb.InnerHTML = die2d(arrIDX)(1)*die2d(arrIDX)(2)   'Weight*No. of times
    ''' ??? why not DataAreaXb.InnerHTML = die2d(arrIDX)(3)
    DataAreaFoo.InnerHTML = SumColumn(2)
    DataAreaSum.InnerHTML = SumColumn(3)
End Sub

'=============================================================================
'SUB FOR COUNTING UP
'=============================================================================
Sub RunScriptUp(DataAreaXa,DataAreaXb,byVal arrIDX)
    die2d(arrIDX)(2) = die2d(arrIDX)(2) + 1
    die2d(arrIDX)(3) = die2d(arrIDX)(3) + die2d(arrIDX)(1)
    DataAreaXa.InnerHTML = die2d(arrIDX)(2)
    DataAreaXb.InnerHTML = die2d(arrIDX)(1)*die2d(arrIDX)(2) 
    ''' ??? why not DataAreaXb.InnerHTML = die2d(arrIDX)(3)
    DataAreaFoo.InnerHTML = SumColumn(2)
    DataAreaSum.InnerHTML = SumColumn(3)
End Sub

'=============================================================================
'SUB FOR SAVING STATS TO A FILE
'=============================================================================
Sub SaveData()
    Dim objFSO, WshShell, objFolder, objNetwork, objFile
    Dim relativePath, path, statDate, statFile, statUser, strLine
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set WshShell = CreateObject("WScript.Shell")
        relativePath = wshShell.CurrentDirectory
        path = relativePath & "\KPI_STATS\"
        statDate = Now
        statFile = Month(statDate) & "-" & Day(statDate) & "-" & Year(statDate) & ".tsv"
    Set objNetwork = CreateObject("WScript.Network")
        statUser = objNetwork.UserDomain & "\" & objNetwork.UserName
    If objFSO.FolderExists(path) Then
    'DO NOTHING
    Else Set objFolder = objFSO.CreateFolder(path)
    End If
    msgbox(path & statFile)
    If objFSO.FileExists (path & statFile) Then
       MsgBox "File already exists!",48,"ERROR"
       Else objFSO.CreateTextFile (path & statFile)
    End If
    Set objFile = objFSO.OpenTextFile (path & statFile, 8)
        strLine = statUser & vbTab & statDate & vbCrLf & _
          String( 52, "-") & vbCrLf & _
          Join(die2d(0), vbTab) & vbCrLf & _
          Join(die2d(1), vbTab) & vbCrLf & _
          Join(die2d(2), vbTab) & vbCrLf & _
          Join(die2d(3), vbTab) & vbCrLf & _
          Join(die2d(4), vbTab) & vbCrLf & _
          Join(die2d(5), vbTab) & vbCrLf & _
          Join(die2d(6), vbTab) & vbCrLf & _
          Join(die2d(7), vbTab) & vbCrLf & _
          String( 52, "-") & vbCrLf & _
          vbTab & vbTab & vbTab & vbTab & SumColumn(3) & " TOTAL points"
        objFile.WriteLine strLine
    objFile.Close
End Sub

'=============================================================================
'EXIT SUB
'=============================================================================
Sub ExitWindow()
    Dim usrExit
  usrExit = vbYes
    'usrExit = MsgBox("Do you really want to exit?" & vbCrLf & "All unsaved data will be lost!",52,"WARNING!")
    If usrExit = vbYes Then
        self.close()
    Else
    End If
End Sub

'=============================================================================
'SUB FOR showing STATS
'=============================================================================
Sub RunReport()
    Dim objNetwork
    Dim strLine, statDate, statUser
    statDate = Now
    Set objNetwork = CreateObject("WScript.Network")
    statUser = objNetwork.UserDomain & "\" & objNetwork.UserName
    Set objNetwork = Nothing
    strLine = statUser & vbTab & statDate & vbCrLf & _
        String( 52, "-") & vbCrLf & _
        Join(die2d(0), vbTab) & vbCrLf & _
        Join(die2d(1), vbTab) & vbCrLf & _
        Join(die2d(2), vbTab) & vbCrLf & _
        Join(die2d(3), vbTab) & vbCrLf & _
        Join(die2d(4), vbTab) & vbCrLf & _
        Join(die2d(5), vbTab) & vbCrLf & _
        Join(die2d(6), vbTab) & vbCrLf & _
        Join(die2d(7), vbTab) & vbCrLf & _
        vbCrLf & _
        vbTab & vbTab & vbTab & vbTab & SumColumn(3) & " TOTAL points"
    msgbox( strLine)
End Sub

'=============================================================================
' TestArray SUB
'=============================================================================
Sub TestArray(byRef dieAd)
dieAd(1)(2)=dieAd(1)(2)+100 ' this change is "in SUB" local
                            ' even thought the dieAd == die2d passed by reference  
die2d(7)(2)=die2d(7)(2)+100 ' this change is "script" global
Sinc=Sinc+1                 ' this change is "script" global
    Dim strLine
    strLine = "TestArray SUB" & vbCrLf & _
      String( 52, "-") & vbCrLf & _
      Join(dieAd(0), vbTab) & vbCrLf & _
      Join(dieAd(1), vbTab) & vbCrLf & _
      Join(dieAd(2), vbTab) & vbCrLf & _
      Join(dieAd(3), vbTab) & vbCrLf & _
      Join(dieAd(4), vbTab) & vbCrLf & _
      String( 52, "-") & vbCrLf & _
      Join(die2d(5), vbTab) & vbCrLf & _
      Join(die2d(6), vbTab) & vbCrLf & _
      Join(die2d(7), vbTab) & vbCrLf & _
      vbCrLf & _
      vbTab & vbTab & vbTab & vbTab & SumColumn(3) & " TOTAL points" _ 
      & vbCrLf & Sinc
    msgbox( strLine)

End Sub
'=============================================================================
' TestScalar SUB
'=============================================================================
Sub TestScalar(byRef nmbrS, byRef nmbrR)
die2d(7)(2)=die2d(7)(2)+50 ' this change is "script" global
Rtask = Rtask + 1          ' this change is "script" global
                           ' but nmbrR stays unchanged (!!!)
                           ' even thought the nmbrR == Rtask passed by reference
nmbrS = nmbrS + 1          ' this change is "in SUB" local
                           ' even thought the nmbrS == Sinc  passed by reference
    Dim strLine
    strLine = "TestScalar SUB" & vbCrLf & _
      String( 52, "-") & vbCrLf & _
      Join(die2d(0), vbTab) & vbCrLf & _
      Join(die2d(1), vbTab) & vbCrLf & _
      Join(die2d(2), vbTab) & vbCrLf & _
      Join(die2d(3), vbTab) & vbCrLf & _
      Join(die2d(4), vbTab) & vbCrLf & _
      String( 52, "-") & vbCrLf & _
      Join(die2d(5), vbTab) & vbCrLf & _
      Join(die2d(6), vbTab) & vbCrLf & _
      Join(die2d(7), vbTab) & vbCrLf & _
      vbCrLf & _
      vbTab & vbTab & vbTab & vbTab & SumColumn(3)  & " TOTAL points" _ 
      & vbCrLf & "nmbrS" & vbTab & "Sinc" & vbTab & "Rtask" & vbTab & "nmbrR" _
      & vbCrLf &  nmbrS  & vbTab &  Sinc  & vbTab &  Rtask  & vbTab &  nmbrR 
    msgbox( strLine)
End Sub

'=============================================================================
' SumColumn FUNCTION
'=============================================================================
Function SumColumn(byVal col)
    Dim ii
    SumColumn = 0
    For ii = 1 To UBound(die2d)
        SumColumn = SumColumn + die2d(ii)(col)
    Next
End Function

'=============================================================================
' KeyCheck FUNCTION
'=============================================================================
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Absolutely unsuccessful attempt:
' Escape, F5 and Alt+F4 keys should be trapped to ensure 
'  no HTA window refreshes occur & proper exit-code runs
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function KeyCheck(byRef myEvent)
    Dim kk
    'kk=myEvent.KeyCode
    kk=myEvent.Key
    If     kk = "F5"  _
        Or kk = "Esc" Then 
        KeyCheck = False
    Else
        KeyCheck = True
    End If
    'msgbox (VarType(kk) & " " & TypeName(kk) & " '" &  kk & "' " & myEvent.keyCode)
End Function

</Script>

</head>

<!--HTML PART OF THE SCRIPT. WAY THE WINDOW LOOKS-->
<body onKeyUp="self.event.returnValue=KeyCheck(event)" onload=ShowWeights()>
<table>
<tr>
    <th>Event</th>
    <th></th>
    <th>Weight</th>
    <th>Times done</th>
    <th>TOTAL</th>
</tr>
<tr>
    <td id="maintd">INCIDENTS:</td>
    <td id="arrowtd">
        <input id=runbutton type="button" value="&#8592;" onClick="RunScriptDown(DataArea1a,DataArea1b,1)">
        <input id=runbutton type="button" value="&#8594;" onClick="RunScriptUp(DataArea1a,DataArea1b,1)">
    </td>
    <td><span id=UserValue1 name=UserValue1 value=Sinc></span></td>
    <td><span id=DataArea1a name=1a></span></td>
    <td><span id=DataArea1b name=1b></span></td>
</tr>
<tr>
    <td id="maintd">REQUESTS:</td>
    <td id="arrowtd">
        <input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea2a,DataArea2b,2)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea2a,DataArea2b,2)">
    </td>
    <td><span id=UserValue2 value=Rtask></span></td>
    <td><span id=DataArea2a name=2a></span></td>
    <td><span id=DataArea2b name=2b></span></td>
</tr>
<tr>
    <td id="maintd">REASSIGNMENTS:</td>
    <td id="arrowtd">
        <input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea3a,DataArea3b,3)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea3a,DataArea3b,3)"></td>
    <td><span id=UserValue3 value=Reassignment></span></td>
    <td><span id=DataArea3a name=3a></span></td>
    <td><span id=DataArea3b name=3b></span></td>
</tr>
<tr>
    <td id="maintd">UPDATES:</td>
    <td id="arrowtd">
        <input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea4a,DataArea4b,4)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea4a,DataArea4b,4)"></td>
    <td><span id=UserValue4 value=Update></span></td>
    <td><span id=DataArea4a name=4a></span></td>
    <td><span id=DataArea4b name=4b></span></td>
</tr>
<tr>
    <td id="maintd">TRANSFERS:</td>
    <td id="arrowtd">
        <input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea5a,DataArea5b,5)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea5a,DataArea5b,5)"></td>
    <td><span id=UserValue5></span></td>
    <td><span id=DataArea5a name=5a></span></td>
    <td><span id=DataArea5b name=5b></span></td>
</tr>
<tr>
    <td id="maintd">ASSISTS:</td>
    <td id="arrowtd">
        <input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea6a,DataArea6b,6)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea6a,DataArea6b,6)"></td>
    <td><span id=UserValue6></span></td>
    <td><span id=DataArea6a name=6a></span></td>
    <td><span id=DataArea6b name=6b></span></td>
</tr>
<tr>
    <td id="maintd">PASSINGS:</td>
    <td id="arrowtd">
        <input id=runbutton  type="button" value="&#8592;" onClick="RunScriptDown(DataArea7a,DataArea7b,7)">
        <input id=runbutton  type="button" value="&#8594;" onClick="RunScriptUp(DataArea7a,DataArea7b,7)"></td>
    <td><span id=UserValue7></span></td>
    <td><span id=DataArea7a name=7a></span></td>
    <td><span id=DataArea7b name=7b></span></td>
</tr>
<tr>
    <td><input id=runbutton  type="button" value="Exit" onClick="ExitWindow()"></td>
    <td><input id=runbutton  type="button" value="Show Report" onClick="RunReport()"></td>
    <td><input id=runbutton  type="button" value="Save Data" onClick="SaveData()"></td>
    <td><span id=DataAreaFoo name=DataAreaFoo></span></td>
    <td><span id=DataAreaSum name=DataAreaSum></span></td>
</tr>
<tr>
    <td><input id=runbutton  type="button" value="Test Array" onClick="TestArray(die2d)"></td>
    <td><input id=runbutton  type="button" value="Test Scalar" onClick="TestScalar(Sinc, Rtask)"></td>
</tr>
</table>

</body>
</html>
标签
html5
css3
vbscript
hta
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!